feature request - emacs utop redirect process output

[nverno]

I think it would be useful to be able to redirect utop process output in emacs, eg. to get history to supply candidates for hippie-completion.

Here's a quick attempt, but I don't quite understand the required state transistions for the utop process at this point. I know it's not comint-based, but the following almost works to temporarily dump the output from utop in another buffer,

(let ((comint-prompt-regexp "^prompt:")
      comint-redirect-perform-sanity-check
      mode-line-process)
  (comint-redirect-send-command-to-process
   (format "input:\ndata:%s\nend:\n" cmd) "*utop-redirect*" utop-process nil))

However, this results in the utop process exiting at various points during output to the other buffer. I would find a function like this useful, or any hints on how to properly implement that state transition. Thanks

[pmetzger]

Sounds like an interesting idea. My elisp isn't up to implementing it, but perhaps someone else's is, or perhaps you will figure it out first.

[nverno]

I ended up implementing a wrapper around comint-redirect-send-command-to-process, so something like (utop-redirect-output "module type S = module type of UTop" "*utop-output*" nil) will dump the output into a buffer named *utop-output*.

AFAICT utop doesn't indicate when it is done sending output, however, so during redirection it currently blocks momentarily while there is no pending input.

The utop-run-once is just used to allow utop-redirect-output to be called before the utop process is started. It allows the process to start normally, delaying redirection until after startup and utop's state is set to edit.

Anyway, I'll put the code here in case there is any interest in adding it

(defun utop-redirect-output (command output-buffer echo &optional no-display)
  "Send COMMAND to utop process with output to OUTPUT-BUFFER.
With prefix arg ECHO, echo output in utop buffer.
Redirection is handled by `comint-redirect-send-command-to-process', (which see)."
  (interactive "sCommand: \nBOutput Buffer: \nP")
  (if (get-buffer-process utop-buffer-name)
      (let ((proc (get-buffer-process utop-buffer-name))) ;lexical
        (unless (string-match-p ";;\\'" command)
          (setq command (concat command ";;")))
        (with-current-buffer utop-buffer-name
          ;; could just add this to utop's hook
          (add-hook 'comint-redirect-filter-functions
                    #'utop-redirect-filter nil t)
          (utop-prepare-for-eval)
          (let ((comint-prompt-regexp "^\\(?:__unused__\\)")
                ;; don't let comint check for prompt regexp in *utop* buffer
                comint-redirect-perform-sanity-check
                ;; comint's attempts to change mode-line fail with utop format
                mode-line-process)
            (comint-redirect-send-command-to-process
             (format "input:\ndata:%s\nend:" command)
             output-buffer proc echo no-display)))
        (while-no-input (while (accept-process-output proc 0.2)))
        (utop-redirect-cleanup))
    ;; the rest is only necessary to be able to call `utop-redirect-output'
    ;; before there is an active utop process
    ;; it starts `utop' via normal `utop-prepare-for-eval' sequence
    ;; delaying execution of `utop-redirect-output' until after both
    ;; `utop-start' is run and `utop-set-state' set's the state to 'edit
    (utop-run-once
     'utop-start :after
     #'utop-redirect-output 'edit command output-buffer echo no-display)
    (utop-prepare-for-eval)))

;; see `utop-process-line'; called from `comint-redirect-filter'
(defun utop-redirect-filter (lines)
  "Process utop output to insert in redirect buffer."
  (save-match-data
    (mapconcat
     #'identity
     (cl-loop for line in (split-string lines "\n" t " \n")
        if (string-match "\\`\\([a-z-]*\\):\\(.*\\)\\'" line)
        collect
          (let ((command (match-string 1 line))
                (argument (match-string 2 line)))
            (pcase command
              ((or "stderr" "stdout") argument)
              ;; don't output any other responses from utop
              (_))))
     "\n")))

(defun utop-redirect-cleanup ()
  "Restore utop process filter and state."
  (interactive)
  (with-current-buffer utop-buffer-name
    (interrupt-process utop-process)
    (comint-redirect-cleanup)
    (utop-set-state 'edit)))

(defun utop-run-once (func where callback &optional state &rest args)
  "Execute CALLBACK applied to ARGS once before or after FUNC is called.
WHERE can be :before or :after and is passed to `advice-add'.
Optionally, if STATE specifies one of `utop-state''s, the CALLBACK will run once 
after both FUNC is called and `utop-state' is set to STATE."
  (advice-add func where
              (progn
                (let ((name (intern (concat (symbol-name callback) "@once"))))
                  (defalias `,name
                    `(lambda (&rest _)
                       (,@(if (and state (eq func 'utop-set-state))
                              `(when (eq ',state utop-state)) '(progn))
                        (advice-remove ',func ',name)
                        ,(if (and state (not (eq func 'utop-set-state)))
                             `(utop-run-once
                               'utop-set-state :after ',callback ',state ,@args)
                           `(funcall ',callback ,@args)))))
                  name))))

[pmetzger]

If you want to provide code we could add to utop, you should do a pull request...

[nverno]

I would, but this is more of a hack than a proper solution since I didn't want to change any of the current code, eg. maybe add another state for redirection, and this doesn't have a suitable way to check when output from utop process is complete -- long running redirection will most likely be interrupted before completing.