diff --git a/Makefile b/Makefile index 389b26888..641dbc353 100644 --- a/Makefile +++ b/Makefile @@ -18,8 +18,6 @@ prefix=/usr/local # Where local lisp files go. lispdir = $(prefix)/share/emacs/site-lisp -lispbdir = $(lispdir)/babel -lispbldir = $(lispbdir)/langs # Where info files go. infodir = $(prefix)/share/info @@ -31,11 +29,7 @@ infodir = $(prefix)/share/info # Using emacs in batch mode. BATCH=$(EMACS) -batch -q -no-site-file -eval \ - "(setq load-path (cons (expand-file-name\ - \"langs\"\ - (expand-file-name \"babel\" (expand-file-name \"./lisp/\")))\ - (cons (expand-file-name \"babel\" (expand-file-name \"./lisp/\"))\ - (cons (expand-file-name \"./lisp/\") (cons \"$(lispdir)\" load-path)))))" + "(setq load-path (cons (expand-file-name \"./lisp/\") (cons \"$(lispdir)\" load-path)))" # Specify the byte-compiler for compiling org-mode files ELC= $(BATCH) -f batch-byte-compile @@ -120,18 +114,17 @@ LISPF = org.el \ org-vm.el \ org-w3m.el \ org-wl.el \ - org-xoxo.el - -LISPBF = ob.el \ + org-xoxo.el \ + ob.el \ ob-table.el \ ob-lob.el \ ob-ref.el \ ob-exp.el \ ob-tangle.el \ ob-comint.el \ - ob-keys.el - -LISPBLF = ob-C.el \ + ob-eval.el \ + ob-keys.el \ + ob-C.el \ ob-ditaa.el \ ob-haskell.el \ ob-perl.el \ @@ -156,11 +149,8 @@ LISPBLF = ob-C.el \ LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el -LISPBFILES = $(LISPBF:%=lisp/babel/%) -LISPBLFILES = $(LISPBLF:%=lisp/babel/langs/%) ELCFILES0 = $(LISPFILES0:.el=.elc) ELCFILES = $(LISPFILES:.el=.elc) -ELCBFILES = $(LISPBFILES:.el=.elc) DOCFILES = doc/org.texi doc/org.pdf doc/org doc/dir \ doc/pdflayout.sty doc/.nosearch \ doc/orgguide.texi doc/orgguide.pdf @@ -200,15 +190,10 @@ p: g: ${MAKE} pdf && open doc/orgguide.pdf -install-lisp: $(LISPFILES) $(LISPBFILES) $(ELCFILES) +install-lisp: $(LISPFILES) $(ELCFILES) if [ ! -d $(lispdir) ]; then $(MKDIR) $(lispdir); else true; fi ; - if [ ! -d $(lispbdir) ]; then $(MKDIR) $(lispbdir); else true; fi ; - if [ ! -d $(lispbldir) ]; then $(MKDIR) $(lispbldir); else true; fi ; $(CP) $(LISPFILES) $(lispdir) $(CP) $(ELCFILES) $(lispdir) - $(CP) $(LISPBFILES) $(lispbdir) - $(CP) $(ELCBFILES) $(lispbdir) - $(CP) $(LISPBLFILES) $(lispbldir) install-info: $(INFOFILES) if [ ! -d $(infodir) ]; then $(MKDIR) $(infodir); else true; fi ; @@ -224,13 +209,11 @@ install-noutline: xemacs/noutline.elc autoloads: lisp/org-install.el -lisp/org-install.el: $(LISPFILES0) $(LISPBFILES) Makefile +lisp/org-install.el: $(LISPFILES0) Makefile $(BATCH) --eval "(require 'autoload)" \ --eval '(find-file "org-install.el")' \ --eval '(erase-buffer)' \ - --eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPFILES0) $(LISPBFILES))))' \ - --eval "(insert \"(add-to-list 'load-path (expand-file-name \\\"babel\\\" (file-name-directory (or load-file-name (buffer-file-name)))))\")" \ - --eval "(insert \"\n(add-to-list 'load-path (expand-file-name \\\"langs\\\" (expand-file-name \\\"babel\\\" (file-name-directory (or load-file-name (buffer-file-name))))))\")\n" \ + --eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPFILES0))))' \ --eval '(insert "\n(provide (quote org-install))\n")' \ --eval '(save-buffer)' mv org-install.el lisp @@ -300,10 +283,7 @@ distfile: $(MKDIR) org-$(TAG)/xemacs $(MKDIR) org-$(TAG)/doc $(MKDIR) org-$(TAG)/lisp - $(MKDIR) org-$(TAG)/lisp/babel - $(MKDIR) org-$(TAG)/lisp/babel/langs cp -r $(LISPFILES) org-$(TAG)/lisp - cp -r $(LISPBFILES) org-$(TAG)/lisp/babel cp -r $(DOCFILES) $(CARDFILES) org-$(TAG)/doc cp -r $(DISTFILES_extra) org-$(TAG)/ cp -r README_DIST org-$(TAG)/README diff --git a/doc/org.texi b/doc/org.texi index 4e9f093f4..f71979a18 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11128,6 +11128,13 @@ Choose a file to tangle. @cindex code block, evaluating @cindex source code, evaluating +@quotation +Whenever code is evaluated there is a potential for that code to do harm. +Org-mode provides a number of safeguards to ensure that it only evaluates +code with explicit confirmation from the user. For information on these +safeguards (and on how to disable them) see @ref{Code evaluation security}. +@end quotation + Code blocks can be evaluated and the results placed in the Org-mode buffer. By default, evaluation is only turned on for @code{emacs-lisp} code blocks, however support exists for evaluating blocks in many languages. See @@ -11136,9 +11143,14 @@ code blocks} for information on the syntax used to define a code block. @kindex C-c C-c There are a number of ways to evaluate code blocks. The simplest is to -press @kbd{C-c C-c} with the point on a code block. This will call the -@code{org-babel-execute-src-block} function to evaluate the block and -insert its results into the Org-mode buffer. +press @kbd{C-c C-c} or @kbd{C-c C-v e} with the point on a code block. This +will call the @code{org-babel-execute-src-block} function to evaluate the +block and insert its results into the Org-mode buffer. + +@quotation +The @code{org-babel-no-eval-on-ctrl-c-ctrl-c} variable can be used to remove +code evaluation from the @kbd{C-c C-c} key binding. +@end quotation It is also possible to evaluate named code blocks from anywhere in an Org-mode buffer or an Org-mode table. @code{#+call} (or synonymously @@ -11212,22 +11224,33 @@ Language specific documentation is available for some languages. If available, it can be found at @uref{http://orgmode.org/worg/org-contrib/babel/languages}. +The @code{org-babel-load-languages} controls which languages are enabled for +evaluation (by default only @code{emacs-lisp} is enabled). This variable can +be set using the customization interface or by adding code like the following +to your emacs configuration. -To add support for a particular language to your installation: +@quotation +The following disables @code{emacs-lisp} evaluation and enables evaluation of +@code{R} code blocks. +@end quotation -@enumerate -@item -ensure that the language-specific requirements are met, then -@item -add a line to your Emacs configuration like @lisp -(require 'ob-identifier) +(org-babel-do-load-languages + 'org-babel-load-languages + '((emacs-lisp . nil) + (R . t))) @end lisp -where ``identifier'' is taken from the table above, e.g., + +It is also possible to enable support for a language by loading the related +elisp file with @code{require}. + +@quotation +The following adds support for evaluating @code{clojure} code blocks. +@end quotation + @lisp -(require 'ob-sass) +(require 'ob-clojure) @end lisp -@end enumerate @node Header arguments, Results of evaluation, Languages, Working With Source Code @section Header arguments @@ -11394,6 +11417,7 @@ The following header arguments are defined: * exports:: Export code and/or results * tangle:: Toggle tangling and specify file name * no-expand:: Turn off variable assignment and noweb expansion during tangling +* comments:: Toggle insertion of comments in tangled code files * session:: Preserve the state of code evaluation * noweb:: Toggle expansion of noweb references * cache:: Avoid re-evaluating unchanged code blocks @@ -11737,7 +11761,7 @@ Both the code and results are included in the exported file. E.g., Nothing is included in the exported file. E.g., @code{:exports none}. @end itemize -@node tangle, no-expand, exports, Specific header arguments +@node tangle, comments, exports, Specific header arguments @subsubsection @code{:tangle} The @code{:tangle} header argument specifies whether or not the code @@ -11757,7 +11781,16 @@ as a file basename to which the block will be exported. E.g., @code{:tangle basename}. @end itemize -@node no-expand, session, tangle, Specific header arguments +@node comments, no-expand, tangle, Specific header arguments +@subsubsection @code{:comments} +By default code blocks are tangled to source-code files without any insertion +of comments beyond those which may already exist in the body of the code +block. The @code{:comments} header argument can be set to ``yes'' +e.g. @code{:comments yes} to enable the insertion of comments around code +blocks during tangling. The inserted comments contain pointers back to the +original Org file from which the comment was tangled. + +@node no-expand, session, comments, Specific header arguments @subsubsection @code{:no-expand} By default, code blocks are expanded with @code{org-babel-expand-src-block} @@ -12315,7 +12348,7 @@ Make sure you know what you are doing before customizing the variables which take of the default security brakes. @defopt org-confirm-babel-evaluate -Does code evaluation have to be acknowledged by the user? +When set to t user is queried before code block evaluation @end defopt @item Following @code{shell} and @code{elisp} links diff --git a/lisp/babel/langs/ob-C.el b/lisp/ob-C.el similarity index 93% rename from lisp/babel/langs/ob-C.el rename to lisp/ob-C.el index 8930fa1dd..50527c358 100644 --- a/lisp/babel/langs/ob-C.el +++ b/lisp/ob-C.el @@ -32,10 +32,12 @@ ;;; Code: (require 'ob) +(require 'ob-eval) (require 'org) (require 'cc-mode) -(declare-function org-entry-get "org" (&optional inherit)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp")) @@ -112,14 +114,12 @@ or `org-babel-execute:c++'." (org-babel-reassemble-table (org-babel-read (org-babel-trim - (with-temp-buffer - (org-babel-shell-command-on-region - (point-min) (point-max) - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) - (current-buffer) 'replace) - (buffer-string)))) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))) + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))) (progn (with-current-buffer error-buf (goto-char (point-max)) diff --git a/lisp/babel/langs/ob-R.el b/lisp/ob-R.el similarity index 60% rename from lisp/babel/langs/ob-R.el rename to lisp/ob-R.el index 6a711e868..8403483b4 100644 --- a/lisp/babel/langs/ob-R.el +++ b/lisp/ob-R.el @@ -28,6 +28,14 @@ ;;; Code: (require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-tsv "ob-table" (table params)) +(declare-function R "ext:essd-r" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) (defconst org-babel-header-arg-names:R '(width height bg units pointsize antialias quality compression @@ -37,26 +45,40 @@ (defvar org-babel-default-header-args:R '()) +(defvar org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code.") + (defun org-babel-expand-body:R (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." (let* ((processed-params (or processed-params (org-babel-process-params params))) - (vars (mapcar (lambda (i) (cons (car (nth i (nth 1 processed-params))) - (org-babel-reassemble-table - (cdr (nth i (nth 1 processed-params))) - (cdr (nth i (nth 4 processed-params))) - (cdr (nth i (nth 5 processed-params)))))) - (number-sequence 0 (1- (length (nth 1 processed-params)))))) + (vars (mapcar + (lambda (i) + (cons (car (nth i (nth 1 processed-params))) + (org-babel-reassemble-table + (cdr (nth i (nth 1 processed-params))) + (cdr (nth i (nth 4 processed-params))) + (cdr (nth i (nth 5 processed-params)))))) + (number-sequence 0 (1- (length (nth 1 processed-params)))))) (out-file (cdr (assoc :file params)))) - (concat - (if out-file (concat (org-babel-R-construct-graphics-device-call out-file params) "\n") "") - (mapconcat ;; define any variables - (lambda (pair) - (org-babel-R-assign-elisp (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) - vars "\n") - "\n" body "\n" (if out-file "dev.off()\n" "")))) + (mapconcat ;; define any variables + #'org-babel-trim + ((lambda (inside) + (if out-file + (append + (list (org-babel-R-construct-graphics-device-call out-file params)) + inside + (list "dev.off()")) + inside)) + (append + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + vars) + (list body))) "\n"))) (defun org-babel-execute:R (body params) "Execute a block of R code with org-babel. This function is @@ -65,7 +87,8 @@ called by `org-babel-execute-src-block'." (save-excursion (let* ((processed-params (org-babel-process-params params)) (result-type (nth 3 processed-params)) - (session (org-babel-R-initiate-session (first processed-params) params)) + (session (org-babel-R-initiate-session + (first processed-params) params)) (colnames-p (cdr (assoc :colnames params))) (rownames-p (cdr (assoc :rownames params))) (out-file (cdr (assoc :file params))) @@ -77,6 +100,7 @@ called by `org-babel-execute-src-block'." (org-babel-pick-name (nth 4 processed-params) colnames-p)) (or (equal "yes" rownames-p) (org-babel-pick-name (nth 5 processed-params) rownames-p))))) + (message "result is %S" result) (or out-file result)))) (defun org-babel-prep-session:R (session params) @@ -86,9 +110,9 @@ called by `org-babel-execute-src-block'." (var-lines (mapcar (lambda (pair) (org-babel-R-assign-elisp - (car pair) (cdr pair) - (equal (cdr (assoc :colnames params)) "yes") - (equal (cdr (assoc :rownames params)) "yes"))) + (car pair) (cdr pair) + (equal (cdr (assoc :colnames params)) "yes") + (equal (cdr (assoc :rownames params)) "yes"))) vars))) (org-babel-comint-in-buffer session (mapc (lambda (var) @@ -136,9 +160,14 @@ called by `org-babel-execute-src-block'." (if (org-babel-comint-buffer-livep session) session (save-window-excursion - (R) - (rename-buffer (if (bufferp session) (buffer-name session) - (if (stringp session) session (buffer-name)))) (current-buffer)))))) + (require 'ess) (R) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) (defun org-babel-R-construct-graphics-device-call (out-file params) "Construct the call to the graphics device." @@ -153,25 +182,36 @@ called by `org-babel-execute-src-block'." (:ps . "postscript") (:postscript . "postscript"))) (allowed-args '(:width :height :bg :units :pointsize - :antialias :quality :compression :res :type - :family :title :fonts :version :paper :encoding - :pagecentre :colormodel :useDingbats :horizontal)) - (device (and (string-match ".+\\.\\([^.]+\\)" out-file) (match-string 1 out-file))) + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) (extra-args (cdr (assq :R-dev-args params))) filearg args) - (setq device (or (and device (cdr (assq (intern (concat ":" device)) devices))) "png")) - (setq filearg (if (member device '("pdf" "postscript" "svg")) "file" "filename")) - (setq args (mapconcat (lambda (pair) - (if (member (car pair) allowed-args) - (format ",%s=%s" (substring (symbol-name (car pair)) 1) (cdr pair)) "")) - params "")) - (format "%s(%s=\"%s\"%s%s%s)\n" device filearg out-file args (if extra-args "," "") (or extra-args "")))) + (setq device (or (and device (cdr (assq (intern (concat ":" device)) + devices))) "png")) + (setq filearg + (if (member device '("pdf" "postscript" "svg")) "file" "filename")) + (setq args (mapconcat + (lambda (pair) + (if (member (car pair) allowed-args) + (format ",%s=%s" + (substring (symbol-name (car pair)) 1) + (cdr pair)) "")) + params "")) + (format "%s(%s=\"%s\"%s%s%s)" + device filearg out-file args + (if extra-args "," "") (or extra-args "")))) (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") (defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") +(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") -(defun org-babel-R-evaluate (session body result-type column-names-p row-names-p) +(defun org-babel-R-evaluate + (session body result-type column-names-p row-names-p) "Pass BODY to the R process in SESSION. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the @@ -179,65 +219,52 @@ last statement in BODY, as elisp." (if (not session) ;; external process evaluation (case result-type - (output - (with-temp-buffer - (insert body) - (org-babel-shell-command-on-region (point-min) (point-max) "R --slave --no-save" 'current-buffer 'replace) - (org-babel-trim (buffer-string)))) + (output (org-babel-eval org-babel-R-command body)) (value - (let* ((tmp-file (make-temp-file "R-out-functional-results")) exit-code - (stderr - (with-temp-buffer - (insert (format org-babel-R-wrapper-method - body tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE"))) - (setq exit-code (org-babel-shell-command-on-region - (point-min) (point-max) "R --no-save" nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) + (let ((tmp-file (make-temp-file "org-babel-R-results-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-wrapper-method + body tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE"))) (org-babel-R-process-value-result - (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file)) - column-names-p)))) + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p)))) ;; comint session evaluation - (org-babel-comint-in-buffer session - (let* ((tmp-file (make-temp-file "org-babel-R")) - (full-body - (case result-type - (value - (mapconcat #'org-babel-chomp (list body - (format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)" tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE")) - org-babel-R-eoe-indicator) "\n")) - (output - (mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n")))) - (raw - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert full-body) (inferior-ess-send-input))) - (comint-prompt-regexp - (concat "^\\(" - inferior-ess-primary-prompt - "\\|" - inferior-ess-secondary-prompt - "\\)*")) - broke results) - (case result-type - (value (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file)) - column-names-p)) - (output - (flet ((extractor - (el) - (if (or broke - (and (string-match (regexp-quote org-babel-R-eoe-output) el) - (setq broke t))) - nil - (if (= (length el) 0) - nil - (if (string-match comint-prompt-regexp el) - (org-babel-trim (substring el (match-end 0))) - el))))) - (mapconcat - #'identity - (delete nil (mapcar #'extractor (mapcar #'org-babel-chomp raw))) "\n")))))))) + (case result-type + (value + (let ((tmp-file (make-temp-file "org-babel-R")) + broke) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat + #'org-babel-chomp + (list + body + (format org-babel-R-wrapper-lastvar + tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE")) + org-babel-R-eoe-indicator) "\n")) + (inferior-ess-send-input)) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + #'identity + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))) 2) "\n"))))) (defun org-babel-R-process-value-result (result column-names-p) "R-specific processing of return value prior to return to diff --git a/lisp/babel/langs/ob-asymptote.el b/lisp/ob-asymptote.el similarity index 98% rename from lisp/babel/langs/ob-asymptote.el rename to lisp/ob-asymptote.el index 1415730ce..da11fe440 100644 --- a/lisp/babel/langs/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -46,6 +46,9 @@ (require 'ob) (eval-when-compile (require 'cl)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function org-combine-plists "org" (&rest plists)) + (add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) (defvar org-babel-default-header-args:asymptote diff --git a/lisp/babel/langs/ob-clojure.el b/lisp/ob-clojure.el similarity index 76% rename from lisp/babel/langs/ob-clojure.el rename to lisp/ob-clojure.el index 491a4ac1d..814803aac 100644 --- a/lisp/babel/langs/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -39,9 +39,16 @@ ;;; Code: (require 'ob) -(require 'cl) -(require 'slime) -(require 'swank-clojure) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function slime-eval-async "ext:slime" (sexp &optional cont package)) +(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function swank-clojure-concat-paths "ext:slime" (paths)) +(declare-function org-babel-ref-variables "ext:slime" (params)) +(declare-function slime "ext:slime" (&optional command coding-system)) +(declare-function slime-output-buffer "ext:slime" (&optional noprompt)) +(declare-function slime-filter-buffers "ext:slime" (predicate)) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) @@ -63,7 +70,8 @@ [] %s) -(spit \"%s\" (str (main)))") ;;" <-- syntax highlighting is messed without this double quote +(spit \"%s\" (str (main)))") +;;";; <-- syntax highlighting is messed without this double quote ;;taken mostly from clojure-test-mode.el (defun org-babel-clojure-clojure-slime-eval (string &optional handler) @@ -76,16 +84,23 @@ (slime-eval `(swank:eval-and-grab-output ,string))) ;;taken from swank-clojure.el +(defvar swank-clojure-binary) +(defvar swank-clojure-classpath) +(defvar swank-clojure-java-path) +(defvar swank-clojure-extra-vm-args) +(defvar swank-clojure-library-paths) +(defvar swank-clojure-extra-classpaths) (defun org-babel-clojure-babel-clojure-cmd () "Create the command to start clojure according to current settings." (if (and (not swank-clojure-binary) (not swank-clojure-classpath)) - (error "You must specifiy either a `swank-clojure-binary' or a `swank-clojure-jar-path'") + (error (concat "You must specifiy either a `swank-clojure-binary' " + "or a `swank-clojure-jar-path'")) (if swank-clojure-binary (if (listp swank-clojure-binary) swank-clojure-binary (list swank-clojure-binary)) - (delete-if - 'null + (delq + nil (append (list swank-clojure-java-path) swank-clojure-extra-vm-args @@ -123,15 +138,20 @@ specifying a var of the same value." (defun org-babel-clojure-build-full-form (body vars) "Construct a clojure let form with vars as the let vars." - (let ((vars-forms (mapconcat ;; define any variables - (lambda (pair) - (format "%s %s" (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) - vars "\n ")) + (let ((vars-forms + (mapconcat ;; define any variables + (lambda (pair) + (format "%s %s" + (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) + vars "\n ")) (body (org-babel-trim body))) - (if (> (length vars-forms) 0) (format "(let [%s]\n %s)" vars-forms body) body))) + (if (> (length vars-forms) 0) + (format "(let [%s]\n %s)" vars-forms body) + body))) (defun org-babel-prep-session:clojure (session params) "Prepare SESSION according to the header arguments specified in PARAMS." + (require 'slime) (require 'swank-clojure) (let* ((session-buf (org-babel-clojure-initiate-session session)) (vars (org-babel-ref-variables params)) (var-lines (mapcar ;; define any top level session variables @@ -143,6 +163,7 @@ specifying a var of the same value." (defun org-babel-load-session:clojure (session body params) "Load BODY into SESSION." + (require 'slime) (require 'swank-clojure) (save-window-excursion (let ((buffer (org-babel-prep-session:clojure session params))) (with-current-buffer buffer @@ -164,10 +185,11 @@ then create one. Return the initialized session." (let* ((session (if session (if (stringp session) (intern session) session) - :default)) + :default)) (clojure-buffer (org-babel-clojure-session-buffer session))) (unless (and clojure-buffer (buffer-live-p clojure-buffer)) - (setq org-babel-clojure-buffers (assq-delete-all session org-babel-clojure-buffers)) + (setq org-babel-clojure-buffers + (assq-delete-all session org-babel-clojure-buffers)) (push session org-babel-clojure-pending-sessions) (slime) ;; we are waiting to finish setting up which will be done in @@ -175,7 +197,8 @@ then create one. Return the initialized session." (let ((timeout 9)) (while (and (not (org-babel-clojure-session-buffer session)) (< 0 timeout)) - (message "Waiting for clojure repl for session: %s ... %i" session timeout) + (message "Waiting for clojure repl for session: %s ... %i" + session timeout) (sit-for 1) (decf timeout))) (setq org-babel-clojure-pending-sessions @@ -188,8 +211,10 @@ then create one. Return the initialized session." (defun org-babel-clojure-initiate-session (&optional session params) "Return the slime-clojure repl buffer bound to this session or nil if \"none\" is specified." + (require 'slime) (require 'swank-clojure) (unless (and (stringp session) (string= session "none")) - (org-babel-clojure-session-buffer (org-babel-clojure-initiate-session-by-key session)))) + (org-babel-clojure-session-buffer + (org-babel-clojure-initiate-session-by-key session)))) (defun org-babel-clojure-session-connected-hook () "Finish setting up the bindings of org-babel session to a slime-clojure repl." @@ -197,8 +222,11 @@ or nil if \"none\" is specified." (when pending-session (save-excursion (switch-to-buffer (slime-output-buffer)) - (rename-buffer (if (stringp pending-session) pending-session (symbol-name pending-session))) - (org-babel-clojure-bind-session-to-repl-buffer pending-session (slime-output-buffer)))))) + (rename-buffer + (if (stringp pending-session) + pending-session (symbol-name pending-session))) + (org-babel-clojure-bind-session-to-repl-buffer + pending-session (slime-output-buffer)))))) (add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook) @@ -222,48 +250,41 @@ repl buffer." (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t))) (org-babel-clojure-bind-session-to-repl-buffer session repl-buf)))) -(defun org-babel-clojure-evaluate-external-process (buffer body &optional result-type) +(defun org-babel-clojure-evaluate-external-process + (buffer body &optional result-type) "Evaluate the body in an external process." - (save-excursion - (let ((cmd (format "%s -" (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " ")))) - (case result-type - (output - (with-temp-buffer - (insert body) - (org-babel-shell-command-on-region cmd (point-min) (point-max) 'current-buffer 'replace) - (buffer-string))) - (value - (let* ((tmp-file (make-temp-file "org-babel-clojure-results-")) exit-code - (stderr - (with-temp-buffer - (insert - (format org-babel-clojure-wrapper-method body tmp-file tmp-file)) - (setq exit-code - (org-babel-shell-command-on-region (point-min) (point-max) cmd nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) - (org-babel-clojure-table-or-string - (with-temp-buffer - (insert-file-contents (org-babel-maybe-remote-file tmp-file)) (buffer-string))))))))) + (let ((cmd (format "%s -" (mapconcat #'identity + (org-babel-clojure-babel-clojure-cmd) + " ")))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-"))) + (org-babel-eval cmd (format org-babel-clojure-wrapper-method + body tmp-file tmp-file)) + (org-babel-clojure-table-or-string + (org-babel-eval-read-file tmp-file))))))) (defun org-babel-clojure-evaluate-session (buffer body &optional result-type) "Evaluate the body in the context of a clojure session." + (require 'slime) (require 'swank-clojure) (let ((raw nil) (results nil)) (save-window-excursion (set-buffer buffer) (setq raw (org-babel-clojure-slime-eval-sync body)) (setq results (reverse (mapcar #'org-babel-trim raw))) - (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value (org-babel-clojure-table-or-string (car results))))))) + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-clojure-table-or-string (car results))))))) (defun org-babel-clojure-evaluate (buffer body &optional result-type) "Pass BODY to the Clojure process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (if session + (if buffer (org-babel-clojure-evaluate-session buffer body result-type) (org-babel-clojure-evaluate-external-process buffer body result-type))) @@ -274,13 +295,17 @@ last statement in BODY, as elisp." (defun org-babel-execute:clojure (body params) "Execute a block of Clojure code with org-babel." + (require 'slime) (require 'swank-clojure) (let* ((processed-params (org-babel-process-params params)) (body (org-babel-expand-body:clojure body params processed-params)) - (session (org-babel-clojure-initiate-session (first processed-params)))) + (session (org-babel-clojure-initiate-session + (first processed-params)))) (org-babel-reassemble-table (org-babel-clojure-evaluate session body (nth 3 processed-params)) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) (provide 'ob-clojure) diff --git a/lisp/babel/ob-comint.el b/lisp/ob-comint.el similarity index 97% rename from lisp/babel/ob-comint.el rename to lisp/ob-comint.el index b60e8f12b..7b742d5b7 100644 --- a/lisp/babel/ob-comint.el +++ b/lisp/ob-comint.el @@ -33,6 +33,7 @@ ;;; Code: (require 'ob) (require 'comint) +(eval-when-compile (require 'cl)) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -68,7 +69,7 @@ or user `keyboard-quit' during execution of body." (remove-echo (cadr (cdr meta))) (full-body (cadr (cdr (cdr meta))))) `(org-babel-comint-in-buffer ,buffer - (let ((string-buffer "") dangling-text) + (let ((string-buffer "") dangling-text raw) (flet ((my-filt (text) (setq string-buffer (concat string-buffer text)))) ;; setup filter @@ -106,7 +107,7 @@ or user `keyboard-quit' during execution of body." (if (and ,remove-echo ,full-body (string-match (replace-regexp-in-string - "\n" "[\r\n]+" (regexp-quote ,full-body)) + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) string-buffer)) (setq raw (substring string-buffer (match-end 0)))) (split-string string-buffer comint-prompt-regexp))))) diff --git a/lisp/babel/langs/ob-css.el b/lisp/ob-css.el similarity index 100% rename from lisp/babel/langs/ob-css.el rename to lisp/ob-css.el diff --git a/lisp/babel/langs/ob-ditaa.el b/lisp/ob-ditaa.el similarity index 98% rename from lisp/babel/langs/ob-ditaa.el rename to lisp/ob-ditaa.el index 6d0a584f6..1d70b5a44 100644 --- a/lisp/babel/langs/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -46,6 +46,7 @@ (defun org-babel-expand-body:ditaa (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." body) +(defvar org-ditaa-jar-path) (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." diff --git a/lisp/babel/langs/ob-dot.el b/lisp/ob-dot.el similarity index 100% rename from lisp/babel/langs/ob-dot.el rename to lisp/ob-dot.el diff --git a/lisp/babel/langs/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el similarity index 100% rename from lisp/babel/langs/ob-emacs-lisp.el rename to lisp/ob-emacs-lisp.el diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el new file mode 100644 index 000000000..282baee29 --- /dev/null +++ b/lisp/ob-eval.el @@ -0,0 +1,256 @@ +;;; ob-run.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 0.01 + +;; This file is part of GNU Emacs. + +;; 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 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. If not, see . + +;;; Commentary: + +;; These functions build existing Emacs support for executing external +;; shell commands. + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defun org-babel-eval-error-notify (exit-code stderr) + "Open a buffer containing information from STDERR with a +message about the value of EXIT-CODE." + (let ((buf (get-buffer-create "*Org-Babel Error Output*"))) + (with-current-buffer buf + (goto-char (point-max)) + (save-excursion (insert stderr))) + (display-buffer buf)) + (message "Babel evaluation exited with code %d" exit-code)) + +(defun org-babel-eval (cmd body) + "Run CMD on BODY, if CMD succeeds then return it's results, +otherwise display STDERR with `org-babel-eval-error-notify'." + (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code) + (with-current-buffer err-buff (erase-buffer)) + (with-temp-buffer + (insert body) + (setq exit-code + (org-babel-shell-command-on-region + (point-min) (point-max) cmd t 'replace err-buff)) + (if (> exit-code 0) + (progn + (with-current-buffer err-buff + (org-babel-eval-error-notify exit-code (buffer-string))) + nil) + (buffer-string))))) + +(defun org-babel-eval-read-file (file) + "Return the contents of FILE as a string." + (with-temp-buffer (insert-file-contents + (org-babel-maybe-remote-file file)) + (buffer-string))) + +(defun org-babel-shell-command-on-region (start end command + &optional output-buffer replace + error-buffer display-error-buffer) + "Execute string COMMAND in inferior shell with region as input. + +Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' + +Normally display output (if any) in temp buffer `*Shell Command Output*'; +Prefix arg means replace the region with it. Return the exit code of +COMMAND. + +To specify a coding system for converting non-ASCII characters in +the input and output to the shell command, use +\\[universal-coding-system-argument] before this command. By +default, the input (from the current buffer) is encoded in the +same coding system that will be used to save the file, +`buffer-file-coding-system'. If the output is going to replace +the region, then it is decoded from that same coding system. + +The noninteractive arguments are START, END, COMMAND, +OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. +Noninteractive callers can specify coding systems by binding +`coding-system-for-read' and `coding-system-for-write'. + +If the command generates output, the output may be displayed +in the echo area or in a buffer. +If the output is short enough to display in the echo area +\(determined by the variable `max-mini-window-height' if +`resize-mini-windows' is non-nil), it is shown there. Otherwise +it is displayed in the buffer `*Shell Command Output*'. The output +is available in that buffer in both cases. + +If there is output and an error, a message about the error +appears at the end of the output. + +If there is no output, or if output is inserted in the current buffer, +then `*Shell Command Output*' is deleted. + +If the optional fourth argument OUTPUT-BUFFER is non-nil, +that says to put the output in some other buffer. +If OUTPUT-BUFFER is a buffer or buffer name, put the output there. +If OUTPUT-BUFFER is not a buffer and not nil, +insert output in the current buffer. +In either case, the output is inserted after point (leaving mark after it). + +If REPLACE, the optional fifth argument, is non-nil, that means insert +the output in place of text from START to END, putting point and mark +around it. + +If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer +or buffer name to which to direct the command's standard error output. +If it is nil, error output is mingled with regular output. +If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there +were any errors. (This is always t, interactively.) +In an interactive call, the variable `shell-command-default-error-buffer' +specifies the value of ERROR-BUFFER." + (interactive (let (string) + (unless (mark) + (error "The mark is not set now, so there is no region")) + ;; Do this before calling region-beginning + ;; and region-end, in case subprocess output + ;; relocates them while we are in the minibuffer. + (setq string (read-shell-command "Shell command on region: ")) + ;; call-interactively recognizes region-beginning and + ;; region-end specially, leaving them in the history. + (list (region-beginning) (region-end) + string + current-prefix-arg + current-prefix-arg + shell-command-default-error-buffer + t))) + (let ((error-file + (if error-buffer + (make-temp-file + (expand-file-name "scor" + (or (unless (featurep 'xemacs) + small-temporary-file-directory) + temporary-file-directory))) + nil)) + exit-status) + (if (or replace + (and output-buffer + (not (or (bufferp output-buffer) (stringp output-buffer))))) + ;; Replace specified region with output from command. + (let ((swap (and replace (< start end)))) + ;; Don't muck with mark unless REPLACE says we should. + (goto-char start) + (and replace (push-mark (point) 'nomsg)) + (setq exit-status + (call-process-region start end shell-file-name t + (if error-file + (list output-buffer error-file) + t) + nil shell-command-switch command)) + ;; It is rude to delete a buffer which the command is not using. + ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) + ;; (kill-buffer shell-buffer))) + ;; Don't muck with mark unless REPLACE says we should. + (and replace swap (exchange-point-and-mark))) + ;; No prefix argument: put the output in a temp buffer, + ;; replacing its entire contents. + (let ((buffer (get-buffer-create + (or output-buffer "*Shell Command Output*")))) + (unwind-protect + (if (eq buffer (current-buffer)) + ;; If the input is the same buffer as the output, + ;; delete everything but the specified region, + ;; then replace that region with the output. + (progn (setq buffer-read-only nil) + (delete-region (max start end) (point-max)) + (delete-region (point-min) (min start end)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch + command))) + ;; Clear the output buffer, then run the command with + ;; output there. + (let ((directory default-directory)) + (save-current-buffer + (set-buffer buffer) + (setq buffer-read-only nil) + (if (not output-buffer) + (setq default-directory directory)) + (erase-buffer))) + (setq exit-status + (call-process-region start end shell-file-name nil + (if error-file + (list buffer error-file) + buffer) + nil shell-command-switch command))) + ;; Report the output. + (with-current-buffer buffer + (setq mode-line-process + (cond ((null exit-status) + " - Error") + ((stringp exit-status) + (format " - Signal [%s]" exit-status)) + ((not (equal 0 exit-status)) + (format " - Exit [%d]" exit-status))))) + (if (with-current-buffer buffer (> (point-max) (point-min))) + ;; There's some output, display it + (display-message-or-buffer buffer) + ;; No output; error? + (let ((output + (if (and error-file + (< 0 (nth 7 (file-attributes error-file)))) + "some error output" + "no output"))) + (cond ((null exit-status) + (message "(Shell command failed with error)")) + ((equal 0 exit-status) + (message "(Shell command succeeded with %s)" + output)) + ((stringp exit-status) + (message "(Shell command killed by signal %s)" + exit-status)) + (t + (message "(Shell command failed with code %d and %s)" + exit-status output)))) + ;; Don't kill: there might be useful info in the undo-log. + ;; (kill-buffer buffer) + )))) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (and display-error-buffer + (display-buffer (current-buffer))))) + (delete-file error-file)) + exit-status)) + +(provide 'ob-eval) + +;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d + +;;; ob-comint.el ends here diff --git a/lisp/babel/ob-exp.el b/lisp/ob-exp.el similarity index 100% rename from lisp/babel/ob-exp.el rename to lisp/ob-exp.el diff --git a/lisp/babel/langs/ob-gnuplot.el b/lisp/ob-gnuplot.el similarity index 91% rename from lisp/babel/langs/ob-gnuplot.el rename to lisp/ob-gnuplot.el index 5060d66db..cb1af6be8 100644 --- a/lisp/babel/langs/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -40,7 +40,16 @@ ;;; Code: (require 'ob) -(require 'gnuplot) +(require 'ob-ref) +(require 'ob-comint) +(eval-when-compile (require 'cl)) + +(declare-function org-time-string-to-time "org" (s)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function gnuplot-mode "ext:gnuplot-mode" ()) +(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) (defvar org-babel-default-header-args:gnuplot '((:results . "file") (:exports . "results") (:session . nil)) @@ -124,10 +133,12 @@ code." "Execute a block of Gnuplot code with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Gnuplot source code block") + (require 'gnuplot) (let ((session (cdr (assoc :session params))) (result-type (cdr (assoc :results params))) (out-file (cdr (assoc :file params))) - (body (org-babel-expand-body:gnuplot body params))) + (body (org-babel-expand-body:gnuplot body params)) + output) (save-window-excursion ;; evaluate the code body with gnuplot (if (string= session "none") @@ -170,18 +181,23 @@ called by `org-babel-execute-src-block'." (insert (org-babel-chomp body))) buffer))) +(defvar gnuplot-buffer) (defun org-babel-gnuplot-initiate-session (&optional session params) "If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session. The current `gnuplot-mode' doesn't provide support for multiple sessions." + (require 'gnuplot) (unless (string= session "none") - (save-window-excursion (gnuplot-send-string-to-gnuplot "" "line") - gnuplot-buffer))) + (save-window-excursion + (gnuplot-send-string-to-gnuplot "" "line") + gnuplot-buffer))) (defun org-babel-gnuplot-quote-timestamp-field (s) "Convert field S from timestamp to Unix time and export to gnuplot." (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s))) +(defvar org-table-number-regexp) +(defvar org-ts-regexp3) (defun org-babel-gnuplot-quote-tsv-field (s) "Quote field S for export to gnuplot." (unless (stringp s) diff --git a/lisp/babel/langs/ob-haskell.el b/lisp/ob-haskell.el similarity index 92% rename from lisp/babel/langs/ob-haskell.el rename to lisp/ob-haskell.el index df3b72ab2..c380f1b7b 100644 --- a/lisp/babel/langs/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -41,8 +41,15 @@ ;;; Code: (require 'ob) -(require 'haskell-mode) -(require 'inf-haskell) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function haskell-mode "ext:haskell-mode" ()) +(declare-function run-haskell "ext:inf-haskell" (&optional arg)) +(declare-function inferior-haskell-load-file + "ext:inf-haskell" (&optional reload)) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) @@ -66,7 +73,7 @@ "Execute a block of Haskell code with org-babel." (message "executing haskell source code block") (let* ((processed-params (org-babel-process-params params)) - (session (first processed-params)) + (session (nth 0 processed-params)) (vars (nth 1 processed-params)) (result-type (nth 3 processed-params)) (full-body (org-babel-expand-body:haskell body params processed-params)) @@ -82,9 +89,11 @@ (cdr (member org-babel-haskell-eoe (reverse (mapcar #'org-babel-trim raw))))))) (org-babel-reassemble-table - (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value (org-babel-haskell-table-or-string (car results)))) + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-haskell-table-or-string (car results)))) (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) @@ -97,7 +106,7 @@ (defun org-babel-haskell-initiate-session (&optional session params) "If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." - ;; TODO: make it possible to have multiple sessions + (require 'inf-haskell) (or (get-buffer "*haskell*") (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) @@ -114,13 +123,13 @@ then create one. Return the initialized session." buffer))) (defun org-babel-prep-session:haskell - (session params &optional processesed-params) + (session params &optional processed-params) "Prepare SESSION according to the header arguments specified in PARAMS." (save-window-excursion (let ((pp (or processed-params (org-babel-process-params params))) (buffer (org-babel-haskell-initiate-session session))) (org-babel-comint-in-buffer buffer - (mapcar + (mapc (lambda (pair) (insert (format "let %s = %s" (car pair) @@ -150,6 +159,7 @@ specifying a var of the same value." (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") (format "%S" var))) +(defvar org-src-preserve-indentation) (defun org-babel-haskell-export-to-lhs (&optional arg) "Export to a .lhs file with all haskell code blocks escaped appropriately. When called with a prefix argument the resulting diff --git a/lisp/babel/ob-keys.el b/lisp/ob-keys.el similarity index 93% rename from lisp/babel/ob-keys.el rename to lisp/ob-keys.el index dc459902f..2cc523a21 100644 --- a/lisp/babel/ob-keys.el +++ b/lisp/ob-keys.el @@ -51,7 +51,11 @@ functions.") (describe-bindings org-babel-key-prefix)) (defvar org-babel-key-bindings - '(("\C-p" . org-babel-expand-src-block) + '(("e" . org-babel-execute-src-block) + ("\C-e" . org-babel-execute-src-block) + ("o" . org-babel-open-src-block-result) + ("\C-o" . org-babel-open-src-block-result) + ("\C-p" . org-babel-expand-src-block) ("p" . org-babel-expand-src-block) ("g" . org-babel-goto-named-source-block) ("\C-b" . org-babel-execute-buffer) diff --git a/lisp/babel/langs/ob-latex.el b/lisp/ob-latex.el similarity index 96% rename from lisp/babel/langs/ob-latex.el rename to lisp/ob-latex.el index 3c7b7cfa8..6b817ae01 100644 --- a/lisp/babel/langs/ob-latex.el +++ b/lisp/ob-latex.el @@ -32,6 +32,7 @@ ;;; Code: (require 'ob) +(require 'org-latex) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) @@ -85,9 +86,12 @@ called by `org-babel-execute-src-block'." (with-temp-file tex-file (insert (org-splice-latex-header org-format-latex-header - (remove-if - (lambda (el) (and (listp el) (string= "hyperref" (cadr el)))) - org-export-latex-default-packages-alist) + (delq + nil + (mapcar + (lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-export-latex-default-packages-alist)) org-export-latex-packages-alist org-format-latex-header-extra) (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") diff --git a/lisp/babel/ob-lob.el b/lisp/ob-lob.el similarity index 100% rename from lisp/babel/ob-lob.el rename to lisp/ob-lob.el diff --git a/lisp/babel/langs/ob-matlab.el b/lisp/ob-matlab.el similarity index 50% rename from lisp/babel/langs/ob-matlab.el rename to lisp/ob-matlab.el index 63858bc92..748113158 100644 --- a/lisp/babel/langs/ob-matlab.el +++ b/lisp/ob-matlab.el @@ -36,43 +36,10 @@ ;; http://matlab-emacs.sourceforge.net/ ;;; Code: -(require 'matlab) +(require 'ob) (require 'ob-octave) -(defvar org-babel-default-header-args:matlab '()) - -(defvar org-babel-matlab-shell-command "matlab -nosplash" - "Shell command to use to run matlab as an external process.") - -(defun org-babel-expand-body:matlab (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - -(defvar org-babel-matlab-with-emacs-link nil - "If non-nil use matlab-shell-run-region for session - evaluation. This will use EmacsLink if (matlab-with-emacs-link) - evaluates to a non-nil value.") - -(defvar org-babel-matlab-emacs-link-wrapper-method - "%s -if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); -else, save -ascii %s ans -end -delete('%s') -") - -(defun org-babel-execute:matlab (body params) - "Execute a block of matlab code with org-babel." - (org-babel-execute:octave body params 'matlab)) - -(defun org-babel-prep-session:matlab (session params) - "Prepare SESSION according to PARAMS." - (org-babel-prep-session:octave session params 'matlab)) - -(defun org-babel-matlab-initiate-session (&optional session params) - "Create a matlab inferior process buffer. If there is not a -current inferior-process-buffer in SESSION then create. Return -the initialized session." - (org-babel-octave-initiate-session session params 'matlab)) +;; see ob-octave for matlab implementation (provide 'ob-matlab) diff --git a/lisp/babel/langs/ob-ocaml.el b/lisp/ob-ocaml.el similarity index 95% rename from lisp/babel/langs/ob-ocaml.el rename to lisp/ob-ocaml.el index 66d285bd9..140c98da6 100644 --- a/lisp/babel/langs/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -37,7 +37,11 @@ ;;; Code: (require 'ob) -(require 'tuareg) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function tuareg-run-caml "ext:taureg" ()) (add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) @@ -60,7 +64,8 @@ (let* ((processed-params (org-babel-process-params params)) (vars (nth 1 processed-params)) (full-body (org-babel-expand-body:ocaml body params processed-params)) - (session (org-babel-prep-session:ocaml session params)) + (session (org-babel-prep-session:ocaml + (cdr (assoc :session params)) params)) (raw (org-babel-comint-with-output (session org-babel-ocaml-eoe-output t full-body) (insert (concat (org-babel-chomp full-body) " ;;")) @@ -72,8 +77,10 @@ (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) +(defvar tuareg-interactive-buffer-name) (defun org-babel-prep-session:ocaml (session params) "Prepare SESSION according to the header arguments specified in PARAMS." + (require 'tuareg) (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) (not (string= session "default")) (stringp session)) diff --git a/lisp/babel/langs/ob-octave.el b/lisp/ob-octave.el similarity index 66% rename from lisp/babel/langs/ob-octave.el rename to lisp/ob-octave.el index 8797b2317..e50b74fb5 100644 --- a/lisp/babel/langs/ob-octave.el +++ b/lisp/ob-octave.el @@ -31,19 +31,29 @@ ;;; Code: (require 'ob) -(require 'octave-inf) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) +(declare-function matlab-shell "ext:matlab-mode") +(declare-function matlab-shell-run-region "ext:matlab-mode") + +(defvar org-babel-default-header-args:matlab '()) (defvar org-babel-default-header-args:octave '()) +(defvar org-babel-matlab-shell-command "matlab -nosplash" + "Shell command to use to run matlab as an external process.") (defvar org-babel-octave-shell-command "octave -q" "Shell command to use to run octave as an external process.") +(defun org-babel-expand-body:matlab (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (org-babel-expand-body:octave body params processed-params)) (defun org-babel-expand-body:octave (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (concat - ;; prepend code to define all arguments passed to the code block - ;; (may not be appropriate for all languages) (mapconcat (lambda (pair) (format "%s=%s" @@ -51,25 +61,60 @@ (org-babel-octave-var-to-octave (cdr pair)))) vars "\n") "\n" body "\n"))) +(defvar org-babel-matlab-with-emacs-link nil + "If non-nil use matlab-shell-run-region for session + evaluation. This will use EmacsLink if (matlab-with-emacs-link) + evaluates to a non-nil value.") + +(defvar org-babel-matlab-emacs-link-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end +delete('%s') +") +(defvar org-babel-octave-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end") + +(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") + +(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") + +(defun org-babel-execute:matlab (body params) + "Execute a block of matlab code with org-babel." + (require 'matlab) + (org-babel-execute:octave body params 'matlab)) (defun org-babel-execute:octave (body params &optional matlabp) "Execute a block of octave code with org-babel." - (message (format "executing %s source code block" (if matlabp "matlab" "octave"))) + (message "executing %s source code block" (if matlabp "matlab" "octave")) (let* ((processed-params (org-babel-process-params params)) - ;; set the session if the session variable is non-nil - (session (funcall (intern (format "org-babel-%s-initiate-session" lang)) - (first processed-params) params)) + (session + (funcall (intern (format "org-babel-%s-initiate-session" + (if matlabp "matlab" "octave"))) + (nth 0 processed-params) params)) (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) (result-type (nth 3 processed-params)) (out-file (cdr (assoc :file params))) - (augmented-body (org-babel-expand-body:octave body params processed-params)) - (result (org-babel-octave-evaluate session augmented-body result-type matlabp))) + (augmented-body + (org-babel-expand-body:octave body params processed-params)) + (result (org-babel-octave-evaluate + session augmented-body result-type matlabp))) (or out-file (org-babel-reassemble-table result - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params))))))) +(defun org-babel-prep-session:matlab (session params) + "Prepare SESSION according to PARAMS." + (require 'matlab) + (org-babel-prep-session:octave session params 'matlab)) (defun org-babel-octave-var-to-octave (var) "Convert an emacs-lisp variable into an octave variable. Converts an emacs-lisp variable into a string of octave code @@ -94,60 +139,53 @@ specifying a variable of the same value." (org-babel-comint-wait-for-output session)) var-lines)) session)) +(defun org-babel-matlab-initiate-session (&optional session params) + "Create a matlab inferior process buffer. If there is not a +current inferior-process-buffer in SESSION then create. Return +the initialized session." + (require 'matlab) + (org-babel-octave-initiate-session session params 'matlab)) (defun org-babel-octave-initiate-session (&optional session params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." + (require 'octave-inf) (unless (string= session "none") - (let ((session (or session (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) + (let ((session (or session + (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) (run-octave)) (rename-buffer (if (bufferp session) (buffer-name session) - (if (stringp session) session (buffer-name)))) (current-buffer)))))) + (if (stringp session) session (buffer-name)))) + (current-buffer)))))) -(defvar org-babel-octave-wrapper-method - "%s -if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); -else, save -ascii %s ans -end") - -(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") - -(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") - -(defun org-babel-octave-evaluate (session body result-type lang) +(defun org-babel-octave-evaluate + (session body result-type lang &optional matlabp) "Pass BODY to the octave process in SESSION. If RESULT-TYPE equals 'output then return the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (if session - (org-babel-octave-evaluate-session session body result-type matlabp) + (org-babel-octave-evaluate-session session body result-type matlabp) (org-babel-octave-evaluate-external-process body result-type matlabp))) (defun org-babel-octave-evaluate-external-process (body result-type matlabp) "Evaluate BODY in an external octave process." - (let ((cmd (if matlabp org-babel-matlab-shell-command org-babel-octave-shell-command))) - (save-excursion - (case result-type - (output - (with-temp-buffer - (insert body) - (org-babel-shell-command-on-region (point-min) (point-max) cmd 'current-buffer 'replace) - (buffer-string))) - (value - (let* ((tmp-file (make-temp-file "org-babel-results-")) exit-code - (stderr - (with-temp-buffer - (insert (format org-babel-octave-wrapper-method body tmp-file tmp-file)) - (setq exit-code (org-babel-shell-command-on-region - (point-min) (point-max) cmd nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) - (org-babel-octave-import-elisp-from-file (org-babel-maybe-remote-file tmp-file)))))))) + (let ((cmd (if matlabp + org-babel-matlab-shell-command + org-babel-octave-shell-command))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let ((tmp-file (make-temp-file "org-babel-results-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body tmp-file tmp-file)) + (org-babel-eval-read-file tmp-file)))))) -(defun org-babel-octave-evaluate-session (session body result-type &optional matlabp) +(defun org-babel-octave-evaluate-session + (session body result-type &optional matlabp) "Evaluate BODY in SESSION." (let* ((tmp-file (make-temp-file "org-babel-results-")) (wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) @@ -164,7 +202,8 @@ statement in BODY, as elisp." body tmp-file tmp-file wait-file) "\n") (mapconcat #'org-babel-chomp - (list (format org-babel-octave-wrapper-method body tmp-file tmp-file) + (list (format org-babel-octave-wrapper-method + body tmp-file tmp-file) org-babel-octave-eoe-indicator) "\n"))))) (raw (if (and matlabp org-babel-matlab-with-emacs-link) (save-window-excursion @@ -187,16 +226,19 @@ statement in BODY, as elisp." (insert full-body) (comint-send-input nil t)))) results) (case result-type (value - (org-babel-octave-import-elisp-from-file (org-babel-maybe-remote-file tmp-file))) + (org-babel-octave-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file))) (output (progn (setq results (if matlabp - (cdr (reverse (delq "" (mapcar #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))) + (cdr (reverse (delq "" (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))) (cdr (member org-babel-octave-eoe-output - (reverse (mapcar #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))))) + (reverse (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))))) (mapconcat #'identity (reverse results) "\n")))))) (defun org-babel-octave-import-elisp-from-file (file-name) diff --git a/lisp/babel/langs/ob-perl.el b/lisp/ob-perl.el similarity index 71% rename from lisp/babel/langs/ob-perl.el rename to lisp/ob-perl.el index f34a88c0d..a8d4a8ed2 100644 --- a/lisp/babel/langs/ob-perl.el +++ b/lisp/ob-perl.el @@ -28,11 +28,16 @@ ;;; Code: (require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) (defvar org-babel-default-header-args:perl '()) +(defvar org-babel-perl-command "perl" + "Name of command to use for executing perl code.") + (defun org-babel-expand-body:perl (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) @@ -49,17 +54,19 @@ called by `org-babel-execute-src-block'." (message "executing Perl source code block") (let* ((processed-params (org-babel-process-params params)) - (session (first processed-params)) + (session (nth 0 processed-params)) (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) (result-type (nth 3 processed-params)) (full-body (org-babel-expand-body:perl - body params processed-params)) ;; then the source block body + body params processed-params)) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:perl (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -97,33 +104,14 @@ print o join(\"\\n\", @r), \"\\n\"") 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (if (not session) - ;; external process evaluation - (save-excursion - (case result-type - (output - (with-temp-buffer - (insert body) - ;; (message "buffer=%s" (buffer-string)) ;; debugging - (org-babel-shell-command-on-region (point-min) (point-max) "perl" 'current-buffer 'replace) - (buffer-string))) - (value - (let* ((tmp-file (make-temp-file "perl-functional-results")) exit-code - (stderr - (with-temp-buffer - (insert - (format - (if (member "pp" result-params) - (error "Pretty-printing not implemented for perl") - org-babel-perl-wrapper-method) body tmp-file)) - (setq exit-code - (org-babel-shell-command-on-region - (point-min) (point-max) "perl" nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) - (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file)))))) - ;; comint session evaluation - (error "Sessions are not supported for Perl."))) + (when session (error "Sessions are not supported for Perl.")) + (case result-type + (output (org-babel-eval org-babel-perl-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-perl-results-"))) + (org-babel-eval + org-babel-perl-command + (format org-babel-perl-wrapper-method body tmp-file)) + (org-babel-eval-read-file tmp-file))))) (provide 'ob-perl) diff --git a/lisp/babel/langs/ob-python.el b/lisp/ob-python.el similarity index 61% rename from lisp/babel/langs/ob-python.el rename to lisp/ob-python.el index 15857b71e..b27ee0544 100644 --- a/lisp/babel/langs/ob-python.el +++ b/lisp/ob-python.el @@ -28,14 +28,21 @@ ;;; Code: (require 'ob) -(require 'ob-tangle) +(require 'ob-ref) (require 'ob-comint) +(require 'ob-eval) (require (if (featurep 'xemacs) 'python-mode 'python)) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" ) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) (defvar org-babel-default-header-args:python '()) +(defvar org-babel-python-command "python" + "Name of command to use for executing python code.") + (defun org-babel-expand-body:python (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." (concat @@ -56,13 +63,16 @@ called by `org-babel-execute-src-block'." (result-params (nth 2 processed-params)) (result-type (nth 3 processed-params)) (full-body (org-babel-expand-body:python - body params processed-params)) ;; then the source block body - (result (org-babel-python-evaluate session full-body result-type))) + body params processed-params)) + (result (org-babel-python-evaluate + session full-body result-type result-params))) (or (cdr (assoc :file params)) (org-babel-reassemble-table result - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + (org-babel-pick-name (nth 4 processed-params) + (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) + (cdr (assoc :rownames params))))))) (defun org-babel-prep-session:python (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -136,31 +146,25 @@ then create. Return the initialized session." ;; `py-shell' creates a buffer whose name is the value of ;; `py-which-bufname' with '*'s at the beginning and end (let* ((bufname (if python-buffer - (replace-regexp-in-string "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) ; zap surrounding * + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) (concat "Python-" (symbol-name session)))) - (py-which-bufname bufname)) ; avoid making a mess with buffer-local + (py-which-bufname bufname)) (py-shell) (setq python-buffer (concat "*" bufname "*")))) (t (error "No function available for running an inferior python."))) - - (setq org-babel-python-buffers (cons (cons session python-buffer) - (assq-delete-all session org-babel-python-buffers))) + (setq org-babel-python-buffers + (cons (cons session python-buffer) + (assq-delete-all session org-babel-python-buffers))) session))) (defun org-babel-python-initiate-session (&optional session params) "Create a session named SESSION according to PARAMS." (unless (string= session "none") - (org-babel-python-session-buffer (org-babel-python-initiate-session-by-key session)))) + (org-babel-python-session-buffer + (org-babel-python-initiate-session-by-key session)))) -(defvar org-babel-python-last-value-eval "_" - "When evaluated by Python this returns the return value of the last statement.") -(defvar org-babel-python-pp-last-value-eval - '("results = _" - "import pprint" - "org_babel_pp = pprint.PrettyPrinter()" - "org_babel_pp.pprint(results)") - "When evaluated by Python this pretty prints the value of the last statement.") (defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" "Used to indicate that evaluation is has completed.") (defvar org-babel-python-wrapper-method @@ -177,77 +181,74 @@ def main(): open('%s', 'w').write( pprint.pformat(main()) )") -(defun org-babel-python-evaluate (buffer body &optional result-type) +(defun org-babel-python-evaluate + (buffer body &optional result-type result-params) "Pass BODY to the Python process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (if (not session) + (if (not buffer) ;; external process evaluation - (save-excursion - (case result-type - (output - (with-temp-buffer - (insert body) - ;; (message "buffer=%s" (buffer-string)) ;; debugging - (org-babel-shell-command-on-region (point-min) (point-max) "python" 'current-buffer 'replace) - (buffer-string))) - (value - (let* ((tmp-file (make-temp-file "org-babel-python-results-")) exit-code - (stderr - (with-temp-buffer - (insert - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n") - tmp-file)) - ;; (message "buffer=%s" (buffer-string)) ;; debugging - (setq exit-code (org-babel-shell-command-on-region - (point-min) (point-max) "python" nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) - (let ((raw (with-temp-buffer - (insert-file-contents (org-babel-maybe-remote-file tmp-file)) - (buffer-string)))) - (if (or (member "code" result-params) (member "pp" result-params)) - raw - (org-babel-python-table-or-string raw))))))) + (case result-type + (output (org-babel-eval org-babel-python-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-eval org-babel-python-command + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) ;; comint session evaluation - (org-babel-comint-in-buffer buffer - (let* ((raw (org-babel-comint-with-output - (buffer org-babel-python-eoe-indicator t full-body) - ;; for some reason python is fussy, and likes enters after every input - (let ((comint-process-echoes nil)) - (mapc (lambda (statement) (insert statement) (comint-send-input)) - (split-string (org-babel-trim body) "[\r\n]+")) - (comint-send-input) (comint-send-input) - (if (member "pp" result-params) - (mapc (lambda (statement) (insert statement) (comint-send-input)) - org-babel-python-pp-last-value-eval) - (insert org-babel-python-last-value-eval)) - (comint-send-input) (comint-send-input) - (insert org-babel-python-eoe-indicator) - (comint-send-input)))) - (raw (apply #'append ; split further - (mapcar #'(lambda (r) - (split-string r "[\r\n]+")) - raw))) - (results (delete org-babel-python-eoe-indicator - (cdr (member org-babel-python-eoe-indicator - (mapcar #'org-babel-trim raw)))))) - (unless (or (member "code" result-params) (member "pp" result-params)) - (setq results (mapcar #'org-babel-python-read-string results))) - (case result-type - (output (org-babel-trim (mapconcat #'identity (reverse (cdr results)) "\n"))) - (value - (if (or (member "code" result-params) (member "pp" result-params)) - (car results) - (org-babel-python-table-or-string (org-babel-trim (car results)))))))))) + (flet ((dump-last-value (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pp" + (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) + (list (format "open('%s', 'w').write(str(_))" tmp-file))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file)))))))) (defun org-babel-python-read-string (string) "Strip 's from around python string" diff --git a/lisp/babel/ob-ref.el b/lisp/ob-ref.el similarity index 100% rename from lisp/babel/ob-ref.el rename to lisp/ob-ref.el diff --git a/lisp/babel/langs/ob-ruby.el b/lisp/ob-ruby.el similarity index 70% rename from lisp/babel/langs/ob-ruby.el rename to lisp/ob-ruby.el index d525bbe47..5f06d4cf2 100644 --- a/lisp/babel/langs/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -38,14 +38,23 @@ ;;; Code: (require 'ob) -(require 'inf-ruby) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-ruby "ext:inf-ruby" (&optional command name)) (add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) (defvar org-babel-default-header-args:ruby '()) +(defvar org-babel-ruby-command "ruby" + "Name of command to use for executing ruby code.") + (defun org-babel-expand-body:ruby (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." + (require 'inf-ruby) (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (concat (mapconcat ;; define any variables @@ -65,7 +74,8 @@ called by `org-babel-execute-src-block'." (result-type (nth 3 processed-params)) (full-body (org-babel-expand-body:ruby body params processed-params)) - (result (org-babel-ruby-evaluate session full-body result-type))) + (result (org-babel-ruby-evaluate + session full-body result-type result-params))) (or (cdr (assoc :file params)) (org-babel-reassemble-table result @@ -114,7 +124,6 @@ specifying a var of the same value." (defun org-babel-ruby-table-or-string (results) "If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (message "converting %S" results) (org-babel-read (if (and (stringp results) (string-match "^\\[.+\\]$" results)) (org-babel-read @@ -123,12 +132,13 @@ Emacs-lisp table, otherwise return the results as a string." "\\[" "(" (replace-regexp-in-string "\\]" ")" (replace-regexp-in-string ", " " " (replace-regexp-in-string - "'" "\"" results)))))) + "'" "\"" results)))))) results))) (defun org-babel-ruby-initiate-session (&optional session params) "If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." + (require 'inf-ruby) (unless (string= session "none") (let ((session-buffer (save-window-excursion (run-ruby nil session) (current-buffer)))) @@ -137,12 +147,12 @@ then create one. Return the initialized session." (sit-for .5) (org-babel-ruby-initiate-session session))))) -(defvar org-babel-ruby-last-value-eval "_" - "When evaluated by Ruby this returns the return value of the last statement.") -(defvar org-babel-ruby-pp-last-value-eval "require 'pp'; pp(_)" - "When evaluated by Ruby this pretty prints value of the last statement.") (defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" "Used to indicate that evaluation is has completed.") +(defvar org-babel-ruby-f-write + "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") +(defvar org-babel-ruby-pp-f-write + "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") (defvar org-babel-ruby-wrapper-method " def main() @@ -164,66 +174,70 @@ File.open('%s', 'w') do |f| end ") -(defun org-babel-ruby-evaluate (buffer body &optional result-type) +(defun org-babel-ruby-evaluate + (buffer body &optional result-type result-params) "Pass BODY to the Ruby process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (if (not session) + (if (not buffer) ;; external process evaluation - (save-excursion - (case result-type - (output - (with-temp-buffer - (insert body) - ;; (message "buffer=%s" (buffer-string)) ;; debugging - (org-babel-shell-command-on-region - (point-min) (point-max) "ruby" 'current-buffer 'replace) - (buffer-string))) - (value - (let* ((tmp-file (make-temp-file "ruby-functional-results")) - exit-code - (stderr - (with-temp-buffer - (insert (format (if (member "pp" result-params) - org-babel-ruby-pp-wrapper-method - org-babel-ruby-wrapper-method) - body tmp-file)) - (setq exit-code - (org-babel-shell-command-on-region - (point-min) (point-max) "ruby" - nil 'replace (current-buffer))) - (buffer-string)))) - (if (> exit-code 0) (org-babel-error-notify exit-code stderr)) - (let ((raw (with-temp-buffer - (insert-file-contents - (org-babel-maybe-remote-file tmp-file)) - (buffer-string)))) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-ruby-table-or-string raw))))))) - ;; comint session evaluation - (let* ((full-body - (mapconcat - #'org-babel-chomp - (list body (if (member "pp" result-params) - org-babel-ruby-pp-last-value-eval - org-babel-ruby-last-value-eval) - org-babel-ruby-eoe-indicator) "\n")) - (raw (org-babel-comint-with-output - (buffer org-babel-ruby-eoe-indicator t full-body) - (insert full-body) (comint-send-input nil t))) - (results (cdr (member - org-babel-ruby-eoe-indicator - (reverse (mapcar #'org-babel-ruby-read-string - (mapcar #'org-babel-trim raw))))))) (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value - (if (or (member "code" result-params) (member "pp" result-params)) - (car results) - (org-babel-ruby-table-or-string (car results)))))))) + (output (org-babel-eval org-babel-ruby-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-"))) + (org-babel-eval org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (case result-type + (output + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body org-babel-ruby-eoe-indicator)) + (comint-send-input nil t)) 2) + "\n") "[\r\n]")) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-ruby-table-or-string results))) + (let* ((tmp-file (make-temp-file "org-babel-ruby-results-")) + (ppp (or (member "code" result-params) + (member "pp" result-params)))) + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (when ppp (insert "require 'pp';") (comint-send-input nil t)) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (append + (list body) + (if (not ppp) + (list (format org-babel-ruby-f-write tmp-file)) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write tmp-file))) + (list org-babel-ruby-eoe-indicator))) + (comint-send-input nil t)) + (org-babel-eval-read-file tmp-file))))))) (defun org-babel-ruby-read-string (string) "Strip \\\"s from around a ruby string." diff --git a/lisp/babel/langs/ob-sass.el b/lisp/ob-sass.el similarity index 99% rename from lisp/babel/langs/ob-sass.el rename to lisp/ob-sass.el index 7cf7015ef..e762d3d33 100644 --- a/lisp/babel/langs/ob-sass.el +++ b/lisp/ob-sass.el @@ -40,7 +40,6 @@ ;;; Code: (require 'ob) -(require 'sass-mode) (defvar org-babel-default-header-args:sass '()) diff --git a/lisp/babel/langs/ob-screen.el b/lisp/ob-screen.el similarity index 92% rename from lisp/babel/langs/ob-screen.el rename to lisp/ob-screen.el index c7843565e..58425a72f 100644 --- a/lisp/babel/langs/ob-screen.el +++ b/lisp/ob-screen.el @@ -35,6 +35,7 @@ ;;; Code: (require 'ob) +(require 'ob-ref) (defvar org-babel-screen-location "screen" "The command location for screen. @@ -53,7 +54,7 @@ In case you want to use a different screen than one selected by your $PATH") (message "Sending source code block to interactive terminal session...") (save-window-excursion (let* ((processed-params (org-babel-process-params params)) - (session (first processed-params)) + (session (nth 0 processed-params)) (socket (org-babel-screen-session-socketname session))) (unless socket (org-babel-prep-session:screen session params)) (org-babel-screen-session-execute-string @@ -62,7 +63,7 @@ In case you want to use a different screen than one selected by your $PATH") (defun org-babel-prep-session:screen (session params) "Prepare SESSION according to the header arguments specified in PARAMS." (let* ((processed-params (org-babel-process-params params)) - (session (first processed-params)) + (session (nth 0 processed-params)) (vars (nth 1 processed-params)) (socket (org-babel-screen-session-socketname session)) (vars (org-babel-ref-variables params)) @@ -94,14 +95,22 @@ In case you want to use a different screen than one selected by your $PATH") (defun org-babel-screen-session-socketname (session) "Check if SESSION exist by parsing output of \"screen -ls\"." (let* ((screen-ls (shell-command-to-string "screen -ls")) - (sockets (remove-if-not - '(lambda (x) - (string-match (rx (or "(Attached)" "(Detached)")) x)) - (split-string screen-ls "\n"))) - (match-socket (find-if - '(lambda (x) - (string-match (concat "org-babel-session-" session) x)) - sockets))) + (sockets (delq + nil + (mapcar + (lambda (x) + (when (string-match (rx (or "(Attached)" "(Detached)")) x) + x)) + (split-string screen-ls "\n")))) + (match-socket (car + (delq + nil + (mapcar + (lambda (x) + (when (string-match + (concat "org-babel-session-" session) x) + x)) + sockets))))) (when match-socket (car (split-string match-socket))))) (defun org-babel-screen-session-write-temp-file (session body) diff --git a/lisp/babel/langs/ob-sh.el b/lisp/ob-sh.el similarity index 73% rename from lisp/babel/langs/ob-sh.el rename to lisp/ob-sh.el index 284164b1e..7c1d7cbb4 100644 --- a/lisp/babel/langs/ob-sh.el +++ b/lisp/ob-sh.el @@ -28,9 +28,10 @@ ;;; Code: (require 'ob) +(require 'ob-comint) +(require 'ob-eval) (require 'shell) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (declare-function org-babel-ref-variables "ob-ref" (params)) (declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) @@ -142,52 +143,30 @@ Emacs-lisp table, otherwise return the results as a string." 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY." - (if (not session) - ;; external process evaluation - (save-window-excursion - (with-temp-buffer - (insert body) - ;; (message "buffer=%s" (buffer-string)) ;; debugging - (org-babel-shell-command-on-region (point-min) (point-max) org-babel-sh-command 'current-buffer 'replace) - (cond - ((member "output" result-params) (buffer-string)) - ;; TODO: figure out how to return non-output values from shell scripts - (t ;; if not "output" then treat as "value" - (if (member "scalar" result-params) - (buffer-string) - (let ((tmp-file (make-temp-file "org-babel-sh")) - (results (buffer-string))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))))) - ;; comint session evaluation - (flet ((strip-empty (lst) - (delq nil (mapcar (lambda (el) (unless (= (length el) 0) el)) lst)))) - (let ((tmp-file (make-temp-file "org-babel-sh")) - (results - (cdr (member - org-babel-sh-eoe-output - (strip-empty - (reverse - (mapcar #'org-babel-sh-strip-weird-long-prompt - (mapcar #'org-babel-trim - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (mapc (lambda (line) (insert line) (comint-send-input)) - (strip-empty (split-string body "\n"))) - (insert org-babel-sh-eoe-indicator) - (comint-send-input)))))))))) - ;; (message (replace-regexp-in-string - ;; "%" "%%" (format "processed-results=%S" results))) ;; debugging - (or (and results - (cond - ((member "output" result-params) - (org-babel-trim (mapconcat #'org-babel-trim - (reverse results) "\n"))) - (t ;; if not "output" then treat as "value" - (with-temp-file tmp-file - (insert (car results)) (insert "\n")) - (org-babel-import-elisp-from-file tmp-file)))) - ""))))) + ((lambda (results) + (if (or (member "scalar" result-params) + (member "output" result-params)) + (buffer-string) + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))) + (if (not session) + (org-babel-eval org-babel-sh-command (org-babel-trim body)) + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n"))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." diff --git a/lisp/babel/langs/ob-sql.el b/lisp/ob-sql.el similarity index 95% rename from lisp/babel/langs/ob-sql.el rename to lisp/ob-sql.el index 9429ce042..e42b6cb61 100644 --- a/lisp/babel/langs/ob-sql.el +++ b/lisp/ob-sql.el @@ -44,6 +44,9 @@ ;;; Code: (require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-table-import "org-table" (file arg)) (defvar org-babel-default-header-args:sql '()) @@ -55,6 +58,7 @@ called by `org-babel-execute-src-block'." (message "executing Sql source code block") (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (processed-params (org-babel-process-params params)) (cmdline (cdr (assoc :cmdline params))) (engine (cdr (assoc :engine params))) (in-file (make-temp-file "org-babel-sql-in")) @@ -63,7 +67,7 @@ called by `org-babel-execute-src-block'." (command (case (intern engine) ('mysql (format "mysql %s -e \"source %s\" > %s" (or cmdline "") in-file out-file)) - (t (error "no support for the %s sql engine"))))) + (t (error "no support for the %s sql engine" engine))))) (with-temp-file in-file (insert (org-babel-expand-body:sql body params))) (message command) diff --git a/lisp/babel/langs/ob-sqlite.el b/lisp/ob-sqlite.el similarity index 61% rename from lisp/babel/langs/ob-sqlite.el rename to lisp/ob-sqlite.el index a8180fce5..5571019ef 100644 --- a/lisp/babel/langs/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -28,9 +28,18 @@ ;;; Code: (require 'ob) +(require 'ob-ref) + +(declare-function org-fill-template "org" (template alist)) +(declare-function org-table-convert-region + "org-table" (beg0 end0 &optional separator)) (defvar org-babel-default-header-args:sqlite '()) +(defvar org-babel-header-arg-names:sqlite + '(db header echo bail csv column html line list separator nullvalue) + "Sqlite specific header args.") + (defun org-babel-expand-body:sqlite (body params &optional processed-params) body) @@ -42,16 +51,44 @@ called by `org-babel-execute-src-block'." (message "executing Sqlite source code block") (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (vars (org-babel-ref-variables params)) - (headers-p (equal "yes" (cdr (assoc :colnames params))))) + (db (cdr (assoc :db params))) + (separator (cdr (assoc :separator params))) + (nullvalue (cdr (assoc :nullvalue params))) + (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (others (delq nil (mapcar + (lambda (arg) (car (assoc arg params))) + (list :header :echo :bail :column + :csv :html :line :list)))) + exit-code) + (message "others:%s" others) + (unless db (error "ob-sqlite: can't evaluate without a database.")) (with-temp-buffer (insert (shell-command-to-string - (format "%s %s -csv %s %S" - org-babel-sqlite3-command - (if headers-p "-header" "") - (cdr (assoc :db params)) - (org-babel-sqlite-expand-vars body vars)))) + (org-fill-template + "%cmd %header %separator %nullvalue %others %csv %db %body" + (list + (cons "cmd" org-babel-sqlite3-command) + (cons "header" (if headers-p "-header" "-noheader")) + (cons "separator" + (if separator (format "-separator %s" separator) "")) + (cons "nullvalue" + (if nullvalue (format "-nullvalue %s" nullvalue) "")) + (cons "others" + (mapconcat + (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) + others " ")) + ;; for easy table parsing, default header type should be -csv + (cons "csv" (if (or (member :csv others) (member :column others) + (member :line others) (member :list others) + (member :html others) separator) + "" + "-csv")) + (cons "db " db) + (cons "body" (format "%S" (org-babel-sqlite-expand-vars + body vars))))))) (if (or (member "scalar" result-params) + (member "html" result-params) (member "code" result-params)) (buffer-string) (org-table-convert-region (point-min) (point-max)) @@ -74,8 +111,11 @@ called by `org-babel-execute-src-block'." "If RESULT looks like a trivial table, then unwrap it." (if (and (equal 1 (length result)) (equal 1 (length (car result)))) - (caar result) - result)) + (org-babel-read (caar result)) + (mapcar (lambda (row) + (if (equal 'hline row) + 'hline + (mapcar #'org-babel-read row))) result))) (defun org-babel-sqlite-offset-colnames (table headers-p) "If HEADERS-P is non-nil then offset the first row as column names." diff --git a/lisp/babel/ob-table.el b/lisp/ob-table.el similarity index 100% rename from lisp/babel/ob-table.el rename to lisp/ob-table.el diff --git a/lisp/babel/ob-tangle.el b/lisp/ob-tangle.el similarity index 97% rename from lisp/babel/ob-tangle.el rename to lisp/ob-tangle.el index 00e1faa63..484309b11 100644 --- a/lisp/babel/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -34,13 +34,6 @@ (declare-function org-link-escape "org" (text &optional table)) -(defcustom org-babel-tangle-w-comments nil - "Control the insertion of comments into tangled code. Non-nil -value will result in the insertion of comments for those -languages with comment support." - :group 'org-babel-tangle - :type 'boolean) - (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "Alist mapping languages to their file extensions. @@ -247,8 +240,7 @@ form (body (nth 3 spec)) (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) (flet ((insert-comment (text) - (when (and commentable - org-babel-tangle-w-comments) + (when commentable (insert "\n") (comment-region (point) (progn (insert text) (point))) diff --git a/lisp/babel/ob.el b/lisp/ob.el similarity index 88% rename from lisp/babel/ob.el rename to lisp/ob.el index 6a42bcc31..11a9fd8cf 100644 --- a/lisp/babel/ob.el +++ b/lisp/ob.el @@ -61,6 +61,34 @@ (declare-function org-babel-ref-variables "ob-ref" (params)) (declare-function org-babel-ref-resolve-reference "ob-ref" (ref &optional params)) +(defcustom org-confirm-babel-evaluate t + "Require confirmation before interactively evaluating code +blocks in Org-mode buffers. The default value of this variable +is t, meaning confirmation is required for any code block +evaluation. This variable can be set to nil to inhibit any +future confirmation requests. This variable can also be set to a +function which takes two arguments the language of the code block +and the body of the code block. Such a function should then +return a non-nil value if the user should be prompted for +execution or nil if no prompt is required. + +Warning: Disabling confirmation may result in accidental +evaluation of potentially harmful code. It may be advisable +remove code block execution from C-c C-c as further protection +against accidental code block evaluation. The +`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to +remove code block execution from the C-c C-c keybinding." + :group 'org-babel + :type '(choice boolean function)) +;; don't allow this variable to be changed through file settings +(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) + +(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil + "This variable can be set to remove code block evaluation from +the C-c C-c key binding." + :group 'org-babel + :type 'boolean) + (defvar org-babel-source-name-regexp "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" "Regular expression used to match a source name line.") @@ -134,15 +162,34 @@ added to the header-arguments-alist." (org-babel-parse-inline-src-block-match) nil)))) +(defun org-babel-confirm-evaluate (info) + "Confirm that the user wishes to evaluate the code block +defined by INFO. This behavior can be suppressed by setting the +value of `org-confirm-babel-evaluate' to nil, in which case all +future interactive code block evaluations will proceed without +any confirmation from the user. + +Note disabling confirmation may result in accidental evaluation +of potentially harmful code." + (unless (or (not (if (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info)) + org-confirm-babel-evaluate)) + (yes-or-no-p + (format "Evaluate this%scode on your system?" + (if info (format " %s " (nth 0 info)) " ")))) + (error "evaluation aborted"))) + ;;;###autoload (defun org-babel-execute-src-block-maybe () "Detect if this is context for a org-babel src-block and if so then run `org-babel-execute-src-block'." (interactive) - (let ((info (org-babel-get-src-block-info))) - (if info - (progn (org-babel-execute-src-block current-prefix-arg info) t) nil))) - + (if (not org-babel-no-eval-on-ctrl-c-ctrl-c) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)) + nil)) (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe) ;;;###autoload @@ -241,6 +288,10 @@ the header arguments specified at the front of the source code block." (interactive) (let* ((info (or info (org-babel-get-src-block-info))) + ;; note the `evaluation-confirmed' variable is currently not + ;; used, but could be used later to avoid the need for + ;; chaining confirmations + (evaluation-confirmed (org-babel-confirm-evaluate info)) (lang (nth 0 info)) (params (setf (nth 2 info) (sort (org-babel-merge-params (nth 2 info) params) @@ -1022,7 +1073,7 @@ code ---- the results are extracted in the syntax of the source (listp (cdr (car result))))) result (list result)) '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (org-table-align)) + (goto-char beg) (when (org-at-table-p) (org-table-align))) ((member "file" result-params) (insert result)) ((member "html" result-params) @@ -1298,16 +1349,6 @@ block but are passed literally to the \"example-block\"." (nb-add (buffer-substring index (point-max))))) new-body)) -(defun org-babel-error-notify (exit-code stderr) - "Open a buffer containing information from STDERR with a -message about the value of EXIT-CODE." - (message (format "Shell command exited with code %d" exit-code)) - (let ((buf (get-buffer-create "*Org-Babel Error Output*"))) - (with-current-buffer buf - (goto-char (point-max)) - (save-excursion (insert stderr))) - (display-buffer buf))) - (defun org-babel-clean-text-properties (text) "Strip all properties from text return." (when text @@ -1420,191 +1461,6 @@ the remote connection." (concat "/" user (when user "@") host ":" file)) file)) -(defun org-babel-shell-command-on-region (start end command - &optional output-buffer replace - error-buffer display-error-buffer) - "Execute string COMMAND in inferior shell with region as input. - -Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' - -Normally display output (if any) in temp buffer `*Shell Command Output*'; -Prefix arg means replace the region with it. Return the exit code of -COMMAND. - -To specify a coding system for converting non-ASCII characters in -the input and output to the shell command, use -\\[universal-coding-system-argument] before this command. By -default, the input (from the current buffer) is encoded in the -same coding system that will be used to save the file, -`buffer-file-coding-system'. If the output is going to replace -the region, then it is decoded from that same coding system. - -The noninteractive arguments are START, END, COMMAND, -OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. -Noninteractive callers can specify coding systems by binding -`coding-system-for-read' and `coding-system-for-write'. - -If the command generates output, the output may be displayed -in the echo area or in a buffer. -If the output is short enough to display in the echo area -\(determined by the variable `max-mini-window-height' if -`resize-mini-windows' is non-nil), it is shown there. Otherwise -it is displayed in the buffer `*Shell Command Output*'. The output -is available in that buffer in both cases. - -If there is output and an error, a message about the error -appears at the end of the output. - -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - -If the optional fourth argument OUTPUT-BUFFER is non-nil, -that says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in the current buffer. -In either case, the output is inserted after point (leaving mark after it). - -If REPLACE, the optional fifth argument, is non-nil, that means insert -the output in place of text from START to END, putting point and mark -around it. - -If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer -or buffer name to which to direct the command's standard error output. -If it is nil, error output is mingled with regular output. -If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there -were any errors. (This is always t, interactively.) -In an interactive call, the variable `shell-command-default-error-buffer' -specifies the value of ERROR-BUFFER." - (interactive (let (string) - (unless (mark) - (error "The mark is not set now, so there is no region")) - ;; Do this before calling region-beginning - ;; and region-end, in case subprocess output - ;; relocates them while we are in the minibuffer. - (setq string (read-shell-command "Shell command on region: ")) - ;; call-interactively recognizes region-beginning and - ;; region-end specially, leaving them in the history. - (list (region-beginning) (region-end) - string - current-prefix-arg - current-prefix-arg - shell-command-default-error-buffer - t))) - (let ((error-file - (if error-buffer - (make-temp-file - (expand-file-name "scor" - (or (unless (featurep 'xemacs) - small-temporary-file-directory) - temporary-file-directory))) - nil)) - exit-status) - (if (or replace - (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer))))) - ;; Replace specified region with output from command. - (let ((swap (and replace (< start end)))) - ;; Don't muck with mark unless REPLACE says we should. - (goto-char start) - (and replace (push-mark (point) 'nomsg)) - (setq exit-status - (call-process-region start end shell-file-name t - (if error-file - (list output-buffer error-file) - t) - nil shell-command-switch command)) - ;; It is rude to delete a buffer which the command is not using. - ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) - ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) - ;; (kill-buffer shell-buffer))) - ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark))) - ;; No prefix argument: put the output in a temp buffer, - ;; replacing its entire contents. - (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) - (unwind-protect - (if (eq buffer (current-buffer)) - ;; If the input is the same buffer as the output, - ;; delete everything but the specified region, - ;; then replace that region with the output. - (progn (setq buffer-read-only nil) - (delete-region (max start end) (point-max)) - (delete-region (point-min) (min start end)) - (setq exit-status - (call-process-region (point-min) (point-max) - shell-file-name t - (if error-file - (list t error-file) - t) - nil shell-command-switch - command))) - ;; Clear the output buffer, then run the command with - ;; output there. - (let ((directory default-directory)) - (save-current-buffer - (set-buffer buffer) - (setq buffer-read-only nil) - (if (not output-buffer) - (setq default-directory directory)) - (erase-buffer))) - (setq exit-status - (call-process-region start end shell-file-name nil - (if error-file - (list buffer error-file) - buffer) - nil shell-command-switch command))) - ;; Report the output. - (with-current-buffer buffer - (setq mode-line-process - (cond ((null exit-status) - " - Error") - ((stringp exit-status) - (format " - Signal [%s]" exit-status)) - ((not (equal 0 exit-status)) - (format " - Exit [%d]" exit-status))))) - (if (with-current-buffer buffer (> (point-max) (point-min))) - ;; There's some output, display it - (display-message-or-buffer buffer) - ;; No output; error? - (let ((output - (if (and error-file - (< 0 (nth 7 (file-attributes error-file)))) - "some error output" - "no output"))) - (cond ((null exit-status) - (message "(Shell command failed with error)")) - ((equal 0 exit-status) - (message "(Shell command succeeded with %s)" - output)) - ((stringp exit-status) - (message "(Shell command killed by signal %s)" - exit-status)) - (t - (message "(Shell command failed with code %d and %s)" - exit-status output)))) - ;; Don't kill: there might be useful info in the undo-log. - ;; (kill-buffer buffer) - )))) - - (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) - (with-current-buffer (get-buffer-create error-buffer) - (let ((pos-from-end (- (point-max) (point)))) - (or (bobp) - (insert "\f\n")) - ;; Do no formatting while reading error file, - ;; because that can run a shell command, and we - ;; don't want that to cause an infinite recursion. - (format-insert-file error-file nil) - ;; Put point after the inserted errors. - (goto-char (- (point-max) pos-from-end))) - (and display-error-buffer - (display-buffer (current-buffer))))) - (delete-file error-file)) - exit-status)) - (provide 'ob) ;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 diff --git a/lisp/org.el b/lisp/org.el index c8cfa0fe9..99dbdc14b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -119,7 +119,62 @@ (require 'ob-tangle) (require 'ob-comint) (require 'ob-keys) -(require 'ob-emacs-lisp) + +;; load languages based on value of `org-babel-load-languages' +(defvar org-babel-load-languages) +(defun org-babel-do-load-languages (sym value) + "Load the languages defined in `org-babel-load-languages'." + (set-default sym value) + (mapc (lambda (pair) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (progn + (require (intern (concat "ob-" lang)))) + (progn + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) + org-babel-load-languages)) + +(defcustom org-babel-load-languages '((emacs-lisp . t)) + "Languages which can be evaluated in Org-mode buffers. This +list can be used to load support for any of the languages below, +note that each language will depend on a different set of system +executables and/or Emacs modes. When a language is \"loaded\", +then code blocks in that language can be evaluated with +`org-babel-execute-src-block' bound by default to C-c C-c (note +the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be set to +remove code block evaluation from the C-c C-c keybinding. By +default only Emacs Lisp (which has no requirements) is loaded." + :group 'org-babel + :set 'org-babel-do-load-languages + :type '(alist :tag "Babel Languages" + :key-type + (choice + (const :tag "C" C) + (const :tag "R" R) + (const :tag "Asymptote" asymptote) + (const :tag "Clojure" clojure) + (const :tag "CSS" css) + (const :tag "Ditaa" ditaa) + (const :tag "Dot" dot) + (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Gnuplot" gnuplot) + (const :tag "Haskell" haskell) + (const :tag "Latex" latex) + (const :tag "Matlab" matlab) + (const :tag "Ocaml" ocaml) + (const :tag "Octave" octave) + (const :tag "Perl" perl) + (const :tag "Python" python) + (const :tag "Ruby" ruby) + (const :tag "Sass" sass) + (const :tag "Screen" screen) + (const :tag "Shell Script" sh) + (const :tag "Sql" sql) + (const :tag "Sqlite" sqlite)) + :value-type (boolean :tag "Activate" :value t))) ;;;; Customization variables (defcustom org-clone-delete-id nil @@ -17021,7 +17076,13 @@ This command does many different things, depending on context: - If the cursor is on a numbered item in a plain list, renumber the ordered list. -- If the cursor is on a checkbox, toggle it." +- If the cursor is on a checkbox, toggle it. + +- If the cursor is on a code block, evaluate it. The variable + `org-confirm-babel-evaluate' can be used to control prompting + before code block evaluation, by default every code block + evaluation requires confirmation. Code block evaluation can be + inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (let ((org-enable-table-editor t)) (cond