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