ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'safety-babel'

This commit is contained in:
Eric Schulte 2010-07-05 11:31:03 -07:00
parent 1217e02e56 f268317f70
commit 5ded079a1a
34 changed files with 1072 additions and 753 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
Makefile
View File

@ -18,8 +18,6 @@ prefix=/usr/local
# Where local lisp files go. # Where local lisp files go.
lispdir = $(prefix)/share/emacs/site-lisp lispdir = $(prefix)/share/emacs/site-lisp
lispbdir = $(lispdir)/babel
lispbldir = $(lispbdir)/langs
# Where info files go. # Where info files go.
infodir = $(prefix)/share/info infodir = $(prefix)/share/info
@ -31,11 +29,7 @@ infodir = $(prefix)/share/info
# Using emacs in batch mode. # Using emacs in batch mode.
BATCH=$(EMACS) -batch -q -no-site-file -eval \ BATCH=$(EMACS) -batch -q -no-site-file -eval \
"(setq load-path (cons (expand-file-name\ "(setq load-path (cons (expand-file-name \"./lisp/\") (cons \"$(lispdir)\" load-path)))"
\"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)))))"
# Specify the byte-compiler for compiling org-mode files # Specify the byte-compiler for compiling org-mode files
ELC= $(BATCH) -f batch-byte-compile ELC= $(BATCH) -f batch-byte-compile
@ -120,18 +114,17 @@ LISPF = org.el \
org-vm.el \ org-vm.el \
org-w3m.el \ org-w3m.el \
org-wl.el \ org-wl.el \
org-xoxo.el org-xoxo.el \
ob.el \
LISPBF = ob.el \
ob-table.el \ ob-table.el \
ob-lob.el \ ob-lob.el \
ob-ref.el \ ob-ref.el \
ob-exp.el \ ob-exp.el \
ob-tangle.el \ ob-tangle.el \
ob-comint.el \ ob-comint.el \
ob-keys.el ob-eval.el \
ob-keys.el \
LISPBLF = ob-C.el \ ob-C.el \
ob-ditaa.el \ ob-ditaa.el \
ob-haskell.el \ ob-haskell.el \
ob-perl.el \ ob-perl.el \
@ -156,11 +149,8 @@ LISPBLF = ob-C.el \
LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES0 = $(LISPF:%=lisp/%)
LISPFILES = $(LISPFILES0) lisp/org-install.el LISPFILES = $(LISPFILES0) lisp/org-install.el
LISPBFILES = $(LISPBF:%=lisp/babel/%)
LISPBLFILES = $(LISPBLF:%=lisp/babel/langs/%)
ELCFILES0 = $(LISPFILES0:.el=.elc) ELCFILES0 = $(LISPFILES0:.el=.elc)
ELCFILES = $(LISPFILES:.el=.elc) ELCFILES = $(LISPFILES:.el=.elc)
ELCBFILES = $(LISPBFILES:.el=.elc)
DOCFILES = doc/org.texi doc/org.pdf doc/org doc/dir \ DOCFILES = doc/org.texi doc/org.pdf doc/org doc/dir \
doc/pdflayout.sty doc/.nosearch \ doc/pdflayout.sty doc/.nosearch \
doc/orgguide.texi doc/orgguide.pdf doc/orgguide.texi doc/orgguide.pdf
@ -200,15 +190,10 @@ p:
g: g:
${MAKE} pdf && open doc/orgguide.pdf ${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 $(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) $(LISPFILES) $(lispdir)
$(CP) $(ELCFILES) $(lispdir) $(CP) $(ELCFILES) $(lispdir)
$(CP) $(LISPBFILES) $(lispbdir)
$(CP) $(ELCBFILES) $(lispbdir)
$(CP) $(LISPBLFILES) $(lispbldir)
install-info: $(INFOFILES) install-info: $(INFOFILES)
if [ ! -d $(infodir) ]; then $(MKDIR) $(infodir); else true; fi ; if [ ! -d $(infodir) ]; then $(MKDIR) $(infodir); else true; fi ;
@ -224,13 +209,11 @@ install-noutline: xemacs/noutline.elc
autoloads: lisp/org-install.el autoloads: lisp/org-install.el
lisp/org-install.el: $(LISPFILES0) $(LISPBFILES) Makefile lisp/org-install.el: $(LISPFILES0) Makefile
$(BATCH) --eval "(require 'autoload)" \ $(BATCH) --eval "(require 'autoload)" \
--eval '(find-file "org-install.el")' \ --eval '(find-file "org-install.el")' \
--eval '(erase-buffer)' \ --eval '(erase-buffer)' \
--eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPFILES0) $(LISPBFILES))))' \ --eval '(mapc (lambda (x) (generate-file-autoloads (symbol-name x))) (quote ($(LISPFILES0))))' \
--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 '(insert "\n(provide (quote org-install))\n")' \ --eval '(insert "\n(provide (quote org-install))\n")' \
--eval '(save-buffer)' --eval '(save-buffer)'
mv org-install.el lisp mv org-install.el lisp
@ -300,10 +283,7 @@ distfile:
$(MKDIR) org-$(TAG)/xemacs $(MKDIR) org-$(TAG)/xemacs
$(MKDIR) org-$(TAG)/doc $(MKDIR) org-$(TAG)/doc
$(MKDIR) org-$(TAG)/lisp $(MKDIR) org-$(TAG)/lisp
$(MKDIR) org-$(TAG)/lisp/babel
$(MKDIR) org-$(TAG)/lisp/babel/langs
cp -r $(LISPFILES) org-$(TAG)/lisp cp -r $(LISPFILES) org-$(TAG)/lisp
cp -r $(LISPBFILES) org-$(TAG)/lisp/babel
cp -r $(DOCFILES) $(CARDFILES) org-$(TAG)/doc cp -r $(DOCFILES) $(CARDFILES) org-$(TAG)/doc
cp -r $(DISTFILES_extra) org-$(TAG)/ cp -r $(DISTFILES_extra) org-$(TAG)/
cp -r README_DIST org-$(TAG)/README cp -r README_DIST org-$(TAG)/README

65
doc/org.texi
View File

@ -11128,6 +11128,13 @@ Choose a file to tangle.
@cindex code block, evaluating @cindex code block, evaluating
@cindex source code, 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. 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, By default, evaluation is only turned on for @code{emacs-lisp} code blocks,
however support exists for evaluating blocks in many languages. See 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 @kindex C-c C-c
There are a number of ways to evaluate code blocks. The simplest is to 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 press @kbd{C-c C-c} or @kbd{C-c C-v e} with the point on a code block. This
@code{org-babel-execute-src-block} function to evaluate the block and will call the @code{org-babel-execute-src-block} function to evaluate the
insert its results into the Org-mode buffer. 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 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 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 available, it can be found at
@uref{http://orgmode.org/worg/org-contrib/babel/languages}. @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 @lisp
(require 'ob-identifier) (org-babel-do-load-languages
'org-babel-load-languages
'((emacs-lisp . nil)
(R . t)))
@end lisp @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 @lisp
(require 'ob-sass) (require 'ob-clojure)
@end lisp @end lisp
@end enumerate
@node Header arguments, Results of evaluation, Languages, Working With Source Code @node Header arguments, Results of evaluation, Languages, Working With Source Code
@section Header arguments @section Header arguments
@ -11394,6 +11417,7 @@ The following header arguments are defined:
* exports:: Export code and/or results * exports:: Export code and/or results
* tangle:: Toggle tangling and specify file name * tangle:: Toggle tangling and specify file name
* no-expand:: Turn off variable assignment and noweb expansion during tangling * 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 * session:: Preserve the state of code evaluation
* noweb:: Toggle expansion of noweb references * noweb:: Toggle expansion of noweb references
* cache:: Avoid re-evaluating unchanged code blocks * 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}. Nothing is included in the exported file. E.g., @code{:exports none}.
@end itemize @end itemize
@node tangle, no-expand, exports, Specific header arguments @node tangle, comments, exports, Specific header arguments
@subsubsection @code{:tangle} @subsubsection @code{:tangle}
The @code{:tangle} header argument specifies whether or not the code 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}. basename}.
@end itemize @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} @subsubsection @code{:no-expand}
By default, code blocks are expanded with @code{org-babel-expand-src-block} 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. which take of the default security brakes.
@defopt org-confirm-babel-evaluate @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 @end defopt
@item Following @code{shell} and @code{elisp} links @item Following @code{shell} and @code{elisp} links

18
lisp/babel/langs/ob-C.el → lisp/ob-C.el
View File

@ -32,10 +32,12 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(require 'org) (require 'org)
(require 'cc-mode) (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")) (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-reassemble-table
(org-babel-read (org-babel-read
(org-babel-trim (org-babel-trim
(with-temp-buffer (org-babel-eval
(org-babel-shell-command-on-region (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))
(point-min) (point-max) (org-babel-pick-name
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) (nth 4 processed-params) (cdr (assoc :colnames params)))
(current-buffer) 'replace) (org-babel-pick-name
(buffer-string)))) (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))))
(progn (progn
(with-current-buffer error-buf (with-current-buffer error-buf
(goto-char (point-max)) (goto-char (point-max))

207
lisp/babel/langs/ob-R.el → lisp/ob-R.el
View File

@ -28,6 +28,14 @@
;;; Code: ;;; Code:
(require 'ob) (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 (defconst org-babel-header-arg-names:R
'(width height bg units pointsize antialias quality compression '(width height bg units pointsize antialias quality compression
@ -37,26 +45,40 @@
(defvar org-babel-default-header-args:R '()) (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) (defun org-babel-expand-body:R (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let* ((processed-params (or processed-params (let* ((processed-params (or processed-params
(org-babel-process-params params))) (org-babel-process-params params)))
(vars (mapcar (lambda (i) (cons (car (nth i (nth 1 processed-params))) (vars (mapcar
(org-babel-reassemble-table (lambda (i)
(cdr (nth i (nth 1 processed-params))) (cons (car (nth i (nth 1 processed-params)))
(cdr (nth i (nth 4 processed-params))) (org-babel-reassemble-table
(cdr (nth i (nth 5 processed-params)))))) (cdr (nth i (nth 1 processed-params)))
(number-sequence 0 (1- (length (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)))) (out-file (cdr (assoc :file params))))
(concat (mapconcat ;; define any variables
(if out-file (concat (org-babel-R-construct-graphics-device-call out-file params) "\n") "") #'org-babel-trim
(mapconcat ;; define any variables ((lambda (inside)
(lambda (pair) (if out-file
(org-babel-R-assign-elisp (car pair) (cdr pair) (append
(equal "yes" (cdr (assoc :colnames params))) (list (org-babel-R-construct-graphics-device-call out-file params))
(equal "yes" (cdr (assoc :rownames params))))) inside
vars "\n") (list "dev.off()"))
"\n" body "\n" (if out-file "dev.off()\n" "")))) 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) (defun org-babel-execute:R (body params)
"Execute a block of R code with org-babel. This function is "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 (save-excursion
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(result-type (nth 3 processed-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))) (colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params))) (rownames-p (cdr (assoc :rownames params)))
(out-file (cdr (assoc :file 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)) (org-babel-pick-name (nth 4 processed-params) colnames-p))
(or (equal "yes" rownames-p) (or (equal "yes" rownames-p)
(org-babel-pick-name (nth 5 processed-params) rownames-p))))) (org-babel-pick-name (nth 5 processed-params) rownames-p)))))
(message "result is %S" result)
(or out-file result)))) (or out-file result))))
(defun org-babel-prep-session:R (session params) (defun org-babel-prep-session:R (session params)
@ -86,9 +110,9 @@ called by `org-babel-execute-src-block'."
(var-lines (var-lines
(mapcar (mapcar
(lambda (pair) (org-babel-R-assign-elisp (lambda (pair) (org-babel-R-assign-elisp
(car pair) (cdr pair) (car pair) (cdr pair)
(equal (cdr (assoc :colnames params)) "yes") (equal (cdr (assoc :colnames params)) "yes")
(equal (cdr (assoc :rownames params)) "yes"))) (equal (cdr (assoc :rownames params)) "yes")))
vars))) vars)))
(org-babel-comint-in-buffer session (org-babel-comint-in-buffer session
(mapc (lambda (var) (mapc (lambda (var)
@ -136,9 +160,14 @@ called by `org-babel-execute-src-block'."
(if (org-babel-comint-buffer-livep session) (if (org-babel-comint-buffer-livep session)
session session
(save-window-excursion (save-window-excursion
(R) (require 'ess) (R)
(rename-buffer (if (bufferp session) (buffer-name session) (rename-buffer
(if (stringp session) session (buffer-name)))) (current-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) (defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device." "Construct the call to the graphics device."
@ -153,25 +182,36 @@ called by `org-babel-execute-src-block'."
(:ps . "postscript") (:ps . "postscript")
(:postscript . "postscript"))) (:postscript . "postscript")))
(allowed-args '(:width :height :bg :units :pointsize (allowed-args '(:width :height :bg :units :pointsize
:antialias :quality :compression :res :type :antialias :quality :compression :res
:family :title :fonts :version :paper :encoding :type :family :title :fonts :version
:pagecentre :colormodel :useDingbats :horizontal)) :paper :encoding :pagecentre :colormodel
(device (and (string-match ".+\\.\\([^.]+\\)" out-file) (match-string 1 out-file))) :useDingbats :horizontal))
(device (and (string-match ".+\\.\\([^.]+\\)" out-file)
(match-string 1 out-file)))
(extra-args (cdr (assq :R-dev-args params))) filearg args) (extra-args (cdr (assq :R-dev-args params))) filearg args)
(setq device (or (and device (cdr (assq (intern (concat ":" device)) devices))) "png")) (setq device (or (and device (cdr (assq (intern (concat ":" device))
(setq filearg (if (member device '("pdf" "postscript" "svg")) "file" "filename")) devices))) "png"))
(setq args (mapconcat (lambda (pair) (setq filearg
(if (member (car pair) allowed-args) (if (member device '("pdf" "postscript" "svg")) "file" "filename"))
(format ",%s=%s" (substring (symbol-name (car pair)) 1) (cdr pair)) "")) (setq args (mapconcat
params "")) (lambda (pair)
(format "%s(%s=\"%s\"%s%s%s)\n" device filearg out-file args (if extra-args "," "") (or extra-args "")))) (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-indicator "'org_babel_R_eoe'")
(defvar org-babel-R-eoe-output "[1] \"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} (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)") 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 "Pass BODY to the R process in SESSION. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the 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) (if (not session)
;; external process evaluation ;; external process evaluation
(case result-type (case result-type
(output (output (org-babel-eval org-babel-R-command body))
(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))))
(value (value
(let* ((tmp-file (make-temp-file "R-out-functional-results")) exit-code (let ((tmp-file (make-temp-file "org-babel-R-results-")))
(stderr (org-babel-eval org-babel-R-command
(with-temp-buffer (format org-babel-R-wrapper-method
(insert (format org-babel-R-wrapper-method body tmp-file
body tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE"))) (if row-names-p "TRUE" "FALSE")
(setq exit-code (org-babel-shell-command-on-region (if column-names-p
(point-min) (point-max) "R --no-save" nil 'replace (current-buffer))) (if row-names-p "NA" "TRUE")
(buffer-string)))) "FALSE")))
(if (> exit-code 0) (org-babel-error-notify exit-code stderr))
(org-babel-R-process-value-result (org-babel-R-process-value-result
(org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file)) (org-babel-import-elisp-from-file
column-names-p)))) (org-babel-maybe-remote-file tmp-file)) column-names-p))))
;; comint session evaluation ;; comint session evaluation
(org-babel-comint-in-buffer session (case result-type
(let* ((tmp-file (make-temp-file "org-babel-R")) (value
(full-body (let ((tmp-file (make-temp-file "org-babel-R"))
(case result-type broke)
(value (org-babel-comint-with-output (session org-babel-R-eoe-output)
(mapconcat #'org-babel-chomp (list body (insert (mapconcat
(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-chomp
org-babel-R-eoe-indicator) "\n")) (list
(output body
(mapconcat #'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n")))) (format org-babel-R-wrapper-lastvar
(raw tmp-file
(org-babel-comint-with-output (session org-babel-R-eoe-output) (if row-names-p "TRUE" "FALSE")
(insert full-body) (inferior-ess-send-input))) (if column-names-p
(comint-prompt-regexp (if row-names-p "NA" "TRUE")
(concat "^\\(" "FALSE"))
inferior-ess-primary-prompt org-babel-R-eoe-indicator) "\n"))
"\\|" (inferior-ess-send-input))
inferior-ess-secondary-prompt (org-babel-R-process-value-result
"\\)*")) (org-babel-import-elisp-from-file
broke results) (org-babel-maybe-remote-file tmp-file)) column-names-p)))
(case result-type (output
(value (org-babel-R-process-value-result (mapconcat
(org-babel-import-elisp-from-file #'org-babel-chomp
(org-babel-maybe-remote-file tmp-file)) (butlast
column-names-p)) (delq nil
(output (mapcar
(flet ((extractor #'identity
(el) (org-babel-comint-with-output (session org-babel-R-eoe-output)
(if (or broke (insert (mapconcat #'org-babel-chomp
(and (string-match (regexp-quote org-babel-R-eoe-output) el) (list body org-babel-R-eoe-indicator)
(setq broke t))) "\n"))
nil (inferior-ess-send-input)))) 2) "\n")))))
(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"))))))))
(defun org-babel-R-process-value-result (result column-names-p) (defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value prior to return to "R-specific processing of return value prior to return to

3
lisp/babel/langs/ob-asymptote.el → lisp/ob-asymptote.el
View File

@ -46,6 +46,9 @@
(require 'ob) (require 'ob)
(eval-when-compile (require 'cl)) (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")) (add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
(defvar org-babel-default-header-args:asymptote (defvar org-babel-default-header-args:asymptote

119
lisp/babel/langs/ob-clojure.el → lisp/ob-clojure.el
View File

@ -39,9 +39,16 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'cl) (require 'ob-eval)
(require 'slime) (eval-when-compile (require 'cl))
(require 'swank-clojure)
(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")) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
@ -63,7 +70,8 @@
[] []
%s) %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 ;;taken mostly from clojure-test-mode.el
(defun org-babel-clojure-clojure-slime-eval (string &optional handler) (defun org-babel-clojure-clojure-slime-eval (string &optional handler)
@ -76,16 +84,23 @@
(slime-eval `(swank:eval-and-grab-output ,string))) (slime-eval `(swank:eval-and-grab-output ,string)))
;;taken from swank-clojure.el ;;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 () (defun org-babel-clojure-babel-clojure-cmd ()
"Create the command to start clojure according to current settings." "Create the command to start clojure according to current settings."
(if (and (not swank-clojure-binary) (not swank-clojure-classpath)) (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 swank-clojure-binary
(if (listp swank-clojure-binary) (if (listp swank-clojure-binary)
swank-clojure-binary swank-clojure-binary
(list swank-clojure-binary)) (list swank-clojure-binary))
(delete-if (delq
'null nil
(append (append
(list swank-clojure-java-path) (list swank-clojure-java-path)
swank-clojure-extra-vm-args 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) (defun org-babel-clojure-build-full-form (body vars)
"Construct a clojure let form with vars as the let vars." "Construct a clojure let form with vars as the let vars."
(let ((vars-forms (mapconcat ;; define any variables (let ((vars-forms
(lambda (pair) (mapconcat ;; define any variables
(format "%s %s" (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) (lambda (pair)
vars "\n ")) (format "%s %s"
(car pair) (org-babel-clojure-var-to-clojure (cdr pair))))
vars "\n "))
(body (org-babel-trim body))) (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) (defun org-babel-prep-session:clojure (session params)
"Prepare SESSION according to the header arguments specified in 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)) (let* ((session-buf (org-babel-clojure-initiate-session session))
(vars (org-babel-ref-variables params)) (vars (org-babel-ref-variables params))
(var-lines (mapcar ;; define any top level session variables (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) (defun org-babel-load-session:clojure (session body params)
"Load BODY into SESSION." "Load BODY into SESSION."
(require 'slime) (require 'swank-clojure)
(save-window-excursion (save-window-excursion
(let ((buffer (org-babel-prep-session:clojure session params))) (let ((buffer (org-babel-prep-session:clojure session params)))
(with-current-buffer buffer (with-current-buffer buffer
@ -164,10 +185,11 @@ then create one. Return the initialized session."
(let* ((session (if session (let* ((session (if session
(if (stringp session) (intern session) (if (stringp session) (intern session)
session) session)
:default)) :default))
(clojure-buffer (org-babel-clojure-session-buffer session))) (clojure-buffer (org-babel-clojure-session-buffer session)))
(unless (and clojure-buffer (buffer-live-p clojure-buffer)) (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) (push session org-babel-clojure-pending-sessions)
(slime) (slime)
;; we are waiting to finish setting up which will be done in ;; 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)) (let ((timeout 9))
(while (and (not (org-babel-clojure-session-buffer session)) (while (and (not (org-babel-clojure-session-buffer session))
(< 0 timeout)) (< 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) (sit-for 1)
(decf timeout))) (decf timeout)))
(setq org-babel-clojure-pending-sessions (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) (defun org-babel-clojure-initiate-session (&optional session params)
"Return the slime-clojure repl buffer bound to this session "Return the slime-clojure repl buffer bound to this session
or nil if \"none\" is specified." or nil if \"none\" is specified."
(require 'slime) (require 'swank-clojure)
(unless (and (stringp session) (string= session "none")) (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 () (defun org-babel-clojure-session-connected-hook ()
"Finish setting up the bindings of org-babel session to a slime-clojure repl." "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 (when pending-session
(save-excursion (save-excursion
(switch-to-buffer (slime-output-buffer)) (switch-to-buffer (slime-output-buffer))
(rename-buffer (if (stringp pending-session) pending-session (symbol-name pending-session))) (rename-buffer
(org-babel-clojure-bind-session-to-repl-buffer pending-session (slime-output-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) (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))) (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t)))
(org-babel-clojure-bind-session-to-repl-buffer session repl-buf)))) (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." "Evaluate the body in an external process."
(save-excursion (let ((cmd (format "%s -" (mapconcat #'identity
(let ((cmd (format "%s -" (mapconcat #'identity (org-babel-clojure-babel-clojure-cmd) " ")))) (org-babel-clojure-babel-clojure-cmd)
(case result-type " "))))
(output (case result-type
(with-temp-buffer (output (org-babel-eval cmd body))
(insert body) (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-")))
(org-babel-shell-command-on-region cmd (point-min) (point-max) 'current-buffer 'replace) (org-babel-eval cmd (format org-babel-clojure-wrapper-method
(buffer-string))) body tmp-file tmp-file))
(value (org-babel-clojure-table-or-string
(let* ((tmp-file (make-temp-file "org-babel-clojure-results-")) exit-code (org-babel-eval-read-file tmp-file)))))))
(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)))))))))
(defun org-babel-clojure-evaluate-session (buffer body &optional result-type) (defun org-babel-clojure-evaluate-session (buffer body &optional result-type)
"Evaluate the body in the context of a clojure session." "Evaluate the body in the context of a clojure session."
(require 'slime) (require 'swank-clojure)
(let ((raw nil) (let ((raw nil)
(results nil)) (results nil))
(save-window-excursion (save-window-excursion
(set-buffer buffer) (set-buffer buffer)
(setq raw (org-babel-clojure-slime-eval-sync body)) (setq raw (org-babel-clojure-slime-eval-sync body))
(setq results (reverse (mapcar #'org-babel-trim raw))) (setq results (reverse (mapcar #'org-babel-trim raw)))
(case result-type (cond
(output (mapconcat #'identity (reverse (cdr results)) "\n")) ((equal result-type 'output)
(value (org-babel-clojure-table-or-string (car results))))))) (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) (defun org-babel-clojure-evaluate (buffer body &optional result-type)
"Pass BODY to the Clojure process in BUFFER. If RESULT-TYPE equals "Pass BODY to the Clojure process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
(if session (if buffer
(org-babel-clojure-evaluate-session buffer body result-type) (org-babel-clojure-evaluate-session buffer body result-type)
(org-babel-clojure-evaluate-external-process 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) (defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with org-babel." "Execute a block of Clojure code with org-babel."
(require 'slime) (require 'swank-clojure)
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(body (org-babel-expand-body:clojure body params processed-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-reassemble-table
(org-babel-clojure-evaluate session body (nth 3 processed-params)) (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
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) (nth 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name
(nth 5 processed-params) (cdr (assoc :rownames params))))))
(provide 'ob-clojure) (provide 'ob-clojure)

5
lisp/babel/ob-comint.el → lisp/ob-comint.el
View File

@ -33,6 +33,7 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'comint) (require 'comint)
(eval-when-compile (require 'cl))
(defun org-babel-comint-buffer-livep (buffer) (defun org-babel-comint-buffer-livep (buffer)
"Check if BUFFER is a comint buffer with a live process." "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))) (remove-echo (cadr (cdr meta)))
(full-body (cadr (cdr (cdr meta))))) (full-body (cadr (cdr (cdr meta)))))
`(org-babel-comint-in-buffer ,buffer `(org-babel-comint-in-buffer ,buffer
(let ((string-buffer "") dangling-text) (let ((string-buffer "") dangling-text raw)
(flet ((my-filt (text) (flet ((my-filt (text)
(setq string-buffer (concat string-buffer text)))) (setq string-buffer (concat string-buffer text))))
;; setup filter ;; setup filter
@ -106,7 +107,7 @@ or user `keyboard-quit' during execution of body."
(if (and ,remove-echo ,full-body (if (and ,remove-echo ,full-body
(string-match (string-match
(replace-regexp-in-string (replace-regexp-in-string
"\n" "[\r\n]+" (regexp-quote ,full-body)) "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
string-buffer)) string-buffer))
(setq raw (substring string-buffer (match-end 0)))) (setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp))))) (split-string string-buffer comint-prompt-regexp)))))

0
lisp/babel/langs/ob-css.el → lisp/ob-css.el
View File

1
lisp/babel/langs/ob-ditaa.el → lisp/ob-ditaa.el
View File

@ -46,6 +46,7 @@
(defun org-babel-expand-body:ditaa (body params &optional processed-params) (defun org-babel-expand-body:ditaa (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." body) "Expand BODY according to PARAMS, return the expanded body." body)
(defvar org-ditaa-jar-path)
(defun org-babel-execute:ditaa (body params) (defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel. This function is "Execute a block of Ditaa code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."

0
lisp/babel/langs/ob-dot.el → lisp/ob-dot.el
View File

0
lisp/babel/langs/ob-emacs-lisp.el → lisp/ob-emacs-lisp.el
View File

256
lisp/ob-eval.el Normal file
View File

@ -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 <http://www.gnu.org/licenses/>.
;;; 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

0
lisp/babel/ob-exp.el → lisp/ob-exp.el
View File

24
lisp/babel/langs/ob-gnuplot.el → lisp/ob-gnuplot.el
View File

@ -40,7 +40,16 @@
;;; Code: ;;; Code:
(require 'ob) (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 (defvar org-babel-default-header-args:gnuplot
'((:results . "file") (:exports . "results") (:session . nil)) '((:results . "file") (:exports . "results") (:session . nil))
@ -124,10 +133,12 @@ code."
"Execute a block of Gnuplot code with org-babel. This function is "Execute a block of Gnuplot code with org-babel. This function is
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing Gnuplot source code block") (message "executing Gnuplot source code block")
(require 'gnuplot)
(let ((session (cdr (assoc :session params))) (let ((session (cdr (assoc :session params)))
(result-type (cdr (assoc :results params))) (result-type (cdr (assoc :results params)))
(out-file (cdr (assoc :file 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 (save-window-excursion
;; evaluate the code body with gnuplot ;; evaluate the code body with gnuplot
(if (string= session "none") (if (string= session "none")
@ -170,18 +181,23 @@ called by `org-babel-execute-src-block'."
(insert (org-babel-chomp body))) (insert (org-babel-chomp body)))
buffer))) buffer)))
(defvar gnuplot-buffer)
(defun org-babel-gnuplot-initiate-session (&optional session params) (defun org-babel-gnuplot-initiate-session (&optional session params)
"If there is not a current inferior-process-buffer in SESSION "If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session. The current then create one. Return the initialized session. The current
`gnuplot-mode' doesn't provide support for multiple sessions." `gnuplot-mode' doesn't provide support for multiple sessions."
(require 'gnuplot)
(unless (string= session "none") (unless (string= session "none")
(save-window-excursion (gnuplot-send-string-to-gnuplot "" "line") (save-window-excursion
gnuplot-buffer))) (gnuplot-send-string-to-gnuplot "" "line")
gnuplot-buffer)))
(defun org-babel-gnuplot-quote-timestamp-field (s) (defun org-babel-gnuplot-quote-timestamp-field (s)
"Convert field S from timestamp to Unix time and export to gnuplot." "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))) (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) (defun org-babel-gnuplot-quote-tsv-field (s)
"Quote field S for export to gnuplot." "Quote field S for export to gnuplot."
(unless (stringp s) (unless (stringp s)

28
lisp/babel/langs/ob-haskell.el → lisp/ob-haskell.el
View File

@ -41,8 +41,15 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'haskell-mode) (require 'ob-comint)
(require 'inf-haskell) (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")) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
@ -66,7 +73,7 @@
"Execute a block of Haskell code with org-babel." "Execute a block of Haskell code with org-babel."
(message "executing haskell source code block") (message "executing haskell source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (first processed-params)) (session (nth 0 processed-params))
(vars (nth 1 processed-params)) (vars (nth 1 processed-params))
(result-type (nth 3 processed-params)) (result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:haskell body params processed-params)) (full-body (org-babel-expand-body:haskell body params processed-params))
@ -82,9 +89,11 @@
(cdr (member org-babel-haskell-eoe (cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw))))))) (reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table (org-babel-reassemble-table
(case result-type (cond
(output (mapconcat #'identity (reverse (cdr results)) "\n")) ((equal result-type 'output)
(value (org-babel-haskell-table-or-string (car results)))) (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 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames 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) (defun org-babel-haskell-initiate-session (&optional session params)
"If there is not a current inferior-process-buffer in SESSION "If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session." then create one. Return the initialized session."
;; TODO: make it possible to have multiple sessions (require 'inf-haskell)
(or (get-buffer "*haskell*") (or (get-buffer "*haskell*")
(save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer))))
@ -114,13 +123,13 @@ then create one. Return the initialized session."
buffer))) buffer)))
(defun org-babel-prep-session:haskell (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." "Prepare SESSION according to the header arguments specified in PARAMS."
(save-window-excursion (save-window-excursion
(let ((pp (or processed-params (org-babel-process-params params))) (let ((pp (or processed-params (org-babel-process-params params)))
(buffer (org-babel-haskell-initiate-session session))) (buffer (org-babel-haskell-initiate-session session)))
(org-babel-comint-in-buffer buffer (org-babel-comint-in-buffer buffer
(mapcar (mapc
(lambda (pair) (lambda (pair)
(insert (format "let %s = %s" (insert (format "let %s = %s"
(car pair) (car pair)
@ -150,6 +159,7 @@ specifying a var of the same value."
(concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]")
(format "%S" var))) (format "%S" var)))
(defvar org-src-preserve-indentation)
(defun org-babel-haskell-export-to-lhs (&optional arg) (defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped "Export to a .lhs file with all haskell code blocks escaped
appropriately. When called with a prefix argument the resulting appropriately. When called with a prefix argument the resulting

6
lisp/babel/ob-keys.el → lisp/ob-keys.el
View File

@ -51,7 +51,11 @@ functions.")
(describe-bindings org-babel-key-prefix)) (describe-bindings org-babel-key-prefix))
(defvar org-babel-key-bindings (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) ("p" . org-babel-expand-src-block)
("g" . org-babel-goto-named-source-block) ("g" . org-babel-goto-named-source-block)
("\C-b" . org-babel-execute-buffer) ("\C-b" . org-babel-execute-buffer)

10
lisp/babel/langs/ob-latex.el → lisp/ob-latex.el
View File

@ -32,6 +32,7 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'org-latex)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) (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 (with-temp-file tex-file
(insert (org-splice-latex-header (insert (org-splice-latex-header
org-format-latex-header org-format-latex-header
(remove-if (delq
(lambda (el) (and (listp el) (string= "hyperref" (cadr el)))) nil
org-export-latex-default-packages-alist) (mapcar
(lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el)))
el))
org-export-latex-default-packages-alist))
org-export-latex-packages-alist org-export-latex-packages-alist
org-format-latex-header-extra) org-format-latex-header-extra)
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "") (if height (concat "\n" (format "\\pdfpageheight %s" height)) "")

0
lisp/babel/ob-lob.el → lisp/ob-lob.el
View File

37
lisp/babel/langs/ob-matlab.el → lisp/ob-matlab.el
View File

@ -36,43 +36,10 @@
;; http://matlab-emacs.sourceforge.net/ ;; http://matlab-emacs.sourceforge.net/
;;; Code: ;;; Code:
(require 'matlab) (require 'ob)
(require 'ob-octave) (require 'ob-octave)
(defvar org-babel-default-header-args:matlab '()) ;; see ob-octave for matlab implementation
(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))
(provide 'ob-matlab) (provide 'ob-matlab)

11
lisp/babel/langs/ob-ocaml.el → lisp/ob-ocaml.el
View File

@ -37,7 +37,11 @@
;;; Code: ;;; Code:
(require 'ob) (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")) (add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
@ -60,7 +64,8 @@
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(vars (nth 1 processed-params)) (vars (nth 1 processed-params))
(full-body (org-babel-expand-body:ocaml body params 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 (raw (org-babel-comint-with-output
(session org-babel-ocaml-eoe-output t full-body) (session org-babel-ocaml-eoe-output t full-body)
(insert (concat (org-babel-chomp 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 4 processed-params) (cdr (assoc :colnames params)))
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames 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) (defun org-babel-prep-session:ocaml (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."
(require 'tuareg)
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
(not (string= session "default")) (not (string= session "default"))
(stringp session)) (stringp session))

142
lisp/babel/langs/ob-octave.el → lisp/ob-octave.el
View File

@ -31,19 +31,29 @@
;;; Code: ;;; Code:
(require 'ob) (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-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" (defvar org-babel-octave-shell-command "octave -q"
"Shell command to use to run octave as an external process.") "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) (defun org-babel-expand-body:octave (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat (concat
;; prepend code to define all arguments passed to the code block
;; (may not be appropriate for all languages)
(mapconcat (mapconcat
(lambda (pair) (lambda (pair)
(format "%s=%s" (format "%s=%s"
@ -51,25 +61,60 @@
(org-babel-octave-var-to-octave (cdr pair)))) (org-babel-octave-var-to-octave (cdr pair))))
vars "\n") "\n" body "\n"))) 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) (defun org-babel-execute:octave (body params &optional matlabp)
"Execute a block of octave code with org-babel." "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)) (let* ((processed-params (org-babel-process-params params))
;; set the session if the session variable is non-nil (session
(session (funcall (intern (format "org-babel-%s-initiate-session" lang)) (funcall (intern (format "org-babel-%s-initiate-session"
(first processed-params) params)) (if matlabp "matlab" "octave")))
(nth 0 processed-params) params))
(vars (nth 1 processed-params)) (vars (nth 1 processed-params))
(result-params (nth 2 processed-params)) (result-params (nth 2 processed-params))
(result-type (nth 3 processed-params)) (result-type (nth 3 processed-params))
(out-file (cdr (assoc :file params))) (out-file (cdr (assoc :file params)))
(augmented-body (org-babel-expand-body:octave body params processed-params)) (augmented-body
(result (org-babel-octave-evaluate session augmented-body result-type matlabp))) (org-babel-expand-body:octave body params processed-params))
(result (org-babel-octave-evaluate
session augmented-body result-type matlabp)))
(or out-file (or out-file
(org-babel-reassemble-table (org-babel-reassemble-table
result result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) (org-babel-pick-name
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) (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) (defun org-babel-octave-var-to-octave (var)
"Convert an emacs-lisp variable into an octave variable. "Convert an emacs-lisp variable into an octave variable.
Converts an emacs-lisp variable into a string of octave code 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)) (org-babel-comint-wait-for-output session)) var-lines))
session)) 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) (defun org-babel-octave-initiate-session (&optional session params matlabp)
"Create an octave inferior process buffer. If there is not a "Create an octave inferior process buffer. If there is not a
current inferior-process-buffer in SESSION then create. Return current inferior-process-buffer in SESSION then create. Return
the initialized session." the initialized session."
(require 'octave-inf)
(unless (string= session "none") (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 (if (org-babel-comint-buffer-livep session) session
(save-window-excursion (save-window-excursion
(if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell))
(run-octave)) (run-octave))
(rename-buffer (if (bufferp session) (buffer-name session) (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 (defun org-babel-octave-evaluate
"%s (session body result-type lang &optional matlabp)
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)
"Pass BODY to the octave process in SESSION. If RESULT-TYPE "Pass BODY to the octave process in SESSION. If RESULT-TYPE
equals 'output then return the outputs of the statements in BODY, equals 'output then return the outputs of the statements in BODY,
if RESULT-TYPE equals 'value then return the value of the last if RESULT-TYPE equals 'value then return the value of the last
statement in BODY, as elisp." statement in BODY, as elisp."
(if session (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))) (org-babel-octave-evaluate-external-process body result-type matlabp)))
(defun 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." "Evaluate BODY in an external octave process."
(let ((cmd (if matlabp org-babel-matlab-shell-command org-babel-octave-shell-command))) (let ((cmd (if matlabp
(save-excursion org-babel-matlab-shell-command
(case result-type org-babel-octave-shell-command)))
(output (case result-type
(with-temp-buffer (output (org-babel-eval cmd body))
(insert body) (value (let ((tmp-file (make-temp-file "org-babel-results-")))
(org-babel-shell-command-on-region (point-min) (point-max) cmd 'current-buffer 'replace) (org-babel-eval
(buffer-string))) cmd
(value (format org-babel-octave-wrapper-method body tmp-file tmp-file))
(let* ((tmp-file (make-temp-file "org-babel-results-")) exit-code (org-babel-eval-read-file tmp-file))))))
(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))))))))
(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." "Evaluate BODY in SESSION."
(let* ((tmp-file (make-temp-file "org-babel-results-")) (let* ((tmp-file (make-temp-file "org-babel-results-"))
(wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) (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") body tmp-file tmp-file wait-file) "\n")
(mapconcat (mapconcat
#'org-babel-chomp #'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"))))) org-babel-octave-eoe-indicator) "\n")))))
(raw (if (and matlabp org-babel-matlab-with-emacs-link) (raw (if (and matlabp org-babel-matlab-with-emacs-link)
(save-window-excursion (save-window-excursion
@ -187,16 +226,19 @@ statement in BODY, as elisp."
(insert full-body) (comint-send-input nil t)))) results) (insert full-body) (comint-send-input nil t)))) results)
(case result-type (case result-type
(value (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 (output
(progn (progn
(setq results (setq results
(if matlabp (if matlabp
(cdr (reverse (delq "" (mapcar #'org-babel-octave-read-string (cdr (reverse (delq "" (mapcar
(mapcar #'org-babel-trim raw))))) #'org-babel-octave-read-string
(mapcar #'org-babel-trim raw)))))
(cdr (member org-babel-octave-eoe-output (cdr (member org-babel-octave-eoe-output
(reverse (mapcar #'org-babel-octave-read-string (reverse (mapcar
(mapcar #'org-babel-trim raw))))))) #'org-babel-octave-read-string
(mapcar #'org-babel-trim raw)))))))
(mapconcat #'identity (reverse results) "\n")))))) (mapconcat #'identity (reverse results) "\n"))))))
(defun org-babel-octave-import-elisp-from-file (file-name) (defun org-babel-octave-import-elisp-from-file (file-name)

50
lisp/babel/langs/ob-perl.el → lisp/ob-perl.el
View File

@ -28,11 +28,16 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-eval)
(eval-when-compile (require 'cl))
(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
(defvar org-babel-default-header-args:perl '()) (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) (defun org-babel-expand-body:perl (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
@ -49,17 +54,19 @@
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing Perl source code block") (message "executing Perl source code block")
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (first processed-params)) (session (nth 0 processed-params))
(vars (nth 1 processed-params)) (vars (nth 1 processed-params))
(result-params (nth 2 processed-params)) (result-params (nth 2 processed-params))
(result-type (nth 3 processed-params)) (result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:perl (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))) (session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table (org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type) (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
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) (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) (defun org-babel-prep-session:perl (session params)
"Prepare SESSION according to the header arguments specified in 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 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
(if (not session) (when session (error "Sessions are not supported for Perl."))
;; external process evaluation (case result-type
(save-excursion (output (org-babel-eval org-babel-perl-command body))
(case result-type (value (let ((tmp-file (make-temp-file "org-babel-perl-results-")))
(output (org-babel-eval
(with-temp-buffer org-babel-perl-command
(insert body) (format org-babel-perl-wrapper-method body tmp-file))
;; (message "buffer=%s" (buffer-string)) ;; debugging (org-babel-eval-read-file tmp-file)))))
(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.")))
(provide 'ob-perl) (provide 'ob-perl)

169
lisp/babel/langs/ob-python.el → lisp/ob-python.el
View File

@ -28,14 +28,21 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-tangle) (require 'ob-ref)
(require 'ob-comint) (require 'ob-comint)
(require 'ob-eval)
(require (if (featurep 'xemacs) 'python-mode 'python)) (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")) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
(defvar org-babel-default-header-args:python '()) (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) (defun org-babel-expand-body:python (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(concat (concat
@ -56,13 +63,16 @@ called by `org-babel-execute-src-block'."
(result-params (nth 2 processed-params)) (result-params (nth 2 processed-params))
(result-type (nth 3 processed-params)) (result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:python (full-body (org-babel-expand-body:python
body params processed-params)) ;; then the source block body body params processed-params))
(result (org-babel-python-evaluate session full-body result-type))) (result (org-babel-python-evaluate
session full-body result-type result-params)))
(or (cdr (assoc :file params)) (or (cdr (assoc :file params))
(org-babel-reassemble-table (org-babel-reassemble-table
result result
(org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) (org-babel-pick-name (nth 4 processed-params)
(org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames 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) (defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments specified in 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-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end ;; `py-which-bufname' with '*'s at the beginning and end
(let* ((bufname (if python-buffer (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)))) (concat "Python-" (symbol-name session))))
(py-which-bufname bufname)) ; avoid making a mess with buffer-local (py-which-bufname bufname))
(py-shell) (py-shell)
(setq python-buffer (concat "*" bufname "*")))) (setq python-buffer (concat "*" bufname "*"))))
(t (t
(error "No function available for running an inferior python."))) (error "No function available for running an inferior python.")))
(setq org-babel-python-buffers
(setq org-babel-python-buffers (cons (cons session python-buffer) (cons (cons session python-buffer)
(assq-delete-all session org-babel-python-buffers))) (assq-delete-all session org-babel-python-buffers)))
session))) session)))
(defun org-babel-python-initiate-session (&optional session params) (defun org-babel-python-initiate-session (&optional session params)
"Create a session named SESSION according to PARAMS." "Create a session named SESSION according to PARAMS."
(unless (string= session "none") (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'" (defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
"Used to indicate that evaluation is has completed.") "Used to indicate that evaluation is has completed.")
(defvar org-babel-python-wrapper-method (defvar org-babel-python-wrapper-method
@ -177,77 +181,74 @@ def main():
open('%s', 'w').write( pprint.pformat(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 "Pass BODY to the Python process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
(if (not session) (if (not buffer)
;; external process evaluation ;; external process evaluation
(save-excursion (case result-type
(case result-type (output (org-babel-eval org-babel-python-command body))
(output (value (let ((tmp-file (make-temp-file "org-babel-python-results-")))
(with-temp-buffer (org-babel-eval org-babel-python-command
(insert body) (format
;; (message "buffer=%s" (buffer-string)) ;; debugging (if (member "pp" result-params)
(org-babel-shell-command-on-region (point-min) (point-max) "python" 'current-buffer 'replace) org-babel-python-pp-wrapper-method
(buffer-string))) org-babel-python-wrapper-method)
(value (mapconcat
(let* ((tmp-file (make-temp-file "org-babel-python-results-")) exit-code (lambda (line) (format "\t%s" line))
(stderr (split-string
(with-temp-buffer (org-remove-indentation
(insert (org-babel-trim body))
(format "[\r\n]") "\n")
(if (member "pp" result-params) tmp-file))
org-babel-python-pp-wrapper-method ((lambda (raw)
org-babel-python-wrapper-method) (if (or (member "code" result-params)
(mapconcat (member "pp" result-params))
(lambda (line) (format "\t%s" line)) raw
(split-string (org-babel-python-table-or-string raw)))
(org-remove-indentation (org-babel-trim body)) "[\r\n]") "\n") (org-babel-eval-read-file tmp-file)))))
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)))))))
;; comint session evaluation ;; comint session evaluation
(org-babel-comint-in-buffer buffer (flet ((dump-last-value (tmp-file pp)
(let* ((raw (org-babel-comint-with-output (mapc
(buffer org-babel-python-eoe-indicator t full-body) (lambda (statement) (insert statement) (comint-send-input))
;; for some reason python is fussy, and likes enters after every input (if pp
(let ((comint-process-echoes nil)) (list
(mapc (lambda (statement) (insert statement) (comint-send-input)) "import pp"
(split-string (org-babel-trim body) "[\r\n]+")) (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file))
(comint-send-input) (comint-send-input) (list (format "open('%s', 'w').write(str(_))" tmp-file)))))
(if (member "pp" result-params) (input-body (body)
(mapc (lambda (statement) (insert statement) (comint-send-input)) (mapc (lambda (statement) (insert statement) (comint-send-input))
org-babel-python-pp-last-value-eval) (split-string (org-babel-trim body) "[\r\n]+"))
(insert org-babel-python-last-value-eval)) (comint-send-input) (comint-send-input)))
(comint-send-input) (comint-send-input) (case result-type
(insert org-babel-python-eoe-indicator) (output
(comint-send-input)))) (mapconcat
(raw (apply #'append ; split further #'org-babel-trim
(mapcar #'(lambda (r) (butlast
(split-string r "[\r\n]+")) (org-babel-comint-with-output
raw))) (buffer org-babel-python-eoe-indicator t body)
(results (delete org-babel-python-eoe-indicator (let ((comint-process-echoes nil))
(cdr (member org-babel-python-eoe-indicator (input-body body)
(mapcar #'org-babel-trim raw)))))) (insert org-babel-python-eoe-indicator)
(unless (or (member "code" result-params) (member "pp" result-params)) (comint-send-input))) 2) "\n"))
(setq results (mapcar #'org-babel-python-read-string results))) (value
(case result-type ((lambda (results)
(output (org-babel-trim (mapconcat #'identity (reverse (cdr results)) "\n"))) (if (or (member "code" result-params) (member "pp" result-params))
(value results
(if (or (member "code" result-params) (member "pp" result-params)) (org-babel-python-table-or-string results)))
(car results) (let ((tmp-file (make-temp-file "org-babel-python-results-")))
(org-babel-python-table-or-string (org-babel-trim (car 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) (defun org-babel-python-read-string (string)
"Strip 's from around python string" "Strip 's from around python string"

0
lisp/babel/ob-ref.el → lisp/ob-ref.el
View File

138
lisp/babel/langs/ob-ruby.el → lisp/ob-ruby.el
View File

@ -38,14 +38,23 @@
;;; Code: ;;; Code:
(require 'ob) (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")) (add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb"))
(defvar org-babel-default-header-args:ruby '()) (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) (defun org-babel-expand-body:ruby (body params &optional processed-params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(require 'inf-ruby)
(let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))))
(concat (concat
(mapconcat ;; define any variables (mapconcat ;; define any variables
@ -65,7 +74,8 @@ called by `org-babel-execute-src-block'."
(result-type (nth 3 processed-params)) (result-type (nth 3 processed-params))
(full-body (org-babel-expand-body:ruby (full-body (org-babel-expand-body:ruby
body params processed-params)) 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)) (or (cdr (assoc :file params))
(org-babel-reassemble-table (org-babel-reassemble-table
result result
@ -114,7 +124,6 @@ specifying a var of the same value."
(defun org-babel-ruby-table-or-string (results) (defun org-babel-ruby-table-or-string (results)
"If RESULTS look like a table, then convert them into an "If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string." Emacs-lisp table, otherwise return the results as a string."
(message "converting %S" results)
(org-babel-read (org-babel-read
(if (and (stringp results) (string-match "^\\[.+\\]$" results)) (if (and (stringp results) (string-match "^\\[.+\\]$" results))
(org-babel-read (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 "\\]" ")" (replace-regexp-in-string
", " " " (replace-regexp-in-string ", " " " (replace-regexp-in-string
"'" "\"" results)))))) "'" "\"" results))))))
results))) results)))
(defun org-babel-ruby-initiate-session (&optional session params) (defun org-babel-ruby-initiate-session (&optional session params)
"If there is not a current inferior-process-buffer in SESSION "If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session." then create one. Return the initialized session."
(require 'inf-ruby)
(unless (string= session "none") (unless (string= session "none")
(let ((session-buffer (save-window-excursion (let ((session-buffer (save-window-excursion
(run-ruby nil session) (current-buffer)))) (run-ruby nil session) (current-buffer))))
@ -137,12 +147,12 @@ then create one. Return the initialized session."
(sit-for .5) (sit-for .5)
(org-babel-ruby-initiate-session session))))) (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" (defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe"
"Used to indicate that evaluation is has completed.") "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 (defvar org-babel-ruby-wrapper-method
" "
def main() def main()
@ -164,66 +174,70 @@ File.open('%s', 'w') do |f|
end 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 "Pass BODY to the Ruby process in BUFFER. If RESULT-TYPE equals
'output then return a list of the outputs of the statements in 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
(if (not session) (if (not buffer)
;; external process evaluation ;; 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 (case result-type
(output (mapconcat #'identity (reverse (cdr results)) "\n")) (output (org-babel-eval org-babel-ruby-command body))
(value (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-")))
(if (or (member "code" result-params) (member "pp" result-params)) (org-babel-eval org-babel-ruby-command
(car results) (format (if (member "pp" result-params)
(org-babel-ruby-table-or-string (car results)))))))) 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) (defun org-babel-ruby-read-string (string)
"Strip \\\"s from around a ruby string." "Strip \\\"s from around a ruby string."

1
lisp/babel/langs/ob-sass.el → lisp/ob-sass.el
View File

@ -40,7 +40,6 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'sass-mode)
(defvar org-babel-default-header-args:sass '()) (defvar org-babel-default-header-args:sass '())

29
lisp/babel/langs/ob-screen.el → lisp/ob-screen.el
View File

@ -35,6 +35,7 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-ref)
(defvar org-babel-screen-location "screen" (defvar org-babel-screen-location "screen"
"The command location for 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...") (message "Sending source code block to interactive terminal session...")
(save-window-excursion (save-window-excursion
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (first processed-params)) (session (nth 0 processed-params))
(socket (org-babel-screen-session-socketname session))) (socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params)) (unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string (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) (defun org-babel-prep-session:screen (session params)
"Prepare SESSION according to the header arguments specified in PARAMS." "Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((processed-params (org-babel-process-params params)) (let* ((processed-params (org-babel-process-params params))
(session (first processed-params)) (session (nth 0 processed-params))
(vars (nth 1 processed-params)) (vars (nth 1 processed-params))
(socket (org-babel-screen-session-socketname session)) (socket (org-babel-screen-session-socketname session))
(vars (org-babel-ref-variables params)) (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) (defun org-babel-screen-session-socketname (session)
"Check if SESSION exist by parsing output of \"screen -ls\"." "Check if SESSION exist by parsing output of \"screen -ls\"."
(let* ((screen-ls (shell-command-to-string "screen -ls")) (let* ((screen-ls (shell-command-to-string "screen -ls"))
(sockets (remove-if-not (sockets (delq
'(lambda (x) nil
(string-match (rx (or "(Attached)" "(Detached)")) x)) (mapcar
(split-string screen-ls "\n"))) (lambda (x)
(match-socket (find-if (when (string-match (rx (or "(Attached)" "(Detached)")) x)
'(lambda (x) x))
(string-match (concat "org-babel-session-" session) x)) (split-string screen-ls "\n"))))
sockets))) (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))))) (when match-socket (car (split-string match-socket)))))
(defun org-babel-screen-session-write-temp-file (session body) (defun org-babel-screen-session-write-temp-file (session body)

75
lisp/babel/langs/ob-sh.el → lisp/ob-sh.el
View File

@ -28,9 +28,10 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(require 'ob-comint)
(require 'ob-eval)
(require 'shell) (require 'shell)
(eval-when-compile (eval-when-compile (require 'cl))
(require 'cl))
(declare-function org-babel-ref-variables "ob-ref" (params)) (declare-function org-babel-ref-variables "ob-ref" (params))
(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) (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 'output then return a list of the outputs of the statements in
BODY, if RESULT-TYPE equals 'value then return the value of the BODY, if RESULT-TYPE equals 'value then return the value of the
last statement in BODY." last statement in BODY."
(if (not session) ((lambda (results)
;; external process evaluation (if (or (member "scalar" result-params)
(save-window-excursion (member "output" result-params))
(with-temp-buffer (buffer-string)
(insert body) (let ((tmp-file (make-temp-file "org-babel-sh")))
;; (message "buffer=%s" (buffer-string)) ;; debugging (with-temp-file tmp-file (insert results))
(org-babel-shell-command-on-region (point-min) (point-max) org-babel-sh-command 'current-buffer 'replace) (org-babel-import-elisp-from-file tmp-file))))
(cond (if (not session)
((member "output" result-params) (buffer-string)) (org-babel-eval org-babel-sh-command (org-babel-trim body))
;; TODO: figure out how to return non-output values from shell scripts (let ((tmp-file (make-temp-file "org-babel-sh")))
(t ;; if not "output" then treat as "value" (mapconcat
(if (member "scalar" result-params) #'org-babel-sh-strip-weird-long-prompt
(buffer-string) (mapcar
(let ((tmp-file (make-temp-file "org-babel-sh")) #'org-babel-trim
(results (buffer-string))) (butlast
(with-temp-file tmp-file (insert results)) (org-babel-comint-with-output
(org-babel-import-elisp-from-file tmp-file))))))) (session org-babel-sh-eoe-output t body)
;; comint session evaluation (mapc
(flet ((strip-empty (lst) (lambda (line)
(delq nil (mapcar (lambda (el) (unless (= (length el) 0) el)) lst)))) (insert line) (comint-send-input nil t) (sleep-for 0.25))
(let ((tmp-file (make-temp-file "org-babel-sh")) (append
(results (split-string (org-babel-trim body) "\n")
(cdr (member (list org-babel-sh-eoe-indicator))))
org-babel-sh-eoe-output 2)) "\n")))))
(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))))
"")))))
(defun org-babel-sh-strip-weird-long-prompt (string) (defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output." "Remove prompt cruft from a string of shell output."

6
lisp/babel/langs/ob-sql.el → lisp/ob-sql.el
View File

@ -44,6 +44,9 @@
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
(eval-when-compile (require 'cl))
(declare-function org-table-import "org-table" (file arg))
(defvar org-babel-default-header-args:sql '()) (defvar org-babel-default-header-args:sql '())
@ -55,6 +58,7 @@
called by `org-babel-execute-src-block'." called by `org-babel-execute-src-block'."
(message "executing Sql source code block") (message "executing Sql source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(processed-params (org-babel-process-params params))
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(engine (cdr (assoc :engine params))) (engine (cdr (assoc :engine params)))
(in-file (make-temp-file "org-babel-sql-in")) (in-file (make-temp-file "org-babel-sql-in"))
@ -63,7 +67,7 @@ called by `org-babel-execute-src-block'."
(command (case (intern engine) (command (case (intern engine)
('mysql (format "mysql %s -e \"source %s\" > %s" ('mysql (format "mysql %s -e \"source %s\" > %s"
(or cmdline "") in-file out-file)) (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 (with-temp-file in-file
(insert (org-babel-expand-body:sql body params))) (insert (org-babel-expand-body:sql body params)))
(message command) (message command)

56
lisp/babel/langs/ob-sqlite.el → lisp/ob-sqlite.el
View File

@ -28,9 +28,18 @@
;;; Code: ;;; Code:
(require 'ob) (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-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 (defun org-babel-expand-body:sqlite
(body params &optional processed-params) body) (body params &optional processed-params) body)
@ -42,16 +51,44 @@ called by `org-babel-execute-src-block'."
(message "executing Sqlite source code block") (message "executing Sqlite source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(vars (org-babel-ref-variables 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 (with-temp-buffer
(insert (insert
(shell-command-to-string (shell-command-to-string
(format "%s %s -csv %s %S" (org-fill-template
org-babel-sqlite3-command "%cmd %header %separator %nullvalue %others %csv %db %body"
(if headers-p "-header" "") (list
(cdr (assoc :db params)) (cons "cmd" org-babel-sqlite3-command)
(org-babel-sqlite-expand-vars body vars)))) (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) (if (or (member "scalar" result-params)
(member "html" result-params)
(member "code" result-params)) (member "code" result-params))
(buffer-string) (buffer-string)
(org-table-convert-region (point-min) (point-max)) (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 RESULT looks like a trivial table, then unwrap it."
(if (and (equal 1 (length result)) (if (and (equal 1 (length result))
(equal 1 (length (car result)))) (equal 1 (length (car result))))
(caar result) (org-babel-read (caar result))
result)) (mapcar (lambda (row)
(if (equal 'hline row)
'hline
(mapcar #'org-babel-read row))) result)))
(defun org-babel-sqlite-offset-colnames (table headers-p) (defun org-babel-sqlite-offset-colnames (table headers-p)
"If HEADERS-P is non-nil then offset the first row as column names." "If HEADERS-P is non-nil then offset the first row as column names."

0
lisp/babel/ob-table.el → lisp/ob-table.el
View File

10
lisp/babel/ob-tangle.el → lisp/ob-tangle.el
View File

@ -34,13 +34,6 @@
(declare-function org-link-escape "org" (text &optional table)) (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 (defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el")) '(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions. "Alist mapping languages to their file extensions.
@ -247,8 +240,7 @@ form
(body (nth 3 spec)) (body (nth 3 spec))
(commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes")))
(flet ((insert-comment (text) (flet ((insert-comment (text)
(when (and commentable (when commentable
org-babel-tangle-w-comments)
(insert "\n") (insert "\n")
(comment-region (point) (comment-region (point)
(progn (insert text) (point))) (progn (insert text) (point)))

256
lisp/babel/ob.el → lisp/ob.el
View File

@ -61,6 +61,34 @@
(declare-function org-babel-ref-variables "ob-ref" (params)) (declare-function org-babel-ref-variables "ob-ref" (params))
(declare-function org-babel-ref-resolve-reference "ob-ref" (ref &optional 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 (defvar org-babel-source-name-regexp
"^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*"
"Regular expression used to match a source name line.") "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) (org-babel-parse-inline-src-block-match)
nil)))) 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 ;;;###autoload
(defun org-babel-execute-src-block-maybe () (defun org-babel-execute-src-block-maybe ()
"Detect if this is context for a org-babel src-block and if so "Detect if this is context for a org-babel src-block and if so
then run `org-babel-execute-src-block'." then run `org-babel-execute-src-block'."
(interactive) (interactive)
(let ((info (org-babel-get-src-block-info))) (if (not org-babel-no-eval-on-ctrl-c-ctrl-c)
(if info (let ((info (org-babel-get-src-block-info)))
(progn (org-babel-execute-src-block current-prefix-arg info) t) nil))) (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) (add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
;;;###autoload ;;;###autoload
@ -241,6 +288,10 @@ the header arguments specified at the front of the source code
block." block."
(interactive) (interactive)
(let* ((info (or info (org-babel-get-src-block-info))) (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)) (lang (nth 0 info))
(params (setf (nth 2 info) (params (setf (nth 2 info)
(sort (org-babel-merge-params (nth 2 info) params) (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))))) (listp (cdr (car result)))))
result (list result)) result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n")) '(: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) ((member "file" result-params)
(insert result)) (insert result))
((member "html" result-params) ((member "html" result-params)
@ -1298,16 +1349,6 @@ block but are passed literally to the \"example-block\"."
(nb-add (buffer-substring index (point-max))))) (nb-add (buffer-substring index (point-max)))))
new-body)) 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) (defun org-babel-clean-text-properties (text)
"Strip all properties from text return." "Strip all properties from text return."
(when text (when text
@ -1420,191 +1461,6 @@ the remote connection."
(concat "/" user (when user "@") host ":" file)) (concat "/" user (when user "@") host ":" file))
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) (provide 'ob)
;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 ;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1

65
lisp/org.el
View File

@ -119,7 +119,62 @@
(require 'ob-tangle) (require 'ob-tangle)
(require 'ob-comint) (require 'ob-comint)
(require 'ob-keys) (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 ;;;; Customization variables
(defcustom org-clone-delete-id nil (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 - If the cursor is on a numbered item in a plain list, renumber the
ordered list. 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") (interactive "P")
(let ((org-enable-table-editor t)) (let ((org-enable-table-editor t))
(cond (cond