civodul pushed a commit to branch master in repository shepherd. commit 634f69673409e90bb879de0495eddbba8d591bab Author: Ludovic Courtès <l...@gnu.org> Date: Tue Mar 6 21:38:59 2018 +0100
Simplify 'make-shepherd-output-port'. * modules/shepherd/comm.scm (%not-newline): New variable. (make-shepherd-output-port): Rewrite second method to simplify and make a single 'display' call per line. --- modules/shepherd/comm.scm | 36 ++++++++++++++++-------------------- 1 file changed, 16 insertions(+), 20 deletions(-) diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm index 596a258..e686bfa 100644 --- a/modules/shepherd/comm.scm +++ b/modules/shepherd/comm.scm @@ -216,6 +216,9 @@ on service '~a':") ;; 'strftime' format strings for entries in the log file. (make-parameter default-logfile-date-format)) +(define %not-newline + (char-set-complement (char-set #\newline))) + ;; We provide our own output mechanism, because we have certain ;; special needs; most importantly, we want to send output to herd ;; sometimes. @@ -242,26 +245,19 @@ on service '~a':") ;; completed line. (if (not (string-index str #\newline)) (set! buffer (cons str buffer)) - (let* ((log (lambda (x) - (display x (log-output-port)))) - (init-line (lambda () - (log (strftime (%current-logfile-date-format) - (localtime (current-time))))))) - (init-line) - (for-each log (reverse buffer)) - (let* ((lines (string-split str #\newline)) - (last-line (car (take-right lines 1))) - (is-first #t)) - (for-each (lambda (line) - (if is-first - (set! is-first #f) - (init-line)) - (log line) - (log #\newline)) - (drop-right lines 1)) - (set! buffer (if (string-null? last-line) - '() - (list last-line)))))))) + (let* ((str (string-concatenate-reverse (cons str buffer))) + (lines (string-tokenize str %not-newline))) + (define prefix + (strftime (%current-logfile-date-format) + (localtime (current-time)))) + + ;; Make exactly one 'display' call per line to make sure we + ;; don't create several entries for each line. + (for-each (lambda (line) + (display (string-append prefix line "\n") + (log-output-port))) + lines) + (set! buffer '()))))) ;; Flush output. (lambda ()