Commit | Line | Data |
---|---|---|
e66ba1df BG |
1 | ;;; ob-picolisp.el --- org-babel functions for picolisp evaluation |
2 | ||
b9db31c7 | 3 | ;; Copyright (C) 2010-2012 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) | |
57 | (require 'ob-eval) | |
58 | (require 'ob-comint) | |
59 | (require 'comint) | |
60 | (eval-when-compile (require 'cl)) | |
61 | ||
62 | (declare-function run-picolisp "ext:inferior-picolisp" (cmd)) | |
bdebdb64 | 63 | (defvar org-babel-tangle-lang-exts) ;; Autoloaded |
e66ba1df BG |
64 | |
65 | ;; optionally define a file extension for this language | |
66 | (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l")) | |
67 | ||
68 | ;;; interferes with settings in org-babel buffer? | |
69 | ;; optionally declare default header arguments for this language | |
70 | ;; (defvar org-babel-default-header-args:picolisp | |
71 | ;; '((:colnames . "no")) | |
72 | ;; "Default arguments for evaluating a picolisp source block.") | |
73 | ||
74 | (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" | |
75 | "String to indicate that evaluation has completed.") | |
76 | ||
77 | (defcustom org-babel-picolisp-cmd "pil" | |
78 | "Name of command used to evaluate picolisp blocks." | |
79 | :group 'org-babel | |
372d7b21 | 80 | :version "24.1" |
e66ba1df BG |
81 | :type 'string) |
82 | ||
83 | (defun org-babel-expand-body:picolisp (body params &optional processed-params) | |
84 | "Expand BODY according to PARAMS, return the expanded body." | |
85 | (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) | |
86 | (result-params (cdr (assoc :result-params params))) | |
87 | (print-level nil) (print-length nil)) | |
88 | (if (> (length vars) 0) | |
89 | (concat "(prog (let (" | |
90 | (mapconcat | |
91 | (lambda (var) | |
92 | (format "%S '%S)" | |
93 | (print (car var)) | |
94 | (print (cdr var)))) | |
95 | vars "\n ") | |
96 | " \n" body ") )") | |
97 | body))) | |
98 | ||
99 | (defun org-babel-execute:picolisp (body params) | |
100 | "Execute a block of Picolisp code with org-babel. This function is | |
14e1337f | 101 | called by `org-babel-execute-src-block'" |
e66ba1df BG |
102 | (message "executing Picolisp source code block") |
103 | (let* ( | |
104 | ;; name of the session or "none" | |
105 | (session-name (cdr (assoc :session params))) | |
106 | ;; set the session if the session variable is non-nil | |
107 | (session (org-babel-picolisp-initiate-session session-name)) | |
108 | ;; either OUTPUT or VALUE which should behave as described above | |
109 | (result-type (cdr (assoc :result-type params))) | |
110 | (result-params (cdr (assoc :result-params params))) | |
111 | ;; expand the body with `org-babel-expand-body:picolisp' | |
112 | (full-body (org-babel-expand-body:picolisp body params)) | |
113 | ;; wrap body appropriately for the type of evaluation and results | |
114 | (wrapped-body | |
115 | (cond | |
116 | ((or (member "code" result-params) | |
117 | (member "pp" result-params)) | |
118 | (format "(pretty (out \"/dev/null\" %s))" full-body)) | |
119 | ((and (member "value" result-params) (not session)) | |
120 | (format "(print (out \"/dev/null\" %s))" full-body)) | |
121 | ((member "value" result-params) | |
122 | (format "(out \"/dev/null\" %s)" full-body)) | |
123 | (t full-body)))) | |
14e1337f | 124 | |
e66ba1df BG |
125 | ((lambda (result) |
126 | (if (or (member "verbatim" result-params) | |
127 | (member "scalar" result-params) | |
128 | (member "output" result-params) | |
129 | (member "code" result-params) | |
130 | (member "pp" result-params) | |
131 | (= (length result) 0)) | |
132 | result | |
133 | (read result))) | |
134 | (if (not (string= session-name "none")) | |
135 | ;; session based evaluation | |
136 | (mapconcat ;; <- joins the list back together into a single string | |
137 | #'identity | |
138 | (butlast ;; <- remove the org-babel-picolisp-eoe line | |
139 | (delq nil | |
140 | (mapcar | |
141 | (lambda (line) | |
142 | (org-babel-chomp ;; remove trailing newlines | |
143 | (when (> (length line) 0) ;; remove empty lines | |
144 | (cond | |
145 | ;; remove leading "-> " from return values | |
146 | ((and (>= (length line) 3) | |
147 | (string= "-> " (substring line 0 3))) | |
148 | (substring line 3)) | |
149 | ;; remove trailing "-> <<return-value>>" on the | |
150 | ;; last line of output | |
151 | ((and (member "output" result-params) | |
152 | (string-match-p "->" line)) | |
153 | (substring line 0 (string-match "->" line))) | |
154 | (t line) | |
155 | ) | |
156 | ;; (if (and (>= (length line) 3) ;; remove leading "<- " | |
157 | ;; (string= "-> " (substring line 0 3))) | |
158 | ;; (substring line 3) | |
159 | ;; line) | |
160 | ))) | |
161 | ;; returns a list of the output of each evaluated expression | |
162 | (org-babel-comint-with-output (session org-babel-picolisp-eoe) | |
163 | (insert wrapped-body) (comint-send-input) | |
164 | (insert "'" org-babel-picolisp-eoe) (comint-send-input))))) | |
165 | "\n") | |
166 | ;; external evaluation | |
167 | (let ((script-file (org-babel-temp-file "picolisp-script-"))) | |
168 | (with-temp-file script-file | |
169 | (insert (concat wrapped-body "(bye)"))) | |
170 | (org-babel-eval | |
171 | (format "%s %s" | |
172 | org-babel-picolisp-cmd | |
173 | (org-babel-process-file-name script-file)) | |
174 | "")))))) | |
175 | ||
176 | (defun org-babel-picolisp-initiate-session (&optional session-name) | |
177 | "If there is not a current inferior-process-buffer in SESSION | |
178 | then create. Return the initialized session." | |
179 | (unless (string= session-name "none") | |
180 | (require 'inferior-picolisp) | |
181 | ;; provide a reasonable default session name | |
182 | (let ((session (or session-name "*inferior-picolisp*"))) | |
183 | ;; check if we already have a live session by this name | |
184 | (if (org-babel-comint-buffer-livep session) | |
185 | (get-buffer session) | |
186 | (save-window-excursion | |
187 | (run-picolisp org-babel-picolisp-cmd) | |
188 | (rename-buffer session-name) | |
189 | (current-buffer)))))) | |
190 | ||
191 | (provide 'ob-picolisp) | |
192 | ||
193 | ||
194 | ||
195 | ;;; ob-picolisp.el ends here |