diff options
Diffstat (limited to 'lisp/org/ob-lisp.el')
| -rw-r--r-- | lisp/org/ob-lisp.el | 140 |
1 files changed, 67 insertions, 73 deletions
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 1a8ad38a199..97e8a97b24b 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -1,35 +1,30 @@ -;;; ob-lisp.el --- org-babel functions for Common Lisp +;;; ob-lisp.el --- org-babel functions for common lisp evaluation -;; Copyright (C) 2010-2011 Free Software Foundation +;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. -;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte -;; Keywords: literate programming, reproducible research, lisp +;; Author: Joel Boehland, Eric Schulte, David T. O'Toole <dto@gnu.org> +;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 -;;; License: +;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: -;; Now working with SBCL for both session and external evaluation. -;; -;; This certainly isn't optimally robust, but it seems to be working -;; for the basic use cases. +;;; support for evaluating common lisp code, relies on slime for all eval ;;; Requirements: @@ -38,75 +33,74 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (declare-function slime-eval "ext:slime" (sexp &optional package)) -(declare-function slime-process "ext:slime" (&optional connection)) -(declare-function slime-connected-p "ext:slime" ()) -(defvar org-babel-default-header-args:lisp '() - "Default header arguments for lisp code blocks.") +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) -(defcustom org-babel-lisp-cmd "sbcl --script" - "Name of command used to evaluate lisp blocks." +(defvar org-babel-default-header-args:lisp '()) +(defvar org-babel-header-arg-names:lisp '(package)) + +(defcustom org-babel-lisp-dir-fmt + "(let ((*default-pathname-defaults* #P%S)) %%s)" + "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." :group 'org-babel :type '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)))) - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body ")") + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :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)))) + (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 Lisp code with org-babel. -This function is called by `org-babel-execute-src-block'" - (require 'slime) - (message "executing Lisp source code block") - (let* ((session (org-babel-lisp-initiate-session - (cdr (assoc :session params)))) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:lisp body params))) - (read - (if session - ;; session evaluation - (save-window-excursion - (cadr (slime-eval `(swank:eval-and-grab-output ,full-body)))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "lisp-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format "(print %s)" full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-lisp-cmd - (org-babel-process-file-name script-file)) "")))))) - -;; This function should be used to assign any variables in params in -;; the context of the session environment. -(defun org-babel-prep-session:lisp (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (error "not yet implemented")) - -(defun org-babel-lisp-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." + "Execute a block of Common Lisp code with Babel." (require 'slime) - (unless (string= session "none") - (save-window-excursion - (or (slime-connected-p) - (slime-process))))) + (org-babel-reassemble-table + ((lambda (result) + (if (member "output" (cdr (assoc :result-params params))) + (car result) + (condition-case nil + (read (org-bable-lisp-vector-to-list (cadr result))) + (error (cadr 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-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))) + +(defun org-bable-lisp-vector-to-list (results) + ;; TODO: better would be to replace #(...) with [...] + (replace-regexp-in-string "#(" "(" results)) (provide 'ob-lisp) +;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d ;;; ob-lisp.el ends here |