Commit | Line | Data |
---|---|---|
e66ba1df BG |
1 | ;;; ob-picolisp.el --- org-babel functions for picolisp evaluation |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
e66ba1df | 4 | |
c7e9ed79 | 5 | ;; Authors: Thorsten Jolitz |
dfd98937 | 6 | ;; Eric Schulte |
e66ba1df BG |
7 | ;; Keywords: literate programming, reproducible research |
8 | ;; Homepage: http://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 <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; This library enables the use of PicoLisp in the multi-language | |
8223b1d2 | 28 | ;; programming framework Org-Babel. PicoLisp is a minimal yet |
e66ba1df BG |
29 | ;; fascinating lisp dialect and a highly productive application |
30 | ;; framework for web-based client-server applications on top of | |
8223b1d2 | 31 | ;; object-oriented databases. A good way to learn PicoLisp is to first |
e66ba1df BG |
32 | ;; read Paul Grahams essay "The hundred year language" |
33 | ;; (http://www.paulgraham.com/hundred.html) and then study the various | |
34 | ;; documents and essays published in the PicoLisp wiki | |
35 | ;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some | |
36 | ;; GNU/Linux Distributions, and can be downloaded here: | |
8223b1d2 | 37 | ;; http://software-lab.de/down.html. It ships with a picolisp-mode and |
e66ba1df BG |
38 | ;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/ |
39 | ;; directory). | |
40 | ||
41 | ;; Although it might seem more natural to use Emacs Lisp for most | |
42 | ;; Lisp-based programming tasks inside Org-Mode, an Emacs library | |
43 | ;; written in Emacs Lisp, PicoLisp has at least two outstanding | |
44 | ;; features that make it a valuable addition to Org-Babel: | |
45 | ||
46 | ;; PicoLisp _is_ an object-oriented database with a Prolog-based query | |
47 | ;; language implemented in PicoLisp (Pilog). Database objects are | |
14e1337f | 48 | ;; first-class members of the language. |
e66ba1df BG |
49 | |
50 | ;; PicoLisp is an extremely productive framework for the development | |
14e1337f | 51 | ;; of interactive web-applications (on top of a database). |
e66ba1df BG |
52 | |
53 | ;;; Requirements: | |
54 | ||
55 | ;;; Code: | |
56 | (require 'ob) | |
e66ba1df BG |
57 | (require 'comint) |
58 | (eval-when-compile (require 'cl)) | |
59 | ||
60 | (declare-function run-picolisp "ext:inferior-picolisp" (cmd)) | |
bdebdb64 | 61 | (defvar org-babel-tangle-lang-exts) ;; Autoloaded |
e66ba1df BG |
62 | |
63 | ;; optionally define a file extension for this language | |
64 | (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l")) | |
65 | ||
66 | ;;; interferes with settings in org-babel buffer? | |
67 | ;; optionally declare default header arguments for this language | |
68 | ;; (defvar org-babel-default-header-args:picolisp | |
69 | ;; '((:colnames . "no")) | |
70 | ;; "Default arguments for evaluating a picolisp source block.") | |
71 | ||
72 | (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" | |
73 | "String to indicate that evaluation has completed.") | |
74 | ||
75 | (defcustom org-babel-picolisp-cmd "pil" | |
76 | "Name of command used to evaluate picolisp blocks." | |
77 | :group 'org-babel | |
372d7b21 | 78 | :version "24.1" |
e66ba1df BG |
79 | :type 'string) |
80 | ||
271672fa | 81 | (defun org-babel-expand-body:picolisp (body params) |
e66ba1df BG |
82 | "Expand BODY according to PARAMS, return the expanded body." |
83 | (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) | |
84 | (result-params (cdr (assoc :result-params params))) | |
85 | (print-level nil) (print-length nil)) | |
86 | (if (> (length vars) 0) | |
87 | (concat "(prog (let (" | |
88 | (mapconcat | |
89 | (lambda (var) | |
90 | (format "%S '%S)" | |
91 | (print (car var)) | |
92 | (print (cdr var)))) | |
93 | vars "\n ") | |
94 | " \n" body ") )") | |
95 | body))) | |
96 | ||
97 | (defun org-babel-execute:picolisp (body params) | |
98 | "Execute a block of Picolisp code with org-babel. This function is | |
14e1337f | 99 | called by `org-babel-execute-src-block'" |
e66ba1df BG |
100 | (message "executing Picolisp source code block") |
101 | (let* ( | |
666ffc7e | 102 | ;; Name of the session or "none". |
e66ba1df | 103 | (session-name (cdr (assoc :session params))) |
666ffc7e | 104 | ;; Set the session if the session variable is non-nil. |
e66ba1df | 105 | (session (org-babel-picolisp-initiate-session session-name)) |
666ffc7e | 106 | ;; Either OUTPUT or VALUE which should behave as described above. |
e66ba1df BG |
107 | (result-type (cdr (assoc :result-type params))) |
108 | (result-params (cdr (assoc :result-params params))) | |
666ffc7e | 109 | ;; Expand the body with `org-babel-expand-body:picolisp'. |
e66ba1df | 110 | (full-body (org-babel-expand-body:picolisp body params)) |
666ffc7e | 111 | ;; Wrap body appropriately for the type of evaluation and results. |
e66ba1df BG |
112 | (wrapped-body |
113 | (cond | |
114 | ((or (member "code" result-params) | |
115 | (member "pp" result-params)) | |
116 | (format "(pretty (out \"/dev/null\" %s))" full-body)) | |
117 | ((and (member "value" result-params) (not session)) | |
118 | (format "(print (out \"/dev/null\" %s))" full-body)) | |
119 | ((member "value" result-params) | |
120 | (format "(out \"/dev/null\" %s)" full-body)) | |
666ffc7e SM |
121 | (t full-body))) |
122 | (result | |
123 | (if (not (string= session-name "none")) | |
124 | ;; Session based evaluation. | |
125 | (mapconcat ;; <- joins the list back into a single string | |
126 | #'identity | |
127 | (butlast ;; <- remove the org-babel-picolisp-eoe line | |
128 | (delq nil | |
129 | (mapcar | |
130 | (lambda (line) | |
131 | (org-babel-chomp ;; Remove trailing newlines. | |
132 | (when (> (length line) 0) ;; Remove empty lines. | |
133 | (cond | |
134 | ;; Remove leading "-> " from return values. | |
135 | ((and (>= (length line) 3) | |
136 | (string= "-> " (substring line 0 3))) | |
137 | (substring line 3)) | |
138 | ;; Remove trailing "-> <<return-value>>" on the | |
139 | ;; last line of output. | |
140 | ((and (member "output" result-params) | |
141 | (string-match-p "->" line)) | |
142 | (substring line 0 (string-match "->" line))) | |
143 | (t line) | |
144 | ) | |
145 | ;;(if (and (>= (length line) 3);Remove leading "<-" | |
146 | ;; (string= "-> " (substring line 0 3))) | |
147 | ;; (substring line 3) | |
148 | ;; line) | |
149 | ))) | |
150 | ;; Returns a list of the output of each evaluated exp. | |
151 | (org-babel-comint-with-output | |
152 | (session org-babel-picolisp-eoe) | |
153 | (insert wrapped-body) (comint-send-input) | |
154 | (insert "'" org-babel-picolisp-eoe) | |
155 | (comint-send-input))))) | |
156 | "\n") | |
157 | ;; external evaluation | |
158 | (let ((script-file (org-babel-temp-file "picolisp-script-"))) | |
159 | (with-temp-file script-file | |
160 | (insert (concat wrapped-body "(bye)"))) | |
161 | (org-babel-eval | |
162 | (format "%s %s" | |
163 | org-babel-picolisp-cmd | |
164 | (org-babel-process-file-name script-file)) | |
165 | ""))))) | |
166 | (org-babel-result-cond result-params | |
167 | result | |
168 | (read result)))) | |
e66ba1df BG |
169 | |
170 | (defun org-babel-picolisp-initiate-session (&optional session-name) | |
171 | "If there is not a current inferior-process-buffer in SESSION | |
172 | then create. Return the initialized session." | |
173 | (unless (string= session-name "none") | |
174 | (require 'inferior-picolisp) | |
175 | ;; provide a reasonable default session name | |
176 | (let ((session (or session-name "*inferior-picolisp*"))) | |
177 | ;; check if we already have a live session by this name | |
178 | (if (org-babel-comint-buffer-livep session) | |
179 | (get-buffer session) | |
180 | (save-window-excursion | |
181 | (run-picolisp org-babel-picolisp-cmd) | |
182 | (rename-buffer session-name) | |
183 | (current-buffer)))))) | |
184 | ||
185 | (provide 'ob-picolisp) | |
186 | ||
187 | ||
188 | ||
189 | ;;; ob-picolisp.el ends here |