procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Enhance terpri to allow conditionally output a newline

Browse source 
* 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)
This commit is contained in:
Leo Liu 2014-10-09 06:05:48 +08:00
parent 289a43910e
commit 2dbd7a37a8
12 changed files with 125 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
doc/lispref/ChangeLog
View file

@ -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

9
doc/lispref/streams.texi
View file

@ -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

4
doc/misc/ChangeLog
View file

@ -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

5
doc/misc/cl.texi
View file

@ -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

4
lisp/ChangeLog
View file

@ -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):

7
lisp/emacs-lisp/cl-extra.el
View file

@ -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)

11
src/ChangeLog
View file

@ -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

2
src/keyboard.c
View file

@ -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

2
src/keymap.c
View file

@ -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,

28
src/print.c
View file

@ -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,

5
test/ChangeLog
View file

@ -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):

56
test/automated/print-tests.el Normal file
View file

@ -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