Created
May 6, 2020 03:40
-
-
Save lawlist/6b9da6e3199e2a5ebf581655b3c0ba4c to your computer and use it in GitHub Desktop.
Demonstration creating a running process with a let-bound process-environment.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; NOTE: The process output from the gls command tends to be truncated when both | |
;;; (1) _not_ using a process filter and (2) _not_ using a pipe. When _not_ using a | |
;;; process filter, the workaround is to use a pipe by either setting the variable | |
;;; `process-connection-type' to `nil`; or, using the `make-process' keyword/argument | |
;;; pair of :connection-type 'pipe. Said workaround, however, has the disadvantage | |
;;; of having all the output arriving in one fell swoop and window-start of the | |
;;; process output buffer is point-max of the output -- meaning that the output is | |
;;; not visible unless using a command such as recenter on the output window buffer. | |
(defun gls-example (&optional dir) | |
"Demonstration creating a running process with a let-bound process-environment." | |
(interactive) | |
(let* ((directory (cond | |
(dir (directory-file-name dir)) | |
(t | |
(directory-file-name default-directory)))) | |
(default-directory directory) | |
(my-process-buffer (get-buffer-create "*GLS-BUFFER*")) | |
(my-process-filter | |
(lambda (proc string) | |
(let (point) | |
(with-current-buffer (process-buffer proc) | |
(insert string) | |
(setq point (point))) | |
(set-window-point (get-buffer-window (process-buffer proc)) point)))) | |
(my-start-process | |
;;; This is a variation of `start-process' that modifies the | |
;;; process environment on a let-bound-basis | |
(lambda (name buffer program &rest program-args) | |
(unless (fboundp 'make-process) | |
(error "Emacs was compiled without subprocess support")) | |
(let* ((macports (concat user-emacs-directory ".0.macports/bin")) | |
(path (concat macports ":" (getenv "PATH"))) | |
(temp (mapcar 'concat process-environment)) | |
(newenv (setenv-internal temp "PATH" path t)) | |
(process-environment newenv)) | |
(apply #'make-process | |
(append (list :name name :buffer buffer) | |
(when program | |
(list :command (cons program program-args))))))))) | |
(display-buffer my-process-buffer t) | |
(with-current-buffer my-process-buffer | |
(setq truncate-lines t) | |
(erase-buffer)) | |
(set-process-sentinel | |
(let ((proc (funcall my-start-process | |
"my-process-name" | |
my-process-buffer | |
"/bin/bash" "-c" "gls -la"))) | |
(set-process-filter proc `(lambda (proc string) | |
(funcall ,my-process-filter proc string))) | |
proc) | |
(lambda (p e) (when (= 0 (process-exit-status p)) | |
(message "Congratulations -- process executed normally!")))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment