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