ob-screen.el (5668B)
1 ;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 5 ;; Author: Benjamin Andresen 6 ;; Maintainer: Ken Mankoff <mankoff@gmail.com> 7 ;; Keywords: literate programming, interactive shell 8 ;; URL: https://orgmode.org 9 10 ;; This file is part of GNU Emacs. 11 12 ;; GNU Emacs is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; GNU Emacs is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; Org-Babel support for interactive terminals. Mostly shell scripts. 28 ;; Heavily inspired by 'eev' from Eduardo Ochs 29 ;; 30 ;; Adding :cmd and :terminal as header arguments 31 ;; :terminal must support the -T (title) and -e (command) parameter 32 ;; 33 ;; You can test the default setup (xterm + sh) with 34 ;; M-x org-babel-screen-test RET 35 36 ;;; Code: 37 38 (require 'org-macs) 39 (org-assert-version) 40 41 (require 'ob) 42 43 (defvar org-babel-screen-location "screen" 44 "The command location for screen. 45 In case you want to use a different screen than one selected by your $PATH") 46 47 (defvar org-babel-default-header-args:screen 48 `((:results . "silent") (:session . "default") (:cmd . "sh") 49 (:terminal . "xterm") (:screenrc . ,null-device)) 50 "Default arguments to use when running screen source blocks.") 51 52 (defun org-babel-execute:screen (body params) 53 "Send BODY via screen to a terminal using Babel, according to PARAMS. 54 \"default\" session is used when none is specified in the PARAMS." 55 (unless noninteractive (message "Sending source code block to interactive terminal session...")) 56 (save-window-excursion 57 (let* ((session (cdr (assq :session params))) 58 (socket (org-babel-screen-session-socketname session))) 59 (unless socket (org-babel-prep-session:screen session params)) 60 (org-babel-screen-session-execute-string 61 session (org-babel-expand-body:generic body params))))) 62 63 (defun org-babel-prep-session:screen (_session params) 64 "Prepare SESSION according to the header arguments specified in PARAMS." 65 (let* ((session (cdr (assq :session params))) 66 (cmd (cdr (assq :cmd params))) 67 (terminal (cdr (assq :terminal params))) 68 (screenrc (cdr (assq :screenrc params))) 69 (process-name (concat "org-babel: terminal (" session ")"))) 70 (apply 'start-process process-name "*Messages*" 71 terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location 72 "-c" ,screenrc "-mS" ,session ,cmd)) 73 ;; XXX: Is there a better way than the following? 74 (while (not (org-babel-screen-session-socketname session)) 75 ;; wait until screen session is available before returning 76 ))) 77 78 ;; helper functions 79 80 (defun org-babel-screen-session-execute-string (session body) 81 "If SESSION exists, send BODY to it." 82 (let ((socket (org-babel-screen-session-socketname session))) 83 (when socket 84 (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) 85 (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" 86 org-babel-screen-location 87 `("-S" ,socket "-X" "eval" "msgwait 0" 88 ,(concat "readreg z " tmpfile) 89 "paste z")))))) 90 91 (defun org-babel-screen-session-socketname (session) 92 "Check if SESSION exists by parsing output of \"screen -ls\"." 93 (let* ((screen-ls (shell-command-to-string "screen -ls")) 94 (sockets (delq 95 nil 96 (mapcar 97 (lambda (x) 98 (when (string-match (rx (or "(Attached)" "(Detached)")) x) 99 x)) 100 (split-string screen-ls "\n")))) 101 (match-socket (car 102 (delq 103 nil 104 (mapcar 105 (lambda (x) 106 (and (string-match-p (regexp-quote session) x) 107 x)) 108 sockets))))) 109 (when match-socket (car (split-string match-socket))))) 110 111 (defun org-babel-screen-session-write-temp-file (_session body) 112 "Save BODY in a temp file that is named after SESSION." 113 (let ((tmpfile (org-babel-temp-file "screen-"))) 114 (with-temp-file tmpfile 115 (insert body) 116 (insert "\n") 117 118 ;; org-babel has superfluous spaces 119 (goto-char (point-min)) 120 (delete-matching-lines "^ +$")) 121 tmpfile)) 122 123 (defun org-babel-screen-test () 124 "Test if the default setup works. 125 The terminal should shortly flicker." 126 (interactive) 127 (let* ((random-string (format "%s" (random 99999))) 128 (tmpfile (org-babel-temp-file "ob-screen-test-")) 129 (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) 130 tmp-string) 131 (org-babel-execute:screen body org-babel-default-header-args:screen) 132 ;; XXX: need to find a better way to do the following 133 (while (not (file-readable-p tmpfile)) 134 ;; do something, otherwise this will be optimized away 135 (message "org-babel-screen: File not readable yet.")) 136 (setq tmp-string (with-temp-buffer 137 (insert-file-contents-literally tmpfile) 138 (buffer-substring (point-min) (point-max)))) 139 (delete-file tmpfile) 140 (message (concat "org-babel-screen: Setup " 141 (if (string-match random-string tmp-string) 142 "WORKS." 143 "DOESN'T work."))))) 144 145 (provide 'ob-screen) 146 147 ;;; ob-screen.el ends here