Re: ielm changes: display standard-output in buffer

[Daniel Colascione]

On 9/27/13 5:46 PM, Stefan Monnier wrote:>> +(defun ielm-standard-output-impl 
(char)
>> +  "`standard-output' while evaluating in ielm."
>> +  (push char ielm-output-buffer)
>> +  (when (eq char ?\n)
>> +    (comint-output-filter
>> +     ielm-active-process
>> +     (apply #'string (nreverse ielm-output-buffer)))
>> +    (setf ielm-output-buffer nil)))
>
> You could avoid the two global vars with:
>
>    (defun ielm-standard-output-impl (proc)
>      "`standard-output' while evaluating in ielm."
>      (let ((buffer nil))
>        (lambda (char)
>          (push char buffer)
>          (when (eq char ?\n)
>            (comint-output-filter proc (apply #'string (nreverse buffer)))
>            (setf buffer nil)))))

Good idea.

>
>> +                    (ielm-active-process (ielm-process))
>> +                    (ielm-output-buffer nil)
>> +                    (standard-output #'ielm-standard-output-impl)
>
> And here do (standard-output (ielm-standard-output-impl (ielm-process)))
>
> I do have one objection to the patch, tho: it resets standard-output
> after each IELM command, so you can't use (setq standard-output <foo>) RET
> and then (princ <bar>) RET and expect <bar> to be sent to <foo> any more.
>
> Maybe a buffer-local setting (instead of a let-binding) of
> standard-output would solve this problem?

I've changed the code so that we don't bind standard-output anymore,
but instead explicitly set and reset it, skipping the reset if the
value changed while we evaluated the form. I've also added a flush
timer so that we don't need to wait for a while line of output to
accumulate before displaying output.  (Imagine a loop that calls
(princ ".") occasionally to indicate progress.)

I've also added an ielm-return-for-effect mode and bound C-M-RET to
it.  This function works like ielm-return, except that it doesn't
print the result of evaluating the input expression.  This
functionality is useful when the expression evaluates to something
voluminous and useless.

=== modified file 'lisp/ielm.el'
--- lisp/ielm.el        2013-05-30 03:30:34 +0000
+++ lisp/ielm.el        2013-10-03 06:14:15 +0000
@@ -1,3 +1,4 @@
+;;; -*- lexical-binding: t -*-
 ;;; ielm.el --- interaction mode for Emacs Lisp

 ;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
@@ -169,6 +170,7 @@
   (let ((map (make-sparse-keymap)))
     (define-key map "\t" 'completion-at-point)
     (define-key map "\C-m" 'ielm-return)
+    (define-key map "\e\C-m" 'ielm-return-for-effect)
     (define-key map "\C-j" 'ielm-send-input)
     (define-key map "\e\C-x" 'eval-defun)         ; for consistency with
     (define-key map "\e\t" 'completion-at-point)  ; lisp-interaction-mode
@@ -264,7 +266,7 @@

 ;;; Other bindings

-(defun ielm-return nil
+(defun ielm-return (&optional for-effect)
   "Newline and indent, or evaluate the sexp before the prompt.
 Complete sexps are evaluated; for incomplete sexps inserts a newline
 and indents.  If however `ielm-dynamic-return' is nil, this always
@@ -277,7 +279,7 @@
               (parse-partial-sexp (ielm-pm)
                                   (point)))))
        (if (and (< (car state) 1) (not (nth 3 state)))
-           (ielm-send-input)
+            (ielm-send-input for-effect)
          (when (and ielm-dynamic-multiline-inputs
                     (save-excursion
                       (beginning-of-line)
@@ -288,6 +290,11 @@
          (newline-and-indent)))
     (newline)))

+(defun ielm-return-for-effect ()
+  "Like `ielm-return', but do not print the result."
+  (interactive)
+  (ielm-return t))
+
 (defvar ielm-input)

 (defun ielm-input-sender (_proc input)
@@ -295,12 +302,12 @@
   ;; `ielm-send-input's call.
   (setq ielm-input input))

-(defun ielm-send-input nil
+(defun ielm-send-input (&optional for-effect)
   "Evaluate the Emacs Lisp expression after the prompt."
   (interactive)
   (let (ielm-input)                    ; set by ielm-input-sender
     (comint-send-input)                        ; update history, markers etc.
-    (ielm-eval-input ielm-input)))
+    (ielm-eval-input ielm-input for-effect)))

 ;;; Utility functions

@@ -311,16 +318,42 @@

 ;;; Evaluation

-(defvar ielm-string)
-(defvar ielm-form)
-(defvar ielm-pos)
-(defvar ielm-result)
-(defvar ielm-error-type)
-(defvar ielm-output)
-(defvar ielm-wbuf)
-(defvar ielm-pmark)
+(defun ielm-standard-output-impl (process)
+  "Return a function to use for `standard-output' while in ielm eval.
+The returned function takes one character as input.  Passing nil
+to this function instead of a character flushes the output
+buffer.  Passing t appends a terminating newline if the buffer is
+nonempty, then flushes the buffer."
+  ;; Use an intermediate output buffer because doing redisplay for
+  ;; each character we output is too expensive.  Set up a flush timer
+  ;; so that users don't have to wait for whole lines to appear before
+  ;; seeing output.
+  (let* ((output-buffer nil)
+         (flush-timer nil)
+         (flush-buffer
+          (lambda ()
+            (comint-output-filter
+             process
+             (apply #'string (nreverse output-buffer)))
+            (redisplay)
+            (setf output-buffer nil)
+            (when flush-timer
+              (cancel-timer flush-timer)
+              (setf flush-timer nil)))))
+    (lambda (char)
+      (let (flush-now)
+        (cond ((and (eq char t) output-buffer)
+               (push ?\n output-buffer)
+               (setf flush-now t))
+              ((characterp char)
+               (push char output-buffer)
+               (setf flush-now (eq char ?\n))))
+        (if flush-now
+            (funcall flush-buffer)
+          (unless flush-timer
+            (setf flush-timer (run-with-timer 0.1 nil flush-buffer)))))))))

-(defun ielm-eval-input (input-string)
+(defun ielm-eval-input (input-string &optional for-effect)
   "Evaluate the Lisp expression INPUT-STRING, and pretty-print the result."
   ;; This is the function that actually `sends' the input to the
   ;; `inferior Lisp process'. All comint-send-input does is works out
@@ -331,41 +364,41 @@
   ;; this as in output filter that converted sexps in the output
   ;; stream to their evaluated value.  But that would have involved
   ;; more process coordination than I was happy to deal with.
-  ;;
-  ;; NOTE: all temporary variables in this function will be in scope
-  ;; during the eval, and so need to have non-clashing names.
-  (let ((ielm-string input-string)      ; input expression, as a string
-        ielm-form                      ; form to evaluate
-       ielm-pos                        ; End posn of parse in string
-       ielm-result                     ; Result, or error message
-       ielm-error-type                 ; string, nil if no error
-       (ielm-output "")                ; result to display
-       (ielm-wbuf ielm-working-buffer) ; current buffer after evaluation
-       (ielm-pmark (ielm-pm)))
-    (unless (ielm-is-whitespace-or-comment ielm-string)
+  (let ((string input-string)        ; input expression, as a string
+        form                         ; form to evaluate
+        pos                          ; End posn of parse in string
+        result                       ; Result, or error message
+        error-type                   ; string, nil if no error
+        (output "")                  ; result to display
+        (wbuf ielm-working-buffer)   ; current buffer after evaluation
+        (pmark (ielm-pm)))
+    (unless (ielm-is-whitespace-or-comment string)
       (condition-case err
-         (let ((rout (read-from-string ielm-string)))
-           (setq ielm-form (car rout)
-                 ielm-pos (cdr rout)))
-       (error (setq ielm-result (error-message-string err))
-              (setq ielm-error-type "Read error")))
-      (unless ielm-error-type
+          (let ((rout (read-from-string string)))
+            (setq form (car rout)
+                  pos (cdr rout)))
+        (error (setq result (error-message-string err))
+               (setq error-type "Read error")))
+      (unless error-type
        ;; Make sure working buffer has not been killed
        (if (not (buffer-name ielm-working-buffer))
-           (setq ielm-result "Working buffer has been killed"
-                 ielm-error-type "IELM Error"
-                 ielm-wbuf (current-buffer))
-         (if (ielm-is-whitespace-or-comment (substring ielm-string ielm-pos))
+            (setq result "Working buffer has been killed"
+                  error-type "IELM Error"
+                  wbuf (current-buffer))
+          (if (ielm-is-whitespace-or-comment (substring string pos))
              ;; To correctly handle the ielm-local variables *,
              ;; ** and ***, we need a temporary buffer to be
              ;; current at entry to the inner of the next two let
              ;; forms.  We need another temporary buffer to exit
              ;; that same let.  To avoid problems, neither of
              ;; these buffers should be alive during the
-             ;; evaluation of ielm-form.
-             (let ((*1 *)
+              ;; evaluation of form.
+              (let* ((*1 *)
                    (*2 **)
                    (*3 ***)
+                     (active-process (ielm-process))
+                     (old-standard-output standard-output)
+                     new-standard-output
                    ielm-temp-buffer)
                (set-match-data ielm-match-data)
                (save-excursion
@@ -377,7 +410,7 @@
                             ;; these default bindings are
                             ;; identical to the ielm-local
                             ;; bindings.  Hence, during the
-                            ;; evaluation of ielm-form, the
+                            ;; evaluation of form, the
                             ;; ielm-local values are going to be
                             ;; used in all buffers except for
                             ;; other ielm buffers, which override
@@ -387,52 +420,63 @@
                             (let ((* *1)
                                   (** *2)
                                   (*** *3))
+                              (when (eq standard-output t)
+                                (setf new-standard-output
+                                      (ielm-standard-output-impl
+                                       active-process))
+                                (setf standard-output new-standard-output))
                               (kill-buffer (current-buffer))
-                              (set-buffer ielm-wbuf)
-                              (setq ielm-result
-                                     (eval ielm-form lexical-binding))
-                              (setq ielm-wbuf (current-buffer))
+                              (set-buffer wbuf)
+                              (setq result
+                                    (eval form lexical-binding))
+                              (setq wbuf (current-buffer))
                               (setq
                                ielm-temp-buffer
                                (generate-new-buffer " *ielm-temp*"))
                               (set-buffer ielm-temp-buffer))
                          (when ielm-temp-buffer
-                           (kill-buffer ielm-temp-buffer)))
-                     (error (setq ielm-result (error-message-string err))
-                            (setq ielm-error-type "Eval error"))
-                     (quit (setq ielm-result "Quit during evaluation")
-                           (setq ielm-error-type "Eval error")))))
+                            (kill-buffer ielm-temp-buffer))
+                          (when (eq new-standard-output standard-output)
+                            (ignore-errors
+                              (funcall standard-output t))
+                            (setf standard-output old-standard-output)))
+                      (error (setq result (error-message-string err))
+                             (setq error-type "Eval error"))
+                      (quit (setq result "Quit during evaluation")
+                            (setq error-type "Eval error")))))
                (setq ielm-match-data (match-data)))
-           (setq ielm-error-type "IELM error")
-           (setq ielm-result "More than one sexp in input"))))
+            (setq error-type "IELM error")
+            (setq result "More than one sexp in input"))))

       ;; If the eval changed the current buffer, mention it here
-      (unless (eq ielm-wbuf ielm-working-buffer)
-       (message "current buffer is now: %s" ielm-wbuf)
-       (setq ielm-working-buffer ielm-wbuf))
+      (unless (eq wbuf ielm-working-buffer)
+        (message "current buffer is now: %s" wbuf)
+        (setq ielm-working-buffer wbuf))

-      (goto-char ielm-pmark)
-      (unless ielm-error-type
+      (goto-char pmark)
+      (unless error-type
        (condition-case nil
            ;; Self-referential objects cause loops in the printer, so
            ;; trap quits here. May as well do errors, too
-           (setq ielm-output (concat ielm-output (pp-to-string ielm-result)))
-         (error (setq ielm-error-type "IELM Error")
-                (setq ielm-result "Error during pretty-printing (bug in pp)"))
-         (quit  (setq ielm-error-type "IELM Error")
-                (setq ielm-result "Quit during pretty-printing"))))
-      (if ielm-error-type
+            (unless for-effect
+              (setq output (concat output (pp-to-string result))))
+          (error (setq error-type "IELM Error")
+                 (setq result "Error during pretty-printing (bug in pp)"))
+          (quit  (setq error-type "IELM Error")
+                 (setq result "Quit during pretty-printing"))))
+      (if error-type
          (progn
            (when ielm-noisy (ding))
-           (setq ielm-output (concat ielm-output "*** " ielm-error-type " ***  
"))
-           (setq ielm-output (concat ielm-output ielm-result)))
+            (setq output (concat output "*** " error-type " ***  "))
+            (setq output (concat output result)))
        ;; There was no error, so shift the *** values
        (setq *** **)
        (setq ** *)
-       (setq * ielm-result))
-      (setq ielm-output (concat ielm-output "\n")))
-    (setq ielm-output (concat ielm-output ielm-prompt-internal))
-    (comint-output-filter (ielm-process) ielm-output)))
+        (setq * result))
+      (when (or (not for-effect) (not (equal output "")))
+        (setq output (concat output "\n"))))
+    (setq output (concat output ielm-prompt-internal))
+    (comint-output-filter (ielm-process) output)))

 ;;; Process and marker utilities

@@ -462,6 +506,11 @@
   Inputs longer than one line are moved to the line following the
   prompt (but see variable `ielm-dynamic-multiline-inputs').

+* \\[ielm-return-for-effect] works like `ielm-return', except
+  that it doesn't print the result of evaluating the input.  This
+  functionality is useful when forms would generate voluminous
+  output.
+
 * \\[completion-at-point] completes Lisp symbols (or filenames, within 
strings),
   or indents the line if there is nothing to complete.

@@ -478,6 +527,13 @@
 buffer, then the values in the working buffer are used.  The variables
 `*1', `*2' and `*3', yield the process buffer values.

+If, at the start of evaluation, `standard-output' is `t' (the
+default), `standard-output' is set to a special function that
+causes output to be directed to the ielm buffer.
+`standard-output' is restored after evaluation unless explicitly
+set to a different value during evaluation.  You can use (princ
+VALUE) or (pp VALUE) to write to the ielm buffer.
+
 Expressions evaluated by IELM are not subject to `debug-on-quit' or
 `debug-on-error'.

signature.asc
Description: OpenPGP digital signature