| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2010-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Authors: Thorsten Jolitz | |
| 6 | ;; Eric Schulte | |
| 7 | ;; Keywords: literate programming, reproducible research | |
| 8 | ;; Homepage: 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 | ;; This library enables the use of PicoLisp in the multi-language | |
| 28 | ;; programming framework Org-Babel. PicoLisp is a minimal yet | |
| 29 | ;; fascinating lisp dialect and a highly productive application | |
| 30 | ;; framework for web-based client-server applications on top of | |
| 31 | ;; object-oriented databases. A good way to learn PicoLisp is to first | |
| 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: | |
| 37 | ;; http://software-lab.de/down.html. It ships with a picolisp-mode and | |
| 38 | ;; an 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, an Emacs library written | |
| 43 | ;; in Emacs Lisp, PicoLisp has at least two outstanding features that | |
| 44 | ;; 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 | |
| 48 | ;; first-class members of the language. | |
| 49 | ||
| 50 | ;; PicoLisp is an extremely productive framework for the development | |
| 51 | ;; of interactive web-applications (on top of a database). | |
| 52 | ||
| 53 | ;;; Requirements: | |
| 54 | ||
| 55 | ;;; Code: | |
| 56 | (require 'ob) | |
| 57 | (require 'comint) | |
| 58 | ||
| 59 | (declare-function run-picolisp "ext:inferior-picolisp" (cmd)) | |
| 60 | (defvar org-babel-tangle-lang-exts) ;; Autoloaded | |
| 61 | ||
| 62 | ;; optionally define a file extension for this language | |
| 63 | (add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l")) | |
| 64 | ||
| 65 | ;;; interferes with settings in org-babel buffer? | |
| 66 | ;; optionally declare default header arguments for this language | |
| 67 | ;; (defvar org-babel-default-header-args:picolisp | |
| 68 | ;; '((:colnames . "no")) | |
| 69 | ;; "Default arguments for evaluating a picolisp source block.") | |
| 70 | ||
| 71 | (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" | |
| 72 | "String to indicate that evaluation has completed.") | |
| 73 | ||
| 74 | (defcustom org-babel-picolisp-cmd "pil" | |
| 75 | "Name of command used to evaluate picolisp blocks." | |
| 76 | :group 'org-babel | |
| 77 | :version "24.1" | |
| 78 | :type 'string) | |
| 79 | ||
| 80 | (defun org-babel-expand-body:picolisp (body params) | |
| 81 | "Expand BODY according to PARAMS, return the expanded body." | |
| 82 | (let ((vars (org-babel--get-vars params)) | |
| 83 | (print-level nil) | |
| 84 | (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 (assq :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-params (cdr (assq :result-params params))) | |
| 107 | ;; Expand the body with `org-babel-expand-body:picolisp'. | |
| 108 | (full-body (org-babel-expand-body:picolisp body params)) | |
| 109 | ;; Wrap body appropriately for the type of evaluation and results. | |
| 110 | (wrapped-body | |
| 111 | (cond | |
| 112 | ((or (member "code" result-params) | |
| 113 | (member "pp" result-params)) | |
| 114 | (format "(pretty (out \"/dev/null\" %s))" full-body)) | |
| 115 | ((and (member "value" result-params) (not session)) | |
| 116 | (format "(print (out \"/dev/null\" %s))" full-body)) | |
| 117 | ((member "value" result-params) | |
| 118 | (format "(out \"/dev/null\" %s)" full-body)) | |
| 119 | (t full-body))) | |
| 120 | (result | |
| 121 | (if (not (string= session-name "none")) | |
| 122 | ;; Session based evaluation. | |
| 123 | (mapconcat ;; <- joins the list back into a single string | |
| 124 | #'identity | |
| 125 | (butlast ;; <- remove the org-babel-picolisp-eoe line | |
| 126 | (delq nil | |
| 127 | (mapcar | |
| 128 | (lambda (line) | |
| 129 | (org-babel-chomp ;; Remove trailing newlines. | |
| 130 | (when (> (length line) 0) ;; Remove empty lines. | |
| 131 | (cond | |
| 132 | ;; Remove leading "-> " from return values. | |
| 133 | ((and (>= (length line) 3) | |
| 134 | (string= "-> " (substring line 0 3))) | |
| 135 | (substring line 3)) | |
| 136 | ;; Remove trailing "-> <<return-value>>" on the | |
| 137 | ;; last line of output. | |
| 138 | ((and (member "output" result-params) | |
| 139 | (string-match-p "->" line)) | |
| 140 | (substring line 0 (string-match "->" line))) | |
| 141 | (t line) | |
| 142 | ) | |
| 143 | ;;(if (and (>= (length line) 3);Remove leading "<-" | |
| 144 | ;; (string= "-> " (substring line 0 3))) | |
| 145 | ;; (substring line 3) | |
| 146 | ;; line) | |
| 147 | ))) | |
| 148 | ;; Returns a list of the output of each evaluated exp. | |
| 149 | (org-babel-comint-with-output | |
| 150 | (session org-babel-picolisp-eoe) | |
| 151 | (insert wrapped-body) (comint-send-input) | |
| 152 | (insert "'" org-babel-picolisp-eoe) | |
| 153 | (comint-send-input))))) | |
| 154 | "\n") | |
| 155 | ;; external evaluation | |
| 156 | (let ((script-file (org-babel-temp-file "picolisp-script-"))) | |
| 157 | (with-temp-file script-file | |
| 158 | (insert (concat wrapped-body "(bye)"))) | |
| 159 | (org-babel-eval | |
| 160 | (format "%s %s" | |
| 161 | org-babel-picolisp-cmd | |
| 162 | (org-babel-process-file-name script-file)) | |
| 163 | ""))))) | |
| 164 | (org-babel-result-cond result-params | |
| 165 | result | |
| 166 | (read result)))) | |
| 167 | ||
| 168 | (defun org-babel-picolisp-initiate-session (&optional session-name) | |
| 169 | "If there is not a current inferior-process-buffer in SESSION | |
| 170 | then create. Return the initialized session." | |
| 171 | (unless (string= session-name "none") | |
| 172 | (require 'inferior-picolisp) | |
| 173 | ;; provide a reasonable default session name | |
| 174 | (let ((session (or session-name "*inferior-picolisp*"))) | |
| 175 | ;; check if we already have a live session by this name | |
| 176 | (if (org-babel-comint-buffer-livep session) | |
| 177 | (get-buffer session) | |
| 178 | (save-window-excursion | |
| 179 | (run-picolisp org-babel-picolisp-cmd) | |
| 180 | (rename-buffer session-name) | |
| 181 | (current-buffer)))))) | |
| 182 | ||
| 183 | (provide 'ob-picolisp) | |
| 184 | ||
| 185 | ||
| 186 | ||
| 187 | ;;; ob-picolisp.el ends here | |
