diff options
Diffstat (limited to 'lisp/org/ob-lisp.el')
| -rw-r--r-- | lisp/org/ob-lisp.el | 96 |
1 files changed, 57 insertions, 39 deletions
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 2f66549fc3d..d98098e1361 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -1,4 +1,4 @@ -;;; ob-lisp.el --- org-babel functions for common lisp evaluation +;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -21,21 +21,26 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: -;;; support for evaluating common lisp code, relies on slime for all eval +;;; Support for evaluating Common Lisp code, relies on SLY or SLIME +;;; for all eval. ;;; Requirements: -;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) -;; See http://common-lisp.net/project/slime/ +;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME +;; (Superior Lisp Interaction Mode for Emacs). See: +;; - https://github.com/capitaomorte/sly +;; - http://common-lisp.net/project/slime/ ;;; Code: (require 'ob) +(declare-function sly-eval "ext:sly" (sexp &optional package)) (declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) @@ -43,8 +48,16 @@ (defvar org-babel-default-header-args:lisp '()) (defvar org-babel-header-args:lisp '((package . :any))) +(defcustom org-babel-lisp-eval-fn #'slime-eval + "The function to be called to evaluate code on the Lisp side. +Valid values include `slime-eval' and `sly-eval'." + :group 'org-babel + :version "26.1" + :package-version '(Org . "9.0") + :type 'function) + (defcustom org-babel-lisp-dir-fmt - "(let ((*default-pathname-defaults* #P%S)) %%s)" + "(let ((*default-pathname-defaults* #P%S\n)) %%s\n)" "Format string used to wrap code bodies to set the current directory. For example a value of \"(progn ;; %s\\n %%s)\" would ignore the current directory string." @@ -54,49 +67,54 @@ current directory string." (defun org-babel-expand-body:lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "(%S (quote %S))" (car var) (cdr var))) - vars "\n ") - ")\n" body ")") - body)))) + (body (if (null vars) (org-trim body) + (concat "(let (" + (mapconcat + (lambda (var) + (format "(%S (quote %S))" (car var) (cdr var))) + vars "\n ") + ")\n" body ")")))) (if (or (member "code" result-params) (member "pp" result-params)) (format "(pprint %s)" body) body))) (defun org-babel-execute:lisp (body params) - "Execute a block of Common Lisp code with Babel." - (require 'slime) + "Execute a block of Common Lisp code with Babel. +BODY is the contents of the block, as a string. PARAMS is +a property list containing the parameters of the block." + (require (pcase org-babel-lisp-eval-fn + (`slime-eval 'slime) + (`sly-eval 'sly))) (org-babel-reassemble-table (let ((result - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - (car result) + (funcall (if (member "output" (cdr (assq :result-params params))) + #'car #'cadr) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (funcall org-babel-lisp-eval-fn + `(swank:eval-and-grab-output + ,(let ((dir (if (assq :dir params) + (cdr (assq :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s\n)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result (condition-case nil - (read (org-babel-lisp-vector-to-list (cadr result))) - (error (cadr result))))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))) + (read (org-babel-lisp-vector-to-list result)) + (error result)))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params))))) (defun org-babel-lisp-vector-to-list (results) ;; TODO: better would be to replace #(...) with [...] |