Function: ielm-eval-input

ielm-eval-input is a byte-compiled function defined in ielm.el.gz.

Signature

(ielm-eval-input INPUT-STRING &optional FOR-EFFECT)

Documentation

Evaluate the Lisp expression INPUT-STRING, and pretty-print the result.

Source Code

;; Defined in /usr/src/emacs/lisp/ielm.el.gz
(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
  ;; what that input is.  What this function does is evaluates that
  ;; input and produces `output' which gets inserted into the buffer,
  ;; along with a new prompt.  A better way of doing this might have
  ;; been to actually send the output to the `cat' process, and write
  ;; 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.
  (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 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 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 form.
              (let* ((*1 (bound-and-true-p *))
                     (*2 (bound-and-true-p **))
                     (*3 (bound-and-true-p ***))
                     (active-process (ielm-process))
                     (old-standard-output standard-output)
                     new-standard-output
                     ielm-temp-buffer)
                (set-match-data ielm-match-data)
                (save-excursion
                  (with-temp-buffer
                    (condition-case-unless-debug err
                        (unwind-protect
                            ;; The next let form creates default
                            ;; bindings for *, ** and ***.  But
                            ;; these default bindings are
                            ;; identical to the ielm-local
                            ;; bindings.  Hence, during the
                            ;; evaluation of form, the
                            ;; ielm-local values are going to be
                            ;; used in all buffers except for
                            ;; other ielm buffers, which override
                            ;; them.  Normally, the variables *1,
                            ;; *2 and *3 also have default
                            ;; bindings, which are not overridden.
                            (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 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))
                          (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 error-type "IELM error")
            (setq result "More than one sexp in input"))))

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

      (goto-char pmark)
      (unless error-type
        (condition-case err
            ;; Self-referential objects cause loops in the printer, so
            ;; trap quits here. May as well do errors, too
            (unless for-effect
              (let* ((ielmbuf (current-buffer))
                     (aux (let ((str (eval-expression-print-format result)))
			    (if str (propertize str 'font-lock-face 'shadow)))))
                (setq output (with-temp-buffer
                               (let ((tmpbuf (current-buffer)))
                                 ;; Use print settings (e.g. print-circle,
                                 ;; print-gensym, etc...) from the
                                 ;; right buffer!
                                 (with-current-buffer ielmbuf
                                   (cl-prin1 result tmpbuf))
                                 (pp-buffer)
                                 (concat (buffer-string) aux))))))
          (error
           (setq error-type "IELM Error")
           (setq result (format "Error during pretty-printing: %S" err)))
          (quit  (setq error-type "IELM Error")
                 (setq result "Quit during pretty-printing"))))
      (if error-type
          (progn
            (when ielm-noisy (ding))
            (setq output (concat output
                                 "*** " error-type " ***  "
                                 result)))
        ;; There was no error, so shift the *** values
        (setq *** (bound-and-true-p **))
        (setq ** (bound-and-true-p *))
        (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)))