ob-screen.el (5620B)
1 ;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2023 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 a block of code via screen to a terminal using Babel. 54 \"default\" session is used when none is specified." 55 (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