;;; ob-C.el --- org-babel functions for C and similar languages
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defvar org-babel-C-compiler "gcc"
"Command used to compile a C source code file into an
- executable.")
+executable.")
(defvar org-babel-C++-compiler "g++"
"Command used to compile a C++ source code file into an
- executable.")
+executable.")
(defvar org-babel-c-variant nil
"Internal variable used to hold which type of C (e.g. C or C++)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
- "Execute BODY according to PARAMS. This function calls
-`org-babel-execute:C++'."
+ "Execute BODY according to PARAMS.
+This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-execute:C++ (body params)
- "Execute a block of C++ code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C++ code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
(defun org-babel-execute:C (body params)
- "Execute a block of C code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params)
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) ""))))
- ((lambda (results)
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (let ((results
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ ))
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
- "Wrap body in a \"main\" function call if none exists."
+ "Wrap BODY in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
- (format "int main() {\n%s\nreturn(0);\n}\n" body)))
+ (format "int main() {\n%s\nreturn 0;\n}\n" body)))
(defun org-babel-prep-session:C (session params)
"This function does nothing as C is a compiled language with no
;; helper functions
+(defun org-babel-C-format-val (type val)
+ "Handle the FORMAT part of TYPE with the data from VAL."
+ (let ((format-data (cadr type)))
+ (if (stringp format-data)
+ (cons "" (format format-data val))
+ (funcall format-data val))))
+
+(defun org-babel-C-val-to-C-type (val)
+ "Determine the type of VAL.
+Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
+FORMAT can be either a format string or a function which is called with VAL."
+ (cond
+ ((integerp val) '("int" "%d"))
+ ((floatp val) '("double" "%f"))
+ ((or (listp val) (vectorp val))
+ (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
+ (list (car type)
+ (lambda (val)
+ (cons
+ (format "[%d]%s"
+ (length val)
+ (car (org-babel-C-format-val type (elt val 0))))
+ (concat "{ "
+ (mapconcat (lambda (v)
+ (cdr (org-babel-C-format-val type v)))
+ val
+ ", ")
+ " }"))))))
+ (t ;; treat unknown types as string
+ '("char" (lambda (val)
+ (let ((s (format "%s" val))) ;; convert to string for unknown types
+ (cons (format "[%d]" (1+ (length s)))
+ (concat "\"" s "\""))))))))
+
+(defun org-babel-C-val-to-C-list-type (val)
+ "Determine the C array type of a VAL."
+ (let (type)
+ (mapc
+ #'(lambda (i)
+ (let* ((tmp-type (org-babel-C-val-to-C-type i))
+ (type-name (car type))
+ (tmp-type-name (car tmp-type)))
+ (when (and type (not (string= type-name tmp-type-name)))
+ (if (and (member type-name '("int" "double" "int32_t"))
+ (member tmp-type-name '("int" "double" "int32_t")))
+ (setq tmp-type '("double" "" "%f"))
+ (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
+ type-name
+ tmp-type-name)))
+ (setq type tmp-type)))
+ val)
+ type))
+
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
- (cond
- ((integerp val)
- (format "int %S = %S;" var val))
- ((floatp val)
- (format "double %S = %S;" var val))
- ((or (integerp val))
- (format "char %S = '%S';" var val))
- ((stringp val)
- (format "char %S[%d] = \"%s\";"
- var (+ 1 (length val)) val))
- (t
- (format "u32 %S = %S;" var val)))))
-
+ (let* ((type-data (org-babel-C-val-to-C-type val))
+ (type (car type-data))
+ (formated (org-babel-C-format-val type-data val))
+ (suffix (car formated))
+ (data (cdr formated)))
+ (format "%s %s%s = %s;"
+ type
+ var
+ suffix
+ data))))
(provide 'ob-C)
-
-
;;; ob-C.el ends here
;;; ob-R.el --- org-babel functions for R code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
(or graphics-file (org-babel-R-graphical-output-file params))))
(mapconcat
#'identity
- ((lambda (inside)
- (if graphics-file
- (append
- (list (org-babel-R-construct-graphics-device-call
- graphics-file params))
- inside
- (list "dev.off()"))
- inside))
- (append (org-babel-variable-assignments:R params)
- (list body))) "\n")))
+ (let ((inside
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))))
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "dev.off()"))
+ inside))
+ "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
+(defvar org-babel-R-graphics-devices
+ '((:bmp "bmp" "filename")
+ (:jpg "jpeg" "filename")
+ (:jpeg "jpeg" "filename")
+ (:tikz "tikz" "file")
+ (:tiff "tiff" "filename")
+ (:png "png" "filename")
+ (:svg "svg" "file")
+ (:pdf "pdf" "file")
+ (:ps "postscript" "file")
+ (:postscript "postscript" "file"))
+ "An alist mapping graphics file types to R functions.
+
+Each member of this list is a list with three members:
+1. the file extension of the graphics file, as an elisp :keyword
+2. the R graphics device function to call to generate such a file
+3. the name of the argument to this function which specifies the
+ file to write to (typically \"file\" or \"filename\")")
+
(defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device."
- (let ((devices
- '((:bmp . "bmp")
- (:jpg . "jpeg")
- (:jpeg . "jpeg")
- (:tikz . "tikz")
- (:tiff . "tiff")
- (:png . "png")
- (:svg . "svg")
- (:pdf . "pdf")
- (:ps . "postscript")
- (:postscript . "postscript")))
- (allowed-args '(:width :height :bg :units :pointsize
- :antialias :quality :compression :res
- :type :family :title :fonts :version
- :paper :encoding :pagecentre :colormodel
- :useDingbats :horizontal))
- (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
- (match-string 1 out-file)))
- (extra-args (cdr (assq :R-dev-args params))) filearg args)
- (setq device (or (and device (cdr (assq (intern (concat ":" device))
- devices))) "png"))
- (setq filearg
- (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename"))
+ (let* ((allowed-args '(:width :height :bg :units :pointsize
+ :antialias :quality :compression :res
+ :type :family :title :fonts :version
+ :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
+ (match-string 1 out-file)))
+ (device-info (or (assq (intern (concat ":" device))
+ org-babel-R-graphics-devices)
+ (assq :png org-babel-R-graphics-devices)))
+ (extra-args (cdr (assq :R-dev-args params))) filearg args)
+ (setq device (nth 1 device-info))
+ (setq filearg (nth 2 device-info))
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
+(defvar ess-eval-visibly-p)
+
(defun org-babel-R-evaluate-session
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; ob-awk.el --- org-babel functions for awk evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(cmd-line (cdr (assoc :cmd-line params)))
(in-file (cdr (assoc :in-file params)))
(full-body (org-babel-expand-body:awk body params))
- (code-file ((lambda (file) (with-temp-file file (insert full-body)) file)
- (org-babel-temp-file "awk-")))
- (stdin ((lambda (stdin)
+ (code-file (let ((file (org-babel-temp-file "awk-")))
+ (with-temp-file file (insert full-body)) file))
+ (stdin (let ((stdin (cdr (assoc :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
- tmp)))
- (cdr (assoc :stdin params))))
+ tmp))))
(cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
"-f" code-file
cmd-line
in-file))
" ")))
(org-babel-reassemble-table
- ((lambda (results)
- (when results
- (org-babel-result-cond result-params
- results
- (let ((tmp (org-babel-temp-file "awk-results-")))
- (with-temp-file tmp (insert results))
- (org-babel-import-elisp-from-file tmp)))))
- (cond
- (stdin (with-temp-buffer
- (call-process-shell-command cmd stdin (current-buffer))
- (buffer-string)))
- (t (org-babel-eval cmd ""))))
+ (let ((results
+ (cond
+ (stdin (with-temp-buffer
+ (call-process-shell-command cmd stdin (current-buffer))
+ (buffer-string)))
+ (t (org-babel-eval cmd "")))))
+ (when results
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp (org-babel-temp-file "awk-results-")))
+ (with-temp-file tmp (insert results))
+ (org-babel-import-elisp-from-file tmp)))))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
;;; ob-calc.el --- org-babel functions for calc code evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defun org-babel-expand-body:calc (body params)
"Expand BODY according to PARAMS, return the expanded body." body)
+(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc
+
(defun org-babel-execute:calc (body params)
"Execute a block of calc code with Babel."
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (var-syms (mapcar #'car vars))
- (var-names (mapcar #'symbol-name var-syms)))
+ (org--var-syms (mapcar #'car vars))
+ (var-names (mapcar #'symbol-name org--var-syms)))
(mapc
(lambda (pair)
(calc-push-list (list (cdr pair)))
;; complex expression
(t
(calc-push-list
- (list ((lambda (res)
- (cond
- ((numberp res) res)
- ((math-read-number res) (math-read-number res))
- ((listp res) (error "Calc error \"%s\" on input \"%s\""
- (cadr res) line))
- (t (replace-regexp-in-string
- "'" ""
- (calc-eval
- (math-evaluate-expr
- ;; resolve user variables, calc built in
- ;; variables are handled automatically
- ;; upstream by calc
- (mapcar #'org-babel-calc-maybe-resolve-var
- ;; parse line into calc objects
- (car (math-read-exprs line)))))))))
- (calc-eval line))))))))
+ (list (let ((res (calc-eval line)))
+ (cond
+ ((numberp res) res)
+ ((math-read-number res) (math-read-number res))
+ ((listp res) (error "Calc error \"%s\" on input \"%s\""
+ (cadr res) line))
+ (t (replace-regexp-in-string
+ "'" ""
+ (calc-eval
+ (math-evaluate-expr
+ ;; resolve user variables, calc built in
+ ;; variables are handled automatically
+ ;; upstream by calc
+ (mapcar #'org-babel-calc-maybe-resolve-var
+ ;; parse line into calc objects
+ (car (math-read-exprs line)))))))))
+ ))))))
(mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
(with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1)))))
-(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
- (if (and (equal 'var (car el)) (member (cadr el) var-syms))
+ (if (and (equal 'var (car el)) (member (cadr el) org--var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
;;; ob-clojure.el --- org-babel functions for clojure evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Joel Boehland
;; Eric Schulte
;;; Commentary:
-;;; support for evaluating clojure code, relies on slime for all eval
+;; Support for evaluating clojure code, relies on slime for all eval.
;;; Requirements:
-;;; - clojure (at least 1.2.0)
-;;; - clojure-mode
-;;; - slime
+;; - clojure (at least 1.2.0)
+;; - clojure-mode
+;; - slime
-;;; By far, the best way to install these components is by following
-;;; the directions as set out by Phil Hagelberg (Technomancy) on the
-;;; web page: http://technomancy.us/126
+;; By far, the best way to install these components is by following
+;; the directions as set out by Phil Hagelberg (Technomancy) on the
+;; web page: http://technomancy.us/126
;;; Code:
(require 'ob)
(require 'slime)
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
- ((lambda (result)
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params))))))
+ (let ((result
+ (slime-eval
+ `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties (point-min) (point-max)))
+ (cdr (assoc :package params)))))
+ (let ((result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))))
(provide 'ob-clojure)
;;; ob-comint.el --- org-babel functions for interaction with comint buffers
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
string-buffer))
(setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
-(def-edebug-spec org-babel-comint-with-output (form body))
+(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
;;; ob-core.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
(declare-function org-unescape-code-in-string "org-src" (s))
(declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function org-reverse-string "org" (string))
+(declare-function org-element-context "org-element" (&optional ELEMENT))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
:group 'org-babel
:type 'string)
+(defcustom org-babel-inline-result-wrap "=%s="
+ "Format string used to wrap inline results.
+This string must include a \"%s\" which will be replaced by the results."
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
;; (4) header arguments
"\\([^\n]*\\)\n"
;; (5) body
- "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
+ "\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
(defvar org-babel-inline-src-block-regexp
(let ((src-at-0-p (save-excursion
(beginning-of-line 1)
(string= "src" (thing-at-point 'word))))
- (first-line-p (= 1 (line-number-at-pos)))
+ (first-line-p (= (line-beginning-position) (point-min)))
(orig (point)))
(let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
(first-line-p "[[:punct:] \t]src_")
of other code blocks.
Returns a list
- (language body header-arguments-alist switches name indent)."
+ (language body header-arguments-alist switches name indent block-head)."
(let ((case-fold-search t) head info name indent)
;; full code block
(if (setq head (org-babel-where-is-src-block-head))
;; resolve variable references and add summary parameters
(when (and info (not light))
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
- (when info (append info (list name indent)))))
+ (when info (append info (list name indent head)))))
(defvar org-current-export-file) ; dynamically bound
(defmacro org-babel-check-confirm-evaluate (info &rest body)
(noeval (or ,eval-no ,eval-no-export))
(query (or (equal ,eval "query")
(and ,export (equal ,eval "query-export"))
- (when (functionp org-confirm-babel-evaluate)
- (funcall org-confirm-babel-evaluate
- ,lang ,block-body))
- org-confirm-babel-evaluate))
+ (if (functionp org-confirm-babel-evaluate)
+ (funcall org-confirm-babel-evaluate
+ ,lang ,block-body)
+ org-confirm-babel-evaluate)))
(code-block (if ,info (format " %s " ,lang) " "))
(block-name (if ,name (format " (%s) " ,name) " ")))
,@body)))
(message (format "Evaluation of this%scode-block%sis disabled."
code-block block-name))))))
- ;; dynamically scoped for asynchroneous export
+ ;; dynamically scoped for asynchronous export
(defvar org-babel-confirm-evaluate-answer-no)
(defsubst org-babel-confirm-evaluate (info)
(dir . :any)
(eval . ((never query)))
(exports . ((code results both none)))
+ (epilogue . :any)
(file . :any)
(file-desc . :any)
(hlines . ((no yes)))
(noweb-sep . :any)
(padline . ((yes no)))
(post . :any)
+ (prologue . :any)
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer)
(replace silent none append prepend)
(session . :any)
(shebang . :any)
(tangle . ((tangle yes no :any)))
+ (tangle-mode . ((#o755 #o555 #o444 :any)))
(var . :any)
(wrap . :any)))
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
- (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")
- (:padnewline . "yes"))
+ (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.")
(defvar org-babel-default-inline-header-args
;;; functions
(defvar call-process-region)
+(defvar org-babel-current-src-block-location nil
+ "Marker pointing to the src block currently being executed.
+This may also point to a call line or an inline code block. If
+multiple blocks are being executed (e.g., in chained execution
+through use of the :var header argument) this marker points to
+the outer-most code block.")
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
the header arguments specified at the front of the source code
block."
(interactive)
- (let* ((info (if info
+ (let* ((org-babel-current-src-block-location
+ (or org-babel-current-src-block-location
+ (nth 6 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info
(copy-tree info)
(org-babel-get-src-block-info)))
(merged-params (org-babel-merge-params (nth 2 info) params)))
(or (org-bound-and-true-p
org-babel-call-process-region-original)
(symbol-function 'call-process-region)))
- (indent (car (last info)))
+ (indent (nth 5 info))
result cmd)
(unwind-protect
(let ((call-process-region
(if (member "none" result-params)
(progn
(funcall cmd body params)
- (message "result silenced"))
+ (message "result silenced")
+ (setq result nil))
(setq result
- ((lambda (result)
- (if (and (eq (cdr (assoc :result-type params))
- 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp result)))
- (list (list result)) result))
- (funcall cmd body params)))
- ;; if non-empty result and :file then write to :file
+ (let ((result (funcall cmd body params)))
+ (if (and (eq (cdr (assoc :result-type params))
+ 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp result)))
+ (list (list result)) result)))
+ ;; If non-empty result and :file then write to :file.
(when (cdr (assoc :file params))
(when result
(with-temp-file (cdr (assoc :file params))
(org-babel-format-result
result (cdr (assoc :sep (nth 2 info)))))))
(setq result (cdr (assoc :file params))))
- ;; possibly perform post process provided its appropriate
+ ;; Possibly perform post process provided its appropriate.
(when (cdr (assoc :post params))
(let ((*this* (if (cdr (assoc :file params))
(org-babel-result-to-file
(setq result-params
(remove "file" result-params)))))
(org-babel-insert-result
- result result-params info new-hash indent lang)
- (run-hooks 'org-babel-after-execute-hook)
- result))
+ result result-params info new-hash indent lang))
+ (run-hooks 'org-babel-after-execute-hook)
+ result)
(setq call-process-region
'org-babel-call-process-region-original)))))))))
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
org-babel-expand-body:lang function."
- (mapconcat #'identity (append var-lines (list body)) "\n"))
+ (let ((pro (cdr (assoc :prologue params)))
+ (epi (cdr (assoc :epilogue params))))
+ (mapconcat #'identity
+ (append (when pro (list pro))
+ var-lines
+ (list body)
+ (when epi (list epi)))
+ "\n")))
;;;###autoload
(defun org-babel-expand-src-block (&optional arg info params)
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
- (if (boundp lang-headers) (eval lang-headers) nil)))
+ (when (boundp lang-headers) (eval lang-headers))))
(arg (org-icompleting-read
"Header Arg: "
(mapcar
(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
+(defvar org-src-window-setup)
+
;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg info)
"Switch to code buffer and display session."
(defvar org-bracket-link-regexp)
+(defun org-babel-active-location-p ()
+ (memq (car (save-match-data (org-element-context)))
+ '(babel-call inline-babel-call inline-src-block src-block)))
+
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
"If `point' is on a src block then open the results of the
argument RE-RUN the source-code block is evaluated even if
results already exist."
(interactive "P")
- (let ((info (org-babel-get-src-block-info)))
+ (let ((info (org-babel-get-src-block-info 'light)))
(when info
(save-excursion
;; go to the results, if there aren't any then run the block
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
- (goto-char (match-beginning 0))
- (let ((full-block (match-string 0))
- (beg-block (match-beginning 0))
- (end-block (match-end 0))
- (lang (match-string 2))
- (beg-lang (match-beginning 2))
- (end-lang (match-end 2))
- (switches (match-string 3))
- (beg-switches (match-beginning 3))
- (end-switches (match-end 3))
- (header-args (match-string 4))
- (beg-header-args (match-beginning 4))
- (end-header-args (match-end 4))
- (body (match-string 5))
- (beg-body (match-beginning 5))
- (end-body (match-end 5)))
- ,@body
- (goto-char end-block))))
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 0))
+ (let ((full-block (match-string 0))
+ (beg-block (match-beginning 0))
+ (end-block (match-end 0))
+ (lang (match-string 2))
+ (beg-lang (match-beginning 2))
+ (end-lang (match-end 2))
+ (switches (match-string 3))
+ (beg-switches (match-beginning 3))
+ (end-switches (match-end 3))
+ (header-args (match-string 4))
+ (beg-header-args (match-beginning 4))
+ (end-header-args (match-end 4))
+ (body (match-string 5))
+ (beg-body (match-beginning 5))
+ (end-body (match-end 5)))
+ ,@body
+ (goto-char end-block)))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
(def-edebug-spec org-babel-map-src-blocks (form body))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-inline-src-block-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-lob-one-liner-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward ,rx nil t)
- (goto-char (match-beginning 1))
- (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ (forward-char 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
(t v)))))))
- ((lambda (hash)
- (when (org-called-interactively-p 'interactive) (message hash)) hash)
- (let ((it (format "%s-%s"
- (mapconcat
- #'identity
- (delq nil (mapcar (lambda (arg)
- (let ((normalized (funcall norm arg)))
- (when normalized
- (format "%S" normalized))))
- (nth 2 info))) ":")
- (nth 1 info))))
- (sha1 it))))))
+ (let* ((it (format "%s-%s"
+ (mapconcat
+ #'identity
+ (delq nil (mapcar (lambda (arg)
+ (let ((normalized (funcall norm arg)))
+ (when normalized
+ (format "%S" normalized))))
+ (nth 2 info))) ":")
+ (nth 1 info)))
+ (hash (sha1 it)))
+ (when (org-called-interactively-p 'interactive) (message hash))
+ hash))))
(defun org-babel-current-result-hash ()
"Return the current in-buffer hash."
(defun org-babel-set-current-result-hash (hash)
"Set the current in-buffer hash to HASH."
(org-babel-where-is-src-block-result)
- (save-excursion (goto-char (match-beginning 3))
- ;; (mapc #'delete-overlay (overlays-at (point)))
- (replace-match hash nil nil nil 3)
+ (save-excursion (goto-char (match-beginning 5))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 5)
+ (goto-char (point-at-bol))
(org-babel-hide-hash)))
(defun org-babel-hide-hash ()
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
"Retrieve parameters specified as properties.
-Return an association list of any source block params which
-may be specified in the properties of the current outline entry."
+Return a list of association lists of source block params
+specified in the properties of the current outline entry."
(save-match-data
- (let (val sym)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val (org-entry-get (point) header-arg t))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
+ (list
+ ;; DEPRECATED header arguments specified as separate property at
+ ;; point of definition
+ (let (val sym)
+ (org-babel-parse-multiple-vars
+ (delq nil
(mapcar
- #'symbol-name
+ (lambda (header-arg)
+ (and (setq val (org-entry-get (point) header-arg t))
+ (cons (intern (concat ":" header-arg))
+ (org-babel-read val))))
(mapcar
- #'car
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (progn
- (setq sym (intern (concat "org-babel-header-args:" lang)))
- (and (boundp sym) (eval sym))))))))))))
+ #'symbol-name
+ (mapcar
+ #'car
+ (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (progn
+ (setq sym (intern (concat "org-babel-header-args:" lang)))
+ (and (boundp sym) (eval sym))))))))))
+ ;; header arguments specified with the header-args property at
+ ;; point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ "header-args" 'inherit))
+ (when lang ;; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang) 'inherit))))))
(defvar org-src-preserve-indentation)
(defun org-babel-parse-src-block-match ()
(insert (org-unescape-code-in-string body))
(unless preserve-indentation (org-do-remove-indentation))
(buffer-string)))
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (when (boundp lang-headers) (eval lang-headers))
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) ""))))))
switches
block-indentation)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-unescape-code-in-string (org-no-properties (match-string 5)))
- (org-babel-merge-params
- org-babel-default-inline-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))
+ (apply #'org-babel-merge-params
+ org-babel-default-inline-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) "")))))))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
(cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg))))
(cons (intern (org-babel-chomp arg)) nil)))
- ((lambda (raw)
- (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
- (org-babel-balanced-split arg-string '((32 9) . 58))))))))
+ (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58))))
+ (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(defun org-babel-parse-multiple-vars (header-arguments)
"Expand multiple variable assignments behind a single :var keyword.
(defun org-babel-get-rownames (table)
"Return the row names of TABLE.
Return a cons cell, the `car' of which contains the TABLE less
-colnames, and the `cdr' of which contains a list of the column
-names. Note: this function removes any hlines in TABLE."
- (let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
- (width (apply 'max
- (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
- (table (funcall trans (mapcar (lambda (row)
- (if (not (equal row 'hline))
- row
- (setq row '())
- (dotimes (n width)
- (setq row (cons 'hline row)))
- row))
- table))))
- (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
- (funcall trans (cdr table)))
- (remove 'hline (car table)))))
+rownames, and the `cdr' of which contains a list of the rownames.
+Note: this function removes any hlines in TABLE."
+ (let* ((table (org-babel-del-hlines table))
+ (rownames (funcall (lambda ()
+ (let ((tp table))
+ (mapcar
+ (lambda (row)
+ (prog1
+ (pop (car tp))
+ (setq tp (cdr tp))))
+ table))))))
+ (cons table rownames)))
(defun org-babel-put-colnames (table colnames)
"Add COLNAMES to TABLE if they exist."
Given a TABLE and set of COLNAMES and ROWNAMES add the names
to the table for reinsertion to org-mode."
(if (listp table)
- ((lambda (table)
- (if (and colnames (listp (car table)) (= (length (car table))
- (length colnames)))
- (org-babel-put-colnames table colnames) table))
- (if (and rownames (= (length table) (length rownames)))
- (org-babel-put-rownames table rownames) table))
+ (let ((table (if (and rownames (= (length table) (length rownames)))
+ (org-babel-put-rownames table rownames) table)))
+ (if (and colnames (listp (car table)) (= (length (car table))
+ (length colnames)))
+ (org-babel-put-colnames table colnames) table))
table))
(defun org-babel-where-is-src-block-head ()
(< top initial) (< initial bottom)
(progn (goto-char top) (beginning-of-line 1)
(looking-at org-babel-src-block-regexp))
- (point))))))
+ (point-marker))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
"Go to the beginning of the current code block."
(interactive)
- ((lambda (head)
- (if head (goto-char head) (error "Not currently in a code block")))
- (org-babel-where-is-src-block-head)))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head (goto-char head) (error "Not currently in a code block"))))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
(when (and (string= "name" (downcase (match-string 1)))
(or (beginning-of-line 1)
(looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)))
+ (looking-at org-babel-multi-line-header-regexp)
+ (looking-at org-babel-lob-one-liner-regexp)))
(throw 'is-a-code-block (org-babel-find-named-result name (point))))
(beginning-of-line 0) (point))))))
(defun org-babel-mark-block ()
"Mark current src block."
(interactive)
- ((lambda (head)
- (when head
- (save-excursion
- (goto-char head)
- (looking-at org-babel-src-block-regexp))
- (push-mark (match-end 5) nil t)
- (goto-char (match-beginning 5))))
- (org-babel-where-is-src-block-head)))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (when head
+ (save-excursion
+ (goto-char head)
+ (looking-at org-babel-src-block-regexp))
+ (push-mark (match-end 5) nil t)
+ (goto-char (match-beginning 5)))))
(defun org-babel-demarcate-block (&optional arg)
"Wrap or split the code in the region or on the point.
(move-end-of-line 2))
(sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
- (lang (org-icompleting-read "Lang: "
- (mapcar (lambda (el) (symbol-name (car el)))
- org-babel-load-languages)))
+ (lang (org-icompleting-read
+ "Lang: "
+ (mapcar #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes))))))
(body (delete-and-extract-region
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(looking-at org-babel-lob-one-liner-regexp)))
(inlinep (when (org-babel-get-inline-src-block-matches)
(match-end 0)))
- (name (if on-lob-line
- (mapconcat #'identity (butlast (org-babel-lob-get-info))
- "")
- (nth 4 (or info (org-babel-get-src-block-info 'light)))))
+ (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(head (unless on-lob-line (org-babel-where-is-src-block-head)))
found beg end)
(when head (goto-char head))
((org-at-item-p) (org-babel-read-list))
((looking-at org-bracket-link-regexp) (org-babel-read-link))
((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
- ((looking-at "^[ \t]*: ")
+ ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
(setq result-string
(org-babel-trim
(mapconcat (lambda (line)
- (if (and (> (length line) 1)
- (string-match "^[ \t]*: \\(.+\\)" line))
- (match-string 1 line)
- line))
+ (or (and (> (length line) 1)
+ (string-match "^[ \t]*: ?\\(.+\\)" line)
+ (match-string 1 line))
+ ""))
(split-string
(buffer-substring
(point) (org-babel-result-end)) "[\r\n]+")
(progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
nil t)
(forward-char 1))
- (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
+ (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)")
(forward-line 1))))
(point)))))
(funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
(save-excursion
(goto-char beg)
- (insert (format "=%s=" (prog1 (buffer-substring beg end)
- (delete-region beg end)))))
+ (insert (format org-babel-inline-result-wrap
+ (prog1 (buffer-substring beg end)
+ (delete-region beg end)))))
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)) ; do nothing for an empty result
new-params))
result-params)
output)))
- params results exports tangle noweb cache vars shebang comments padline)
+ params results exports tangle noweb cache vars shebang comments padline
+ clearnames)
(mapc
(lambda (plist)
(setq vars
(append
(if (member name (mapcar #'car vars))
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars))
+ (progn
+ (push name clearnames)
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (unless (equal (car p) name) p))
+ vars)))
vars)
(list (cons name pair))))
;; if no name is given and we already have named variables
;; then assign to named variables in order
(if (and vars (nth variable-index vars))
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name
- (car (nth variable-index vars)))
- "=" (cdr pair)))
- (incf variable-index))
+ (let ((name (car (nth variable-index vars))))
+ (push name clearnames) ; clear out colnames
+ ; and rownames
+ ; for replace vars
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" (cdr pair)))
+ (incf variable-index)))
(error "Variable \"%s\" must be assigned a default value"
(cdr pair))))))
(:results
plists)
(setq vars (reverse vars))
(while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
+ ;; clear out col-names and row-names for replaced variables
+ (mapc
+ (lambda (name)
+ (mapc
+ (lambda (param)
+ (when (assoc param params)
+ (setf (cdr (assoc param params))
+ (org-remove-if (lambda (pair) (equal (car pair) name))
+ (cdr (assoc param params))))
+ (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params))))
+ (list :colname-names :rowname-names)))
+ clearnames)
(mapc
(lambda (hd)
(let ((key (intern (concat ":" (symbol-name hd))))
these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"."
(let* ((parent-buffer (or parent-buffer (current-buffer)))
- (info (or info (org-babel-get-src-block-info)))
+ (info (or info (org-babel-get-src-block-info 'light)))
(lang (nth 0 info))
(body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start)
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
(org-babel-trim (buffer-string)))))
- index source-name evaluate prefix blocks-in-buffer)
+ index source-name evaluate prefix)
(with-temp-buffer
(org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
(org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
(funcall nb-add (buffer-substring index (point)))
(goto-char (match-end 0))
(setq index (point))
- (funcall nb-add
- (with-current-buffer parent-buffer
- (save-restriction
- (widen)
- (mapconcat ;; interpose PREFIX between every line
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve source-name)))
- (if (stringp raw) raw (format "%S" raw)))
- (or
- ;; retrieve from the library of babel
- (nth 2 (assoc (intern source-name)
- org-babel-library-of-babel))
- ;; return the contents of headlines literally
- (save-excursion
- (when (org-babel-ref-goto-headline-id source-name)
+ (funcall
+ nb-add
+ (with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
+ (mapconcat ;; Interpose PREFIX between every line.
+ #'identity
+ (split-string
+ (if evaluate
+ (let ((raw (org-babel-ref-resolve source-name)))
+ (if (stringp raw) raw (format "%S" raw)))
+ (or
+ ;; Retrieve from the library of babel.
+ (nth 2 (assoc (intern source-name)
+ org-babel-library-of-babel))
+ ;; Return the contents of headlines literally.
+ (save-excursion
+ (when (org-babel-ref-goto-headline-id source-name)
(org-babel-ref-headline-body)))
- ;; find the expansion of reference in this buffer
- (let ((rx (concat rx-prefix source-name "[ \t\n]"))
- expansion)
- (save-excursion
- (goto-char (point-min))
- (if org-babel-use-quick-and-dirty-noweb-expansion
- (while (re-search-forward rx nil t)
- (let* ((i (org-babel-get-src-block-info 'light))
- (body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion (cons sep (cons full expansion)))))
- (org-babel-map-src-blocks nil
- (let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
- (nth 4 i))
- source-name)
- (let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion
- (cons sep (cons full expansion)))))))))
- (and expansion
- (mapconcat #'identity (nreverse (cdr expansion)) "")))
- ;; possibly raise an error if named block doesn't exist
- (if (member lang org-babel-noweb-error-langs)
- (error "%s" (concat
- (org-babel-noweb-wrap source-name)
- "could not be resolved (see "
- "`org-babel-noweb-error-langs')"))
- "")))
- "[\n\r]") (concat "\n" prefix))))))
+ ;; Find the expansion of reference in this buffer.
+ (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+ expansion)
+ (save-excursion
+ (goto-char (point-min))
+ (if org-babel-use-quick-and-dirty-noweb-expansion
+ (while (re-search-forward rx nil t)
+ (let* ((i (org-babel-get-src-block-info 'light))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion (cons sep (cons full expansion)))))
+ (org-babel-map-src-blocks nil
+ (let ((i (org-babel-get-src-block-info 'light)))
+ (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (nth 4 i))
+ source-name)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion
+ (cons sep (cons full expansion)))))))))
+ (and expansion
+ (mapconcat #'identity (nreverse (cdr expansion)) "")))
+ ;; Possibly raise an error if named block doesn't exist.
+ (if (member lang org-babel-noweb-error-langs)
+ (error "%s" (concat
+ (org-babel-noweb-wrap source-name)
+ "could not be resolved (see "
+ "`org-babel-noweb-error-langs')"))
+ "")))
+ "[\n\r]") (concat "\n" prefix))))))
(funcall nb-add (buffer-substring index (point-max))))
new-body))
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
- (let (in-single in-double out)
- ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped)))
- (if (or force
- (and (stringp str)
- (> (length str) 2)
- (or (and (string-equal "[" (substring str 0 1))
- (string-equal "]" (substring str -1)))
- (and (string-equal "{" (substring str 0 1))
- (string-equal "}" (substring str -1)))
- (and (string-equal "(" (substring str 0 1))
- (string-equal ")" (substring str -1))))))
- (org-babel-read
- (concat
- "'"
- (progn
- (mapc
- (lambda (ch)
- (setq
- out
- (case ch
- (91 (if (or in-double in-single) ; [
- (cons 91 out)
- (cons 40 out)))
- (93 (if (or in-double in-single) ; ]
- (cons 93 out)
- (cons 41 out)))
- (123 (if (or in-double in-single) ; {
- (cons 123 out)
- (cons 40 out)))
- (125 (if (or in-double in-single) ; }
- (cons 125 out)
- (cons 41 out)))
- (44 (if (or in-double in-single) ; ,
- (cons 44 out) (cons 32 out)))
- (39 (if in-double ; '
- (cons 39 out)
- (setq in-single (not in-single)) (cons 34 out)))
- (34 (if in-single ; "
- (append (list 34 32) out)
- (setq in-double (not in-double)) (cons 34 out)))
- (t (cons ch out)))))
- (string-to-list str))
- (apply #'string (reverse out)))))
- str))))
+ (let ((escaped
+ (if (or force
+ (and (stringp str)
+ (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1))))))
+ (org-babel-read
+ (concat
+ "'"
+ (let (in-single in-double out)
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (case ch
+ (91 (if (or in-double in-single) ; [
+ (cons 91 out)
+ (cons 40 out)))
+ (93 (if (or in-double in-single) ; ]
+ (cons 93 out)
+ (cons 41 out)))
+ (123 (if (or in-double in-single) ; {
+ (cons 123 out)
+ (cons 40 out)))
+ (125 (if (or in-double in-single) ; }
+ (cons 125 out)
+ (cons 41 out)))
+ (44 (if (or in-double in-single) ; ,
+ (cons 44 out) (cons 32 out)))
+ (39 (if in-double ; '
+ (cons 39 out)
+ (setq in-single (not in-single)) (cons 34 out)))
+ (34 (if in-single ; "
+ (append (list 34 32) out)
+ (setq in-double (not in-double)) (cons 34 out)))
+ (t (cons ch out)))))
+ (string-to-list str))
+ (apply #'string (reverse out)))))
+ str)))
+ (condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like lisp (meaning it starts with a
-\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise
-return it unmodified as a string. Optional argument NO-LISP-EVAL
-inhibits lisp evaluation for situations in which is it not
-appropriate."
+\"(\", \"'\", \"`\" or a \"[\") then read it as lisp,
+otherwise return it unmodified as a string. Optional argument
+NO-LISP-EVAL inhibits lisp evaluation for situations in which is
+it not appropriate."
(if (and (stringp cell) (not (equal cell "")))
(or (org-babel-number-p cell)
(if (and (not inhibit-lisp-eval)
remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'"
- ((lambda (f) (if no-quote-p f (shell-quote-argument f)))
- (expand-file-name (org-babel-local-file-name name))))
+ (let ((f (expand-file-name (org-babel-local-file-name name))))
+ (if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory)
(unless (or noninteractive (boundp 'org-babel-temporary-directory))
;;; ob-css.el --- org-babel functions for css evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
:group 'org-babel
:type 'string)
+(defcustom org-babel-ditaa-java-cmd "java"
+ "Java executable to use when evaluating ditaa blocks."
+ :group 'org-babel
+ :type 'string)
+
(defcustom org-ditaa-eps-jar-path
(expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path))
"Path to the DitaaEps.jar executable."
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file ((lambda (el)
- (or el
- (error
- "ditaa code block requires :file header argument")))
- (cdr (assoc :file params))))
+ (out-file (let ((el (cdr (assoc :file params))))
+ (or el
+ (error
+ "ditaa code block requires :file header argument"))))
(cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(eps (cdr (assoc :eps params)))
- (cmd (concat "java " java " " org-ditaa-jar-option " "
+ (cmd (concat org-babel-ditaa-java-cmd
+ " " java " " org-ditaa-jar-option " "
(shell-quote-argument
(expand-file-name
(if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
;;; ob-dot.el --- org-babel functions for dot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
- ((lambda (result)
- (org-babel-result-cond (cdr (assoc :result-params params))
- (let ((print-level nil)
- (print-length nil))
- (if (or (member "scalar" (cdr (assoc :result-params params)))
- (member "verbatim" (cdr (assoc :result-params params))))
- (format "%S" result)
- (format "%s" result)))
- (org-babel-reassemble-table
- result
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
- (eval (read (format (if (member "output"
- (cdr (assoc :result-params params)))
- "(with-output-to-string %s)"
- "(progn %s)")
- (org-babel-expand-body:emacs-lisp body params)))))))
+ (let ((result
+ (eval (read (format (if (member "output"
+ (cdr (assoc :result-params params)))
+ "(with-output-to-string %s)"
+ "(progn %s)")
+ (org-babel-expand-body:emacs-lisp
+ body params))))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (let ((print-level nil)
+ (print-length nil))
+ (if (or (member "scalar" (cdr (assoc :result-params params)))
+ (member "verbatim" (cdr (assoc :result-params params))))
+ (format "%S" result)
+ (format "%s" result)))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))))
(provide 'ob-emacs-lisp)
;;; ob-eval.el --- org-babel functions for external code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
;; shell commands.
;;; Code:
+(require 'org-macs)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
;;; ob-exp.el --- Exportation of org-babel source blocks
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
('otherwise
(error "Requested export buffer when `org-current-export-file' is nil"))))
+(defvar org-link-search-inhibit-query)
+
(defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
(org-babel-exp-in-export-file lang
(setf (nth 2 info)
(org-babel-process-params
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- raw-params))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append (org-babel-params-from-properties lang)
+ (list raw-params))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
:type 'string)
(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-non-block-elements (start end)
- "Process inline source and call lines between START and END for export."
+(defun org-babel-exp-process-buffer ()
+ "Execute all Babel blocks in current buffer."
(interactive)
- (save-excursion
- (goto-char start)
- (unless (markerp end)
- (let ((m (make-marker)))
- (set-marker m end (current-buffer))
- (setq end m)))
- (let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)")))
- (while (re-search-forward rx end t)
- (save-excursion
+ (save-window-excursion
+ (save-excursion
+ (let ((case-fold-search t)
+ (regexp (concat org-babel-inline-src-block-regexp "\\|"
+ org-babel-lob-one-liner-regexp "\\|"
+ "^[ \t]*#\\+BEGIN_SRC")))
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
(let* ((element (save-excursion
;; If match is inline, point is at its
;; end. Move backward so
;; object, not the following one.
(backward-char)
(save-match-data (org-element-context))))
- (type (org-element-type element)))
- (when (memq type '(babel-call inline-babel-call inline-src-block))
- (let ((beg-el (org-element-property :begin element))
- (end-el (org-element-property :end element)))
- (case type
- (inline-src-block
- (let* ((info (org-babel-parse-inline-src-block-match))
- (params (nth 2 info)))
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
- (nth 1 info)))
- (goto-char beg-el)
- (let ((replacement (org-babel-exp-do-export info 'inline)))
- (if (equal replacement "")
- ;; Replacement code is empty: completely
- ;; remove inline src block, including extra
- ;; white space that might have been created
- ;; when inserting results.
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-forward " \t")
- (point)))
- ;; Otherwise: remove inline src block but
- ;; preserve following white spaces. Then
- ;; insert value.
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-backward " \t")
- (point)))
- (insert replacement)))))
- ((babel-call inline-babel-call)
- (let* ((lob-info (org-babel-lob-get-info))
- (results
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat 'identity
- (butlast lob-info)
- " ")))))
- "" nil (car (last lob-info)))
- 'lob))
- (rep (org-fill-template
- org-babel-exp-call-line-template
- `(("line" . ,(nth 0 lob-info))))))
- ;; If replacement is empty, completely remove the
- ;; object/element, including any extra white space
- ;; that might have been created when including
- ;; results.
- (if (equal rep "")
- (delete-region
- beg-el
- (progn (goto-char end-el)
- (if (not (eq type 'babel-call))
- (progn (skip-chars-forward " \t") (point))
- (skip-chars-forward " \r\t\n")
- (line-beginning-position))))
- ;; Otherwise, preserve following white
- ;; spaces/newlines and then, insert replacement
- ;; string.
- (goto-char beg-el)
- (delete-region beg-el
- (progn (goto-char end-el)
- (skip-chars-backward " \r\t\n")
- (point)))
- (insert rep)))))))))))))
-
-(defvar org-src-preserve-indentation) ; From org-src.el
-(defun org-babel-exp-process-buffer ()
- "Execute all blocks in visible part of buffer."
- (interactive)
- (save-window-excursion
- (let ((case-fold-search t)
- (pos (point-min)))
- (goto-char pos)
- (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t)
- (let ((element (save-match-data (org-element-at-point))))
- (when (eq (org-element-type element) 'src-block)
- (let* ((match-start (copy-marker (match-beginning 0)))
- (begin (copy-marker (org-element-property :begin element)))
- ;; Make sure we don't remove any blank lines after
- ;; the block when replacing it.
- (block-end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (copy-marker (line-end-position))))
- (ind (org-get-indentation))
- (headers
- (cons
- (org-element-property :language element)
- (let ((params (org-element-property :parameters element)))
- (and params (org-split-string params "[ \t]+")))))
- (preserve-indent
- (or org-src-preserve-indentation
- (org-element-property :preserve-indent element))))
- ;; Execute all non-block elements between POS and
- ;; current block.
- (org-babel-exp-non-block-elements pos begin)
- ;; Take care of matched block: compute replacement
- ;; string. In particular, a nil REPLACEMENT means the
- ;; block should be left as-is while an empty string
- ;; should remove the block.
- (let ((replacement (progn (goto-char match-start)
- (org-babel-exp-src-block headers))))
- (cond ((not replacement) (goto-char block-end))
- ((equal replacement "")
+ (type (org-element-type element))
+ (begin (copy-marker (org-element-property :begin element)))
+ (end (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (case type
+ (inline-src-block
+ (let* ((info (org-babel-parse-inline-src-block-match))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assoc :noweb params))
+ (string= "yes" (cdr (assoc :noweb params))))
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (goto-char begin)
+ (let ((replacement (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove inline src
+ ;; block, including extra white space that
+ ;; might have been created when inserting
+ ;; results.
(delete-region begin
- (progn (goto-char block-end)
- (skip-chars-forward " \r\t\n")
- (if (eobp) (point)
- (line-beginning-position)))))
- (t
- (goto-char match-start)
- (delete-region (point) block-end)
- (insert replacement)
- (if preserve-indent
- ;; Indent only the code block markers.
- (save-excursion (skip-chars-backward " \r\t\n")
- (indent-line-to ind)
- (goto-char match-start)
- (indent-line-to ind))
- ;; Indent everything.
- (indent-rigidly match-start (point) ind)))))
- (setq pos (line-beginning-position))
- ;; Cleanup markers.
- (set-marker match-start nil)
- (set-marker begin nil)
- (set-marker block-end nil)))))
- ;; Eventually execute all non-block Babel elements between last
- ;; src-block and end of buffer.
- (org-babel-exp-non-block-elements pos (point-max)))))
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then insert
+ ;; value.
+ (delete-region begin end)
+ (insert replacement)))))
+ ((babel-call inline-babel-call)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (results
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat 'identity
+ (butlast lob-info 2)
+ " ")))))))
+ "" (nth 3 lob-info) (nth 2 lob-info))
+ 'lob))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
+ ;; If replacement is empty, completely remove the
+ ;; object/element, including any extra white space
+ ;; that might have been created when including
+ ;; results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t") (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve following white
+ ;; spaces/newlines and then, insert replacement
+ ;; string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (src-block
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-get-indentation))
+ (headers
+ (cons
+ (org-element-property :language element)
+ (let ((params (org-element-property :parameters
+ element)))
+ (and params (org-split-string params "[ \t]+"))))))
+ ;; Take care of matched block: compute replacement
+ ;; string. In particular, a nil REPLACEMENT means
+ ;; the block should be left as-is while an empty
+ ;; string should remove the block.
+ (let ((replacement (progn (goto-char match-start)
+ (org-babel-exp-src-block headers))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (goto-char match-start)
+ (delete-region (point)
+ (save-excursion (goto-char end)
+ (line-end-position)))
+ (insert replacement)
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent
+ element))
+ ;; Indent only the code block markers.
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly match-start (point) ind)))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil)))))))
(defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code.
(org-babel-exp-code info)))))
(defcustom org-babel-exp-code-template
- "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
lang ------ the language of the code block
name ------ the name of the code block
body ------ the body of the code block
+ switches -- the switches associated to the code block
flags ----- the flags passed to the code block
In addition to the keys mentioned above, every header argument
org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
("body" . ,(org-escape-code-in-string (nth 1 info)))
+ ("switches" . ,(let ((f (nth 3 info)))
+ (and (org-string-nw-p f) (concat " " f))))
+ ("flags" . ,(let ((f (assq :flags (nth 2 info))))
+ (and f (concat " " (cdr f)))))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
(nth 2 info))
- ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash)
(org-babel-expand-noweb-references
info (org-babel-exp-get-export-buffer))
(nth 1 info)))
- (info (copy-sequence info)))
+ (info (copy-sequence info))
+ (org-babel-current-src-block-location (point-marker)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
;;; ob-fortran.el --- org-babel functions for fortran
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Authors: Sergey Litvinov
;; Eric Schulte
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
+(declare-function org-every "org" (pred seq))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) ""))))
- ((lambda (results)
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "f-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (let ((results
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "f-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
((stringp val)
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
+ ;; val is a matrix
+ ((and (listp val) (org-every #'listp val))
+ (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
+ var (length val) (length (car val))
+ (org-babel-fortran-transform-list val)
+ (length (car val)) (length val)))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (org-babel-fortran-transform-list val)))
;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
+(defvar org-babel-header-args:gnuplot
+ '((title . :any)
+ (lines . :any)
+ (sets . :any)
+ (x-labels . :any)
+ (y-labels . :any)
+ (timefmt . :any)
+ (time-ind . :any)
+ (missing . :any)
+ (term . :any))
+ "Gnuplot specific header args.")
+
(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar *org-babel-gnuplot-missing* nil)
+
+(defcustom *org-babel-gnuplot-terms*
+ '((eps . "postscript eps"))
+ "List of file extensions and the associated gnuplot terminal."
+ :group 'org-babel
+ :type '(repeat (cons (symbol :tag "File extension")
+ (string :tag "Gnuplot terminal"))))
+
(defun org-babel-gnuplot-process-vars (params)
"Extract variables from PARAMS and process the variables.
Dumps all vectors into files and returns an association list
of variable names and the related value to be used in the gnuplot
code."
- (mapcar
- (lambda (pair)
- (cons
- (car pair) ;; variable name
- (if (listp (cdr pair)) ;; variable value
- (org-babel-gnuplot-table-to-data
- (cdr pair) (org-babel-temp-file "gnuplot-") params)
- (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (mapcar
+ (lambda (pair)
+ (cons
+ (car pair) ;; variable name
+ (let* ((val (cdr pair)) ;; variable value
+ (lp (listp val)))
+ (if lp
+ (org-babel-gnuplot-table-to-data
+ (let* ((first (car val))
+ (tablep (or (listp first) (symbolp first))))
+ (if tablep val (mapcar 'list val)))
+ (org-babel-temp-file "gnuplot-") params)
+ val))))
+ (mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
(out-file (cdr (assoc :file params)))
- (term (or (cdr (assoc :term params))
- (when out-file (file-name-extension out-file))))
+ (prologue (cdr (assoc :prologue params)))
+ (epilogue (cdr (assoc :epilogue params)))
+ (term (or (cdr (assoc :term params))
+ (when out-file
+ (let ((ext (file-name-extension out-file)))
+ (or (cdr (assoc (intern (downcase ext))
+ *org-babel-gnuplot-terms*))
+ ext)))))
(cmdline (cdr (assoc :cmdline params)))
- (title (plist-get params :title))
- (lines (plist-get params :line))
- (sets (plist-get params :set))
- (x-labels (plist-get params :xlabels))
- (y-labels (plist-get params :ylabels))
- (timefmt (plist-get params :timefmt))
- (time-ind (or (plist-get params :timeind)
+ (title (cdr (assoc :title params)))
+ (lines (cdr (assoc :line params)))
+ (sets (cdr (assoc :set params)))
+ (x-labels (cdr (assoc :xlabels params)))
+ (y-labels (cdr (assoc :ylabels params)))
+ (timefmt (cdr (assoc :timefmt params)))
+ (time-ind (or (cdr (assoc :timeind params))
(when timefmt 1)))
+ (missing (cdr (assoc :missing params)))
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
;; append header argument settings to body
- (when title (funcall add-to-body (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
+ (when title (funcall add-to-body (format "set title '%s'" title)))
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
+ (when missing
+ (funcall add-to-body (format "set datafile missing '%s'" missing)))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
(funcall add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(funcall add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(funcall add-to-body "set xdata time")
(funcall add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
- (when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
+ (when out-file
+ ;; set the terminal at the top of the block
+ (funcall add-to-body (format "set output \"%s\"" out-file))
+ ;; and close the terminal at the bottom of the block
+ (setq body (concat body "\nset output\n")))
(when term (funcall add-to-body (format "set term %s" term)))
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
- (funcall add-to-body (mapconcat #'identity
- (org-babel-variable-assignments:gnuplot params)
- "\n"))
+ (funcall add-to-body
+ (mapconcat #'identity
+ (org-babel-variable-assignments:gnuplot params)
+ "\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
- vars))
+ vars)
+ (when prologue (funcall add-to-body prologue))
+ (when epilogue (setq body (concat body "\n" epilogue))))
body))
(defun org-babel-execute:gnuplot (body params)
(defun org-babel-gnuplot-quote-timestamp-field (s)
"Convert 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)
(if (string-match org-table-number-regexp s) s
(if (string-match org-ts-regexp3 s)
(org-babel-gnuplot-quote-timestamp-field s)
- (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
+ (if (zerop (length s))
+ (or *org-babel-gnuplot-missing* s)
+ (if (string-match "[ \"]" s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"")
+ "\"")
+ s)))))
(defun org-babel-gnuplot-table-to-data (table data-file params)
"Export TABLE to DATA-FILE in a format readable by gnuplot.
;;; ob-haskell.el --- org-babel functions for haskell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
-(defvar org-babel-default-header-args:haskell '())
+(defvar org-babel-default-header-args:haskell
+ '((:padlines . "no")))
(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
(cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table
- ((lambda (result)
- (org-babel-result-cond (cdr (assoc :result-params params))
- result (org-babel-haskell-table-or-string result)))
- (case result-type
- ('output (mapconcat #'identity (reverse (cdr results)) "\n"))
- ('value (car results))))
+ (let ((result
+ (case result-type
+ (output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ (value (car results)))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result (org-babel-haskell-table-or-string result)))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(format "%S" var)))
(defvar org-src-preserve-indentation)
+(defvar org-export-copy-to-kill-ring)
(declare-function org-export-to-file "ox"
(backend file
- &optional subtreep visible-only body-only ext-plist))
+ &optional async subtreep visible-only body-only ext-plist))
(defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting
;;; ob-io.el --- org-babel functions for Io evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
(value (let* ((src-file (org-babel-temp-file "io-"))
(wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
- ((lambda (raw)
- (org-babel-result-cond result-params
- raw
- (org-babel-io-table-or-string raw)))
- (org-babel-eval
- (concat org-babel-io-command " " src-file) ""))))))
+ (let ((raw (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-io-table-or-string raw)))))))
(defun org-babel-prep-session:io (session params)
;;; ob-java.el --- org-babel functions for java evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
- ((lambda (results)
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-eval (concat org-babel-java-command
- " " cmdline " " classname) ""))))
+ (let ((results (org-babel-eval (concat org-babel-java-command
+ " " cmdline " " classname) "")))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(provide 'ob-java)
;;; ob-js.el --- org-babel functions for Javascript
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
;;; ob-keys.el --- key bindings for org-babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; ob-latex.el --- org-babel functions for latex "evaluation"
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
+(defcustom org-babel-latex-htlatex ""
+ "The htlatex command to enable conversion of latex to SVG or HTML."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-latex-htlatex-packages
+ '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
+ "Packages to use for htlatex export."
+ :group 'org-babel
+ :type '(repeat (string)))
+
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
((and (string-match "\\.png$" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((or (string-match "\\.pdf$" out-file) imagemagick)
+ ((string-match "\\.tikz$" out-file)
+ (when (file-exists-p out-file) (delete-file out-file))
+ (with-temp-file out-file
+ (insert body)))
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
(with-temp-file tex-file
(require 'ox-latex)
(insert
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
+ ((and (or (string-match "\\.svg$" out-file)
+ (string-match "\\.html$" out-file))
+ (not (string= "" org-babel-latex-htlatex)))
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
+ (cond
+ ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
+ (if (string-match "\\.svg$" out-file)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ out-file)))
+ (error "SVG file produced but HTML file requested.")))
+ ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
+ (if (string-match "\\.html$" out-file)
+ (shell-command "mv %s %s"
+ (concat (file-name-sans-extension tex-file)
+ ".html")
+ out-file)
+ (error "HTML file produced but SVG file requested.")))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(match-string 1 out-file))))
;;; ob-ledger.el --- org-babel functions for ledger evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
(let ((arg-1 (ly-determine-ly-path)) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
- (arg-4 t) ;display
(arg-4 t) ;display
(arg-5 (if ly-gen-png "--png" "")) ;&rest...
(arg-6 (if ly-gen-html "--html" ""))
;;; ob-lisp.el --- org-babel functions for common lisp evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Joel Boehland
;; Eric Schulte
"Execute a block of Common Lisp code with Babel."
(require 'slime)
(org-babel-reassemble-table
- ((lambda (result)
- (org-babel-result-cond (cdr (assoc :result-params params))
- (car result)
- (condition-case nil
- (read (org-babel-lisp-vector-to-list (cadr result)))
- (error (cadr result)))))
- (with-temp-buffer
- (insert (org-babel-expand-body:lisp body params))
- (slime-eval `(swank:eval-and-grab-output
- ,(let ((dir (if (assoc :dir params)
- (cdr (assoc :dir params))
- default-directory)))
- (format
- (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assoc :package params)))))
+ (let ((result
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (slime-eval `(swank:eval-and-grab-output
+ ,(let ((dir (if (assoc :dir params)
+ (cdr (assoc :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir)
+ "(progn %s)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assoc :package params))))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (car result)
+ (condition-case nil
+ (read (org-babel-lisp-vector-to-list (cadr result)))
+ (error (cadr result)))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
;;; ob-lob.el --- functions supporting the Library of Babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
This is an association list. Populate the library by adding
files to `org-babel-lob-files'.")
-(defcustom org-babel-lob-files '()
+(defcustom org-babel-lob-files nil
"Files used to populate the `org-babel-library-of-babel'.
To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
:version "24.1"
- :type 'list)
+ :type '(repeat file))
(defvar org-babel-default-lob-header-args '((:exports . "results"))
"Default header arguments to use when exporting #+lob/call lines.")
(defun org-babel-lob-ingest (&optional file)
- "Add all named source-blocks defined in FILE to
-`org-babel-library-of-babel'."
+ "Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(or (funcall nonempty 8 19) ""))
(funcall nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))))))))
+ (match-string 2) (match-string 11)))
+ (save-excursion
+ (forward-line -1)
+ (and (looking-at (concat org-babel-src-name-regexp
+ "\\([^\n]*\\)$"))
+ (org-no-properties (match-string 1))))))))))
(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
- (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
- (pre-params (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-header-args:emacs-lisp
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat #'identity (butlast info) " "))))))
+ (let* ((mkinfo (lambda (p)
+ (list "emacs-lisp" "results" p nil
+ (nth 3 info) ;; name
+ (nth 2 info))))
+ (pre-params (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-header-args:emacs-lisp
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat #'identity (butlast info 2)
+ " "))))))))
(pre-info (funcall mkinfo pre-params))
(cache-p (and (cdr (assoc :cache pre-params))
(string= "yes" (cdr (assoc :cache pre-params)))))
(new-hash (when cache-p (org-babel-sha1-hash pre-info)))
- (old-hash (when cache-p (org-babel-current-result-hash))))
+ (old-hash (when cache-p (org-babel-current-result-hash)))
+ (org-babel-current-src-block-location (point-marker)))
(if (and cache-p (equal new-hash old-hash))
(save-excursion (goto-char (org-babel-where-is-src-block-result))
(forward-line 1)
;;; ob-makefile.el --- org-babel functions for makefile evaluation
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
-;; Author: Eric Schulte and Thomas S. Dye
+;; Author: Eric Schulte
+;; Thomas S. Dye
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
;;; ob-matlab.el --- org-babel support for matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
;;; ob-maxima.el --- org-babel functions for maxima evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
(defcustom org-babel-maxima-command
(if (boundp 'maxima-command) maxima-command "maxima")
"Command used to call maxima on the shell."
- :group 'org-babel)
+ :group 'org-babel
+ :type 'string)
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
"\n")))
(defun org-babel-execute:maxima (body params)
- "Execute a block of Maxima entries with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of Maxima entries with org-babel.
+This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
org-babel-maxima-command in-file cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd)
- ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
- (mapconcat
- #'identity
- (delq nil
- (mapcar (lambda (line)
- (unless (or (string-match "batch" line)
- (string-match "^rat: replaced .*$" line)
- (string-match "^;;; Loading #P" line)
- (= 0 (length line)))
- line))
- (split-string raw "[\r\n]"))) "\n"))
- (org-babel-eval cmd "")))))
+ ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
+ (let ((raw (org-babel-eval cmd "")))
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar (lambda (line)
+ (unless (or (string-match "batch" line)
+ (string-match "^rat: replaced .*$" line)
+ (string-match "^;;; Loading #P" line)
+ (= 0 (length line)))
+ line))
+ (split-string raw "[\r\n]"))) "\n")))))
(if (org-babel-maxima-graphical-output-file params)
nil
(org-babel-result-cond result-params
;;; ob-msc.el --- org-babel functions for mscgen evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
+(defcustom org-babel-ocaml-command "ocaml"
+ "Name of the command for executing Ocaml code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(session org-babel-ocaml-eoe-output t full-body)
(insert
(concat
- (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
+ (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
- (let ((raw (org-babel-trim clean)))
- (org-babel-result-cond (cdr (assoc :result-params params))
- ;; strip type information from output
- (if (string-match "= \\(.+\\)$" raw) (match-string 1 raw) raw)
+ (let ((raw (org-babel-trim clean))
+ (result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ ;; strip type information from output unless verbatim is specified
+ (if (and (not (member "verbatim" result-params))
+ (string-match "= \\(.+\\)$" raw))
+ (match-string 1 raw) raw)
(org-babel-ocaml-parse-output raw)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(stringp session))
session
tuareg-interactive-buffer-name)))
- (save-window-excursion
- (if (fboundp 'tuareg-run-caml) (tuareg-run-caml) (tuareg-run-ocaml))
- (get-buffer tuareg-interactive-buffer-name))))
+ (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
+ (tuareg-run-process-if-needed org-babel-ocaml-command)
+ (tuareg-run-caml)))
+ (get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables."
(defun org-babel-ocaml-parse-output (output)
"Parse OUTPUT.
OUTPUT is string output from an ocaml process."
- (let ((regexp "%s = \\(.+\\)$"))
+ (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
- (if matlabp (require 'matlab) (require 'octave-inf))
+ (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
+ (require 'octave)))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
;;; ob-org.el --- org-babel functions for org code block evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defun org-babel-expand-body:org (body params)
(dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
(setq body (replace-regexp-in-string
- (regexp-quote (format "$%s" (car var))) (cdr var) body
- nil 'literal)))
+ (regexp-quote (format "$%s" (car var)))
+ (format "%s" (cdr var))
+ body nil 'literal)))
body)
(defun org-babel-execute:org (body params)
;;; ob-perl.el --- org-babel functions for perl evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
(tmp-file (org-babel-temp-file "perl-"))
(tmp-babel-file (org-babel-process-file-name
tmp-file 'noquote)))
- ((lambda (results)
- (when results
- (org-babel-result-cond result-params
- (org-babel-eval-read-file tmp-file)
- (org-babel-import-elisp-from-file tmp-file '(16)))))
- (case result-type
- (output
- (with-temp-file tmp-file
- (insert
- (org-babel-eval org-babel-perl-command body))
- (buffer-string)))
- (value
- (org-babel-eval org-babel-perl-command
- (format org-babel-perl-wrapper-method
- body tmp-babel-file)))))))
+ (let ((results
+ (case result-type
+ (output
+ (with-temp-file tmp-file
+ (insert
+ (org-babel-eval org-babel-perl-command body))
+ (buffer-string)))
+ (value
+ (org-babel-eval org-babel-perl-command
+ (format org-babel-perl-wrapper-method
+ body tmp-babel-file))))))
+ (when results
+ (org-babel-result-cond result-params
+ (org-babel-eval-read-file tmp-file)
+ (org-babel-import-elisp-from-file tmp-file '(16)))))))
(provide 'ob-perl)
;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Authors: Thorsten Jolitz
;; Eric Schulte
called by `org-babel-execute-src-block'"
(message "executing Picolisp source code block")
(let* (
- ;; name of the session or "none"
+ ;; Name of the session or "none".
(session-name (cdr (assoc :session params)))
- ;; set the session if the session variable is non-nil
+ ;; Set the session if the session variable is non-nil.
(session (org-babel-picolisp-initiate-session session-name))
- ;; either OUTPUT or VALUE which should behave as described above
+ ;; Either OUTPUT or VALUE which should behave as described above.
(result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params)))
- ;; expand the body with `org-babel-expand-body:picolisp'
+ ;; Expand the body with `org-babel-expand-body:picolisp'.
(full-body (org-babel-expand-body:picolisp body params))
- ;; wrap body appropriately for the type of evaluation and results
+ ;; Wrap body appropriately for the type of evaluation and results.
(wrapped-body
(cond
((or (member "code" result-params)
(format "(print (out \"/dev/null\" %s))" full-body))
((member "value" result-params)
(format "(out \"/dev/null\" %s)" full-body))
- (t full-body))))
-
- ((lambda (result)
- (org-babel-result-cond result-params
- result
- (read result)))
- (if (not (string= session-name "none"))
- ;; session based evaluation
- (mapconcat ;; <- joins the list back together into a single string
- #'identity
- (butlast ;; <- remove the org-babel-picolisp-eoe line
- (delq nil
- (mapcar
- (lambda (line)
- (org-babel-chomp ;; remove trailing newlines
- (when (> (length line) 0) ;; remove empty lines
- (cond
- ;; remove leading "-> " from return values
- ((and (>= (length line) 3)
- (string= "-> " (substring line 0 3)))
- (substring line 3))
- ;; remove trailing "-> <<return-value>>" on the
- ;; last line of output
- ((and (member "output" result-params)
- (string-match-p "->" line))
- (substring line 0 (string-match "->" line)))
- (t line)
- )
- ;; (if (and (>= (length line) 3) ;; remove leading "<- "
- ;; (string= "-> " (substring line 0 3)))
- ;; (substring line 3)
- ;; line)
- )))
- ;; returns a list of the output of each evaluated expression
- (org-babel-comint-with-output (session org-babel-picolisp-eoe)
- (insert wrapped-body) (comint-send-input)
- (insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
- "\n")
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "picolisp-script-")))
- (with-temp-file script-file
- (insert (concat wrapped-body "(bye)")))
- (org-babel-eval
- (format "%s %s"
- org-babel-picolisp-cmd
- (org-babel-process-file-name script-file))
- ""))))))
+ (t full-body)))
+ (result
+ (if (not (string= session-name "none"))
+ ;; Session based evaluation.
+ (mapconcat ;; <- joins the list back into a single string
+ #'identity
+ (butlast ;; <- remove the org-babel-picolisp-eoe line
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (org-babel-chomp ;; Remove trailing newlines.
+ (when (> (length line) 0) ;; Remove empty lines.
+ (cond
+ ;; Remove leading "-> " from return values.
+ ((and (>= (length line) 3)
+ (string= "-> " (substring line 0 3)))
+ (substring line 3))
+ ;; Remove trailing "-> <<return-value>>" on the
+ ;; last line of output.
+ ((and (member "output" result-params)
+ (string-match-p "->" line))
+ (substring line 0 (string-match "->" line)))
+ (t line)
+ )
+ ;;(if (and (>= (length line) 3);Remove leading "<-"
+ ;; (string= "-> " (substring line 0 3)))
+ ;; (substring line 3)
+ ;; line)
+ )))
+ ;; Returns a list of the output of each evaluated exp.
+ (org-babel-comint-with-output
+ (session org-babel-picolisp-eoe)
+ (insert wrapped-body) (comint-send-input)
+ (insert "'" org-babel-picolisp-eoe)
+ (comint-send-input)))))
+ "\n")
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "picolisp-script-")))
+ (with-temp-file script-file
+ (insert (concat wrapped-body "(bye)")))
+ (org-babel-eval
+ (format "%s %s"
+ org-babel-picolisp-cmd
+ (org-babel-process-file-name script-file))
+ "")))))
+ (org-babel-result-cond result-params
+ result
+ (read result))))
(defun org-babel-picolisp-initiate-session (&optional session-name)
"If there is not a current inferior-process-buffer in SESSION
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a plantuml source block.")
-(defcustom org-plantuml-jar-path nil
+(defcustom org-plantuml-jar-path ""
"Path to the plantuml.jar file."
:group 'org-babel
:version "24.1"
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assoc :java params)) ""))
- (cmd (if (not org-plantuml-jar-path)
+ (cmd (if (string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
(concat "java " java " -jar "
(shell-quote-argument
;;; ob-python.el --- org-babel functions for python evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
(declare-function org-remove-indentation "org" )
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
-(declare-function run-python "ext:python" (&optional cmd noshow new))
+(declare-function run-python "ext:python" (cmd &optional dedicated show))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
- :type 'function)
+ :type 'symbol)
(defvar org-src-preserve-indentation)
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type 'symbol)
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
- var))))
+ (if (stringp var) (substring-no-properties var) var)))))
(defun org-babel-python-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- ((lambda (res)
- (if (listp res)
- (mapcar (lambda (el) (if (equal el 'None)
- org-babel-python-None-to el))
- res)
- res))
- (org-babel-script-escape results)))
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'None)
+ org-babel-python-None-to el))
+ res)
+ res)))
(defvar org-babel-python-buffers '((:default . "*Python*")))
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-python-buffers)))
-(defun org-babel-python-with-earmufs (session)
+(defun org-babel-python-with-earmuffs (session)
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
name
(format "*%s*" name))))
-(defun org-babel-python-without-earmufs (session)
+(defun org-babel-python-without-earmuffs (session)
(let ((name (if (stringp session) session (format "%s" session))))
(if (and (string= "*" (substring name 0 1))
(string= "*" (substring name (- (length name) 1))))
name)))
(defvar py-default-interpreter)
+(defvar py-which-bufname)
+(defvar python-shell-buffer-name)
(defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session.
If there is not a current inferior-process-buffer in SESSION
(require org-babel-python-mode)
(save-window-excursion
(let* ((session (if session (intern session) :default))
- (python-buffer (org-babel-python-session-buffer session)))
+ (python-buffer (org-babel-python-session-buffer session))
+ (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ (concat org-babel-python-command " -i")
+ org-babel-python-command)))
(cond
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
- (if (version< "24.1" emacs-version)
- (progn
- (unless python-buffer
- (setq python-buffer (org-babel-python-with-earmufs session)))
- (let ((python-shell-buffer-name
- (org-babel-python-without-earmufs python-buffer)))
- (run-python
- (if (member system-type '(cygwin windows-nt ms-dos))
- (concat org-babel-python-command " -i")
- org-babel-python-command))))
- (run-python)))
+ (if (not (version< "24.1" emacs-version))
+ (run-python cmd)
+ (unless python-buffer
+ (setq python-buffer (org-babel-python-with-earmuffs session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs python-buffer)))
+ (run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname))
(py-shell)
- (setq python-buffer (org-babel-python-with-earmufs bufname))))
+ (setq python-buffer (org-babel-python-with-earmuffs bufname))))
(t
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
- ((lambda (raw)
- (org-babel-result-cond result-params
- raw
- (org-babel-python-table-or-string (org-babel-trim raw))))
- (case result-type
- (output (org-babel-eval org-babel-python-command
- (concat (if preamble (concat preamble "\n") "")
- body)))
- (value (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-eval
- org-babel-python-command
- (concat
- (if preamble (concat preamble "\n") "")
- (format
- (if (member "pp" result-params)
- org-babel-python-pp-wrapper-method
- org-babel-python-wrapper-method)
- (mapconcat
- (lambda (line) (format "\t%s" line))
- (split-string
- (org-remove-indentation
- (org-babel-trim body))
- "[\r\n]") "\n")
- (org-babel-process-file-name tmp-file 'noquote))))
- (org-babel-eval-read-file tmp-file))))))
+ (let ((raw
+ (case result-type
+ (output (org-babel-eval org-babel-python-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (value (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-eval
+ org-babel-python-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-python-pp-wrapper-method
+ org-babel-python-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-babel-trim body))
+ "[\r\n]") "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-python-table-or-string (org-babel-trim raw)))))
(defun org-babel-python-evaluate-session
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
- (org-babel-process-file-name tmp-file 'noquote)))))))
+ (org-babel-process-file-name tmp-file
+ 'noquote)))))))
(input-body (lambda (body)
(mapc (lambda (line) (insert line) (funcall send-wait))
(split-string body "[\r\n]"))
- (funcall send-wait))))
- ((lambda (results)
- (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
- (org-babel-result-cond result-params
- results
- (org-babel-python-table-or-string results))))
- (case result-type
- (output
- (mapconcat
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator t body)
- (funcall input-body body)
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait))
- 2) "\n"))
- (value
- (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator nil body)
- (let ((comint-process-echoes nil))
- (funcall input-body body)
- (funcall dump-last-value tmp-file (member "pp" result-params))
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait)))
- (org-babel-eval-read-file tmp-file)))))))
+ (funcall send-wait)))
+ (results
+ (case result-type
+ (output
+ (mapconcat
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator t body)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait))
+ 2) "\n"))
+ (value
+ (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator nil body)
+ (let ((comint-process-echoes nil))
+ (funcall input-body body)
+ (funcall dump-last-value tmp-file
+ (member "pp" result-params))
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait)))
+ (org-babel-eval-read-file tmp-file))))))
+ (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
+ (org-babel-result-cond result-params
+ results
+ (org-babel-python-table-or-string results)))))
(defun org-babel-python-read-string (string)
"Strip 's from around Python string."
;;; ob-ref.el --- org-babel functions for referencing external data
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
- (let ((out (org-babel-read ref)))
+ (let ((out (save-excursion
+ (when org-babel-current-src-block-location
+ (goto-char (if (markerp org-babel-current-src-block-location)
+ (marker-position org-babel-current-src-block-location)
+ org-babel-current-src-block-location)))
+ (org-babel-read ref))))
(if (equal out ref)
(if (string-match "^\".*\"$" ref)
(read ref)
;;; ob-ruby.el --- org-babel functions for ruby evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
+(defcustom org-babel-ruby-hline-to "nil"
+ "Replace hlines in incoming tables with this when translating to ruby."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-ruby-nil-to 'hline
+ "Replace 'nil' in ruby tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'symbol)
+
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
- (format "%S" var)))
+ (if (equal var 'hline)
+ org-babel-ruby-hline-to
+ (format "%S" var))))
(defun org-babel-ruby-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'nil)
+ org-babel-ruby-nil-to el))
+ res)
+ res)))
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body (org-babel-process-file-name tmp-file 'noquote)))
- ((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)))))
+ (let ((raw (org-babel-eval-read-file tmp-file)))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ raw
+ (org-babel-ruby-table-or-string raw))))))
;; comint session evaluation
(case result-type
(output
;;; ob-sass.el --- org-babel functions for the sass css generation language
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; ob-scala.el --- org-babel functions for Scala evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
- ((lambda (raw)
- (org-babel-result-cond result-params
- raw
- (org-babel-scala-table-or-string raw)))
- (org-babel-eval
- (concat org-babel-scala-command " " src-file) ""))))))
+ (let ((raw (org-babel-eval
+ (concat org-babel-scala-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-scala-table-or-string raw)))))))
(defun org-babel-prep-session:scala (session params)
;;; ob-scheme.el --- org-babel functions for Scheme
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
+;; Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
;; - a working scheme implementation
;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
;;
-;; - for session based evaluation cmuscheme.el is required which is
-;; included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;; ELPA.
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
+(require 'geiser nil t)
+(defvar geiser-repl--repl) ; Defined in geiser-repl.el
+(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
+(defvar geiser-default-implementation) ; Defined in geiser-impl.el
+(defvar geiser-active-implementations) ; Defined in geiser-impl.el
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(declare-function run-geiser "geiser-repl" (impl))
+(declare-function geiser-mode "geiser-mode" ())
+(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg))
+(declare-function geiser-repl-exit "geiser-repl" (&optional arg))
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
- "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
- "Name of command used to evaluate scheme blocks."
- :group 'org-babel
- :version "24.1"
- :type 'string)
-
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
")\n" body ")")
body)))
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+ "Remove dead buffers from the REPL map."
+ (maphash
+ (lambda (x y)
+ (when (not (buffer-name y))
+ (remhash x org-babel-scheme-repl-map)))
+ org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+ "Look up the scheme buffer for a session; return nil if it doesn't exist."
+ (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+ (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+ "Record the scheme buffer used for a given session."
+ (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+ "Returns the scheme implementation geiser associates with the buffer."
+ (with-current-buffer (set-buffer buffer)
+ geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+ "Switch to a scheme REPL, creating it if it doesn't exist:"
+ (let ((buffer (org-babel-scheme-get-session-buffer name)))
+ (or buffer
+ (progn
+ (run-geiser impl)
+ (if name
+ (progn
+ (rename-buffer name t)
+ (org-babel-scheme-set-session-buffer name (current-buffer))))
+ (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+ "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+ (let ((result
+ (cond ((not name)
+ (concat buffer " " (symbol-name impl) " REPL"))
+ ((string= name "none") nil)
+ (name))))
+ result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+ "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+ (let ((result nil))
+ (with-temp-buffer
+ (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+ (newline)
+ (insert (if output
+ (format "(with-output-to-string (lambda () %s))" code)
+ code))
+ (geiser-mode)
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (current-buffer))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (geiser-eval-region (point-min) (point-max))
+ (setq result
+ (if (equal (substring (current-message) 0 3) "=> ")
+ (replace-regexp-in-string "^=> " "" (current-message))
+ "\"An error occurred.\""))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer))
+ (setq result (if (or (string= result "#<void>")
+ (string= result "#<unspecified>"))
+ nil
+ (read result)))))
+ result))
+
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (let* ((result-type (cdr (assoc :result-type params)))
- (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
- org-babel-scheme-cmd))
- (full-body (org-babel-expand-body:scheme body params))
- (result (if (not (string= (cdr (assoc :session params)) "none"))
- ;; session evaluation
- (let ((session (org-babel-prep-session:scheme
- (cdr (assoc :session params)) params)))
- (org-babel-comint-with-output
- (session (format "%S" org-babel-scheme-eoe) t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line))
- (comint-send-input nil t))
- (list body (format "%S" org-babel-scheme-eoe)))))
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "scheme-script-")))
- (with-temp-file script-file
- (insert
- ;; return the value or the output
- (if (string= result-type "value")
- (format "(display %s)" full-body)
- full-body)))
- (org-babel-eval
- (format "%s %s" org-babel-scheme-cmd
- (org-babel-process-file-name script-file)) "")))))
- (org-babel-result-cond (cdr (assoc :result-params params))
- result (read result))))
-
-(defun org-babel-prep-session:scheme (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (org-babel-scheme-initiate-session session))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (var-lines
- (mapcar
- (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
- vars)))
- (when session
- (org-babel-comint-in-buffer session
- (sit-for .5) (goto-char (point-max))
- (mapc (lambda (var)
- (insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines)))
- session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session."
- (require 'cmuscheme)
- (unless (string= session "none")
- (let ((session-buffer (save-window-excursion
- (run-scheme org-babel-scheme-cmd)
- (rename-buffer session)
- (current-buffer))))
- (if (org-babel-comint-buffer-livep session-buffer)
- (progn (sit-for .25) session-buffer)
- (sit-for .5)
- (org-babel-scheme-initiate-session session)))))
+ (let* ((source-buffer (current-buffer))
+ (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+ "^ ?\\*\\([^*]+\\)\\*" "\\1"
+ (buffer-name source-buffer))))
+ (save-excursion
+ (org-babel-reassemble-table
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (impl (or (when (cdr (assoc :scheme params))
+ (intern (cdr (assoc :scheme params))))
+ geiser-default-implementation
+ (car geiser-active-implementations)))
+ (session (org-babel-scheme-make-session-name
+ source-buffer-name (cdr (assoc :session params)) impl))
+ (full-body (org-babel-expand-body:scheme body params)))
+ (org-babel-scheme-execute-with-geiser
+ full-body ; code
+ (string= result-type "output") ; output?
+ impl ; implementation
+ (and (not (string= session "none")) session))) ; session
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params)))))))
(provide 'ob-scheme)
-
-
;;; ob-scheme.el ends here
;;; ob-screen.el --- org-babel support for interactive terminal
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
;;; ob-sh.el --- org-babel functions for shell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
- (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
- (org-babel-ref-resolve stdin))))
- (cdr (assoc :stdin params))))
+ (stdin (let ((stdin (cdr (assoc :stdin params))))
+ (when stdin (org-babel-sh-var-to-string
+ (org-babel-ref-resolve stdin)))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
"Convert an elisp value to a string."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
- ((and (listp var) (listp (car var)))
+ ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat echo-var var "\n"))
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY."
- ((lambda (results)
- (when results
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- results
- (let ((tmp-file (org-babel-temp-file "sh-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file))))))
- (cond
- (stdin ; external shell script w/STDIN
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (stdin-file (org-babel-temp-file "sh-stdin-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (with-temp-file stdin-file (insert stdin))
- (with-temp-buffer
- (call-process-shell-command
- (if shebang
- script-file
- (format "%s %s" org-babel-sh-command script-file))
- stdin-file
- (current-buffer))
- (buffer-string))))
- (session ; session evaluation
- (mapconcat
- #'org-babel-sh-strip-weird-long-prompt
- (mapcar
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-sh-eoe-output t body)
- (mapc
- (lambda (line)
- (insert line)
- (comint-send-input nil t)
- (while (save-excursion
- (goto-char comint-last-input-end)
- (not (re-search-forward
- comint-prompt-regexp nil t)))
- (accept-process-output (get-buffer-process (current-buffer)))))
- (append
- (split-string (org-babel-trim body) "\n")
- (list org-babel-sh-eoe-indicator))))
- 2)) "\n"))
- ('otherwise ; external shell script
- (if (and (cdr (assoc :shebang params))
- (> (length (cdr (assoc :shebang params))) 0))
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (org-babel-eval script-file ""))
- (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+ (let ((results
+ (cond
+ (stdin ; external shell script w/STDIN
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (with-temp-file stdin-file (insert stdin))
+ (with-temp-buffer
+ (call-process-shell-command
+ (if shebang
+ script-file
+ (format "%s %s" org-babel-sh-command script-file))
+ stdin-file
+ (current-buffer))
+ (buffer-string))))
+ (session ; session evaluation
+ (mapconcat
+ #'org-babel-sh-strip-weird-long-prompt
+ (mapcar
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-sh-eoe-output t body)
+ (mapc
+ (lambda (line)
+ (insert line)
+ (comint-send-input nil t)
+ (while (save-excursion
+ (goto-char comint-last-input-end)
+ (not (re-search-forward
+ comint-prompt-regexp nil t)))
+ (accept-process-output
+ (get-buffer-process (current-buffer)))))
+ (append
+ (split-string (org-babel-trim body) "\n")
+ (list org-babel-sh-eoe-indicator))))
+ 2)) "\n"))
+ ('otherwise ; external shell script
+ (if (and (cdr (assoc :shebang params))
+ (> (length (cdr (assoc :shebang params))) 0))
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (equal "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (org-babel-eval script-file ""))
+ (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+ (when results
+ (let ((result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."
;;; ob-shen.el --- org-babel functions for Shen
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, shen
(require 'ob)
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
(defvar org-babel-default-header-args:shen '()
"Default header arguments for shen code blocks.")
(let* ((result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
- ((lambda (results)
- (org-babel-result-cond result-params
- results
- (condition-case nil (org-babel-script-escape results)
- (error results))))
- (with-temp-buffer
- (insert full-body)
- (call-interactively #'shen-eval-defun)))))
+ (let ((results
+ (with-temp-buffer
+ (insert full-body)
+ (call-interactively #'shen-eval-defun))))
+ (org-babel-result-cond result-params
+ results
+ (condition-case nil (org-babel-script-escape results)
+ (error results))))))
(provide 'ob-shen)
;;; ob-shen.el ends here
;;; ob-sql.el --- org-babel functions for sql evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(lambda (pair)
(setq body
(replace-regexp-in-string
- (format "\$%s" (car pair))
- ((lambda (val)
- (if (listp val)
- ((lambda (data-file)
- (with-temp-file data-file
- (insert (orgtbl-to-csv
- val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
- data-file)
- (org-babel-temp-file "sql-data-"))
- (if (stringp val) val (format "%S" val))))
- (cdr pair))
+ (format "\$%s" (car pair)) ;FIXME: "\$" == "$"!
+ (let ((val (cdr pair)))
+ (if (listp val)
+ (let ((data-file (org-babel-temp-file "sql-data-")))
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (if (stringp val) val (format "%S" val))))
body)))
vars)
body)
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(defun org-babel-sqlite-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
+ ;; FIXME: Redundancy with org-babel-sql-expand-vars!
(mapc
(lambda (pair)
(setq body
(replace-regexp-in-string
- (format "\$%s" (car pair))
- ((lambda (val)
- (if (listp val)
- ((lambda (data-file)
- (with-temp-file data-file
- (insert (orgtbl-to-csv
- val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
- data-file)
- (org-babel-temp-file "sqlite-data-"))
- (if (stringp val) val (format "%S" val))))
- (cdr pair))
+ (format "\$%s" (car pair)) ;FIXME: "\$" == "$"!
+ (let ((val (cdr pair)))
+ (if (listp val)
+ (let ((data-file (org-babel-temp-file "sqlite-data-")))
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (if (stringp val) val (format "%S" val))))
body)))
vars)
body)
;;; ob-table.el --- support for calling org-babel functions from tables
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;;; Commentary:
;; Should allow calling functions from org-mode tables using the
-;; function `sbe' as so...
+;; function `org-sbe' as so...
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
;; | 7 | |
;; | 8 | |
;; | 9 | |
-;; #+TBLFM: $2='(sbe 'fibbd (n $1))
+;; #+TBLFM: $2='(org-sbe 'fibbd (n $1))
;;; Code:
(require 'ob-core)
(concat (substring string 0 (match-beginning 0))
(if (match-string 1 string) "...")) string))
-(defmacro sbe (source-block &rest variables)
+(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
Each element of VARIABLES should be a two
element list, whose first element is the name of the variable and
second element is a string of its value. The following call to
-`sbe' would be equivalent to the following source code block.
+`org-sbe' would be equivalent to the following source code block.
- (sbe 'source-block (n $2) (m 3))
+ (org-sbe 'source-block (n $2) (m 3))
#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
results
as shown in the example below.
| 1 | 2 | :file nothing.png | nothing.png |
-#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
+#+TBLFM: @1$4='(org-sbe test-sbe $3 (x $1) (y $2))"
+ (declare (debug (form form)))
(let* ((header-args (if (stringp (car variables)) (car variables) ""))
(variables (if (stringp (car variables)) (cdr variables) variables)))
(let* (quote
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
- (prog1 (if quote
- (format "\"%s\"" el)
- (org-no-properties el))
+ (prog1
+ (cond
+ (quote (format "\"%s\"" el))
+ ((stringp el) (org-no-properties el))
+ (t el))
(setq quote nil))))
(cdr var)))))
variables)))
(unless (stringp source-block)
(setq source-block (symbol-name source-block)))
- ((lambda (result)
- (org-babel-trim (if (stringp result) result (format "%S" result))))
- (if (and source-block (> (length source-block) 0))
- (let ((params
- (eval `(org-babel-parse-header-arguments
- (concat
- ":var results="
- ,source-block
- "[" ,header-args "]"
- "("
- (mapconcat
- (lambda (var-spec)
- (if (> (length (cdr var-spec)) 1)
- (format "%S='%S"
- (car var-spec)
- (mapcar #'read (cdr var-spec)))
- (format "%S=%s"
- (car var-spec) (cadr var-spec))))
- ',variables ", ")
- ")")))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params)
- '((:results . "silent"))))
- "")))))
-(def-edebug-spec sbe (form form))
+ (let ((result
+ (if (and source-block (> (length source-block) 0))
+ (let ((params
+ ;; FIXME: Why `eval'?!?!?
+ (eval `(org-babel-parse-header-arguments
+ (concat
+ ":var results="
+ ,source-block
+ "[" ,header-args "]"
+ "("
+ (mapconcat
+ (lambda (var-spec)
+ (if (> (length (cdr var-spec)) 1)
+ (format "%S='%S"
+ (car var-spec)
+ (mapcar #'read (cdr var-spec)))
+ (format "%S=%s"
+ (car var-spec) (cadr var-spec))))
+ ',variables ", ")
+ ")")))))
+ (org-babel-execute-src-block
+ nil (list "emacs-lisp" "results" params)
+ '((:results . "silent"))))
+ "")))
+ (org-babel-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)
;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
(eval-when-compile
(require 'cl))
+(declare-function org-edit-special "org" (&optional arg))
(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-store-link "org" (arg))
+(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-heading-components "org" ())
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
- (find-file-noselect file)
+ (find-file-noselect file 'nowarn)
(with-current-buffer (get-file-buffer file)
(revert-buffer t t t)))
Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks. Optional argument LANG can be
-used to limit the exported source code blocks by language."
+used to limit the exported source code blocks by language.
+Return a list whose CAR is the tangled file name."
(interactive "fFile to tangle: \nP")
(let ((visited-p (get-file-buffer (expand-file-name file)))
to-be-removed)
- (save-window-excursion
- (find-file file)
- (setq to-be-removed (current-buffer))
- (org-babel-tangle nil target-file lang))
- (unless visited-p
- (kill-buffer to-be-removed))))
+ (prog1
+ (save-window-excursion
+ (find-file file)
+ (setq to-be-removed (current-buffer))
+ (org-babel-tangle nil target-file lang))
+ (unless visited-p
+ (kill-buffer to-be-removed)))))
(defun org-babel-tangle-publish (_ filename pub-dir)
"Tangle FILENAME and place the results in PUB-DIR."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
(lambda (spec)
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
(let* ((tangle (funcall get-spec :tangle))
- (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
- (funcall get-spec :shebang)))
+ (she-bang (let ((sheb (funcall get-spec :shebang)))
+ (when (> (length sheb) 0) sheb)))
+ (tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
- ;; possibly create the parent directories for file
- (when ((lambda (m) (and m (not (string= m "no"))))
- (funcall get-spec :mkdirp))
+ ;; Possibly create the parent directories for file.
+ (when (let ((m (funcall get-spec :mkdirp)))
+ (and m (not (string= m "no"))))
(make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file
(when (and (file-exists-p file-name)
- (not (member file-name path-collector)))
+ (not (member file-name (mapcar #'car path-collector))))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
- (when she-bang (set-file-modes file-name #o755))
+ (when she-bang
+ (unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
+ (add-to-list 'path-collector
+ (cons file-name tangle-mode)
+ nil
+ (lambda (a b) (equal (car a) (car b))))))))
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
- (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ (buffer-file-name
+ (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
- path-collector))
- path-collector))))
+ (mapcar #'car path-collector)))
+ ;; set permissions on tangled files
+ (mapc (lambda (pair)
+ (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
+ path-collector)
+ (mapcar #'car path-collector)))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
(string= comments "yes") (string= comments "noweb")))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
+ (let ((le (eval el)))
+ (if (stringp le) le (format "%S" le)))))
'(start-line file link source-name)))
(insert-comment (lambda (text)
(when (and comments (not (string= comments "no"))
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
(match-string 1 extra))
org-coderef-label-format))
- (link ((lambda (link)
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link)))
- (org-no-properties
- (org-store-link nil))))
+ (link (let ((link (org-no-properties
+ (org-store-link nil))))
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link))))
(source-name
(intern (or (nth 4 info)
(format "%s:%d"
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
- ((lambda (body) ;; Run the tangle-body-hook
- (with-temp-buffer
- (insert body)
- (when (string-match "-r" extra)
- (goto-char (point-min))
- (while (re-search-forward
- (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
- (replace-match "")))
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string)))
- ((lambda (body) ;; Expand the body in language specific manner
- (if (assoc :no-expand params)
- body
- (if (fboundp expand-cmd)
- (funcall expand-cmd body params)
- (org-babel-expand-body:generic
- body params
- (and (fboundp assignments-cmd)
- (funcall assignments-cmd params))))))
- (if (org-babel-noweb-p params :tangle)
- (org-babel-expand-noweb-references info)
- (nth 1 info)))))
+ ;; Run the tangle-body-hook.
+ (let* ((body ;; Expand the body in language specific manner.
+ (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))
+ (body
+ (if (assoc :no-expand params)
+ body
+ (if (fboundp expand-cmd)
+ (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params
+ (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params)))))))
+ (with-temp-buffer
+ (insert body)
+ (when (string-match "-r" extra)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+ (replace-match "")))
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string))))
(comment
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
+ (let ((le (eval el)))
+ (if (stringp le) le (format "%S" le)))))
'(start-line file link source-name))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
"Jump from a tangled code file to the related Org-mode file."
(interactive)
(let ((mid (point))
- start end done
+ start body-start end done
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
(and (setq start (point-at-eol))
+ (setq body-start (save-excursion
+ (forward-line 2) (point-at-bol)))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
(org-babel-next-src-block
(string-to-number (match-string 1 block-name)))
(org-babel-goto-named-src-block block-name))
+ ;; position at the beginning of the code block body
+ (goto-char (org-babel-where-is-src-block-head))
+ (forward-line 1)
+ ;; Use org-edit-special to isolate the code.
+ (org-edit-special)
+ ;; Then move forward the correct number of characters in the
+ ;; code buffer.
+ (forward-char (- mid body-start))
+ ;; And return to the Org-mode buffer with the point in the right
+ ;; place.
+ (org-edit-src-exit)
(setq target-char (point)))
- (pop-to-buffer target-buffer)
+ (org-src-switch-to-buffer target-buffer t)
(prog1 body (goto-char target-char))))
(provide 'ob-tangle)
;;; ob.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Keywords: literate programming, reproducible research
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
+(require 'org-macs)
+(require 'org-compat)
(require 'ob-eval)
(require 'ob-core)
(require 'ob-comint)
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
you can \"misuse\" it to also add other text to the header."
:group 'org-agenda-export
:group 'org-export-html
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-agenda-persistent-filter nil
"When set, keep filters from one agenda view to the next."
(string))
(list :tag "Number of days in agenda"
(const org-agenda-span)
- (choice (const :tag "Day" 'day)
- (const :tag "Week" 'week)
- (const :tag "Month" 'month)
- (const :tag "Year" 'year)
+ (choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
(integer :tag "Custom")))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
(repeat :inline t :tag "Conditions for skipping"
(choice
:tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+ (list :tag "Regexp matches" :inline t (const :format "" regexp) (regexp))
+ (list :tag "Regexp does not match" :inline t (const :format "" notregexp) (regexp))
(list :tag "TODO state is" :inline t
- (const 'todo)
+ (const todo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "any not-done state" todo)
+ (const :tag "any done state" done)
+ (const :tag "any state" any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
(list :tag "TODO state is not" :inline t
- (const 'nottodo)
+ (const nottodo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "any not-done state" todo)
+ (const :tag "any done state" done)
+ (const :tag "any state" any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
- (const :tag "scheduled" 'scheduled)
- (const :tag "not scheduled" 'notscheduled)
- (const :tag "deadline" 'deadline)
- (const :tag "no deadline" 'notdeadline)
- (const :tag "timestamp" 'timestamp)
- (const :tag "no timestamp" 'nottimestamp))))))
+ (const :tag "scheduled" scheduled)
+ (const :tag "not scheduled" notscheduled)
+ (const :tag "deadline" deadline)
+ (const :tag "no deadline" notdeadline)
+ (const :tag "timestamp" timestamp)
+ (const :tag "no timestamp" nottimestamp))))))
(list :tag "Non-standard skipping condition"
:value (org-agenda-skip-function)
(const org-agenda-skip-function)
:group 'org-agenda)
(defgroup org-agenda-search-view nil
"Options concerning the general tags/property/todo match agenda view."
- :tag "Org Agenda Match View"
+ :tag "Org Agenda Search View"
:group 'org-agenda)
(defvar org-agenda-archives-mode nil
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-deadlines nil
- "Non-nil means ignore some deadlined TODO items when making TODO list.
+ "Non-nil means ignore some deadline TODO items when making TODO list.
There are different motivations for using different values, please think
carefully when configuring this variable.
but not scheduled today.
When set to the symbol `repeated-after-deadline', skip scheduled
-items if they are repeated beyond the current dealine."
+items if they are repeated beyond the current deadline."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type '(choice
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type '(choice (const nil)
+ (integer)))
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Day" day)
(const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
(const :tag "Month" month)
(const :tag "Year" year)
(integer :tag "Custom")))
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Don't show log items" nil)
- (const :tag "Show only log items" 'only)
- (const :tag "Show all possible log items" 'clockcheck)
+ (const :tag "Show only log items" only)
+ (const :tag "Show all possible log items" clockcheck)
(repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
- (choice (const :tag "Show closed log items" 'closed)
- (const :tag "Show clocked log items" 'clock)
- (const :tag "Show all logged state changes" 'state)))))
+ (choice (const :tag "Show closed log items" closed)
+ (const :tag "Show clocked log items" clock)
+ (const :tag "Show all logged state changes" state)))))
(defcustom org-agenda-start-with-clockreport-mode nil
"The initial value of clockreport-mode in a newly created agenda window."
:version "24.1"
:type 'boolean)
-(defcustom org-agenda-search-view-max-outline-level nil
+(defcustom org-agenda-search-view-max-outline-level 0
"Maximum outline level to display in search view.
E.g. when this is set to 1, the search view will only
-show headlines of level 1."
+show headlines of level 1. When set to 0, the default
+value, don't limit agenda view by outline level."
:group 'org-agenda-search-view
:version "24.4"
- :package-version '(Org . "8.0")
+ :package-version '(Org . "8.3")
:type 'integer)
(defgroup org-agenda-time-grid nil
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
:version "24.1"
- :type '(list
- (string :tag "Scheduled today ")
- (string :tag "Scheduled previously")))
+ :type 'string)
(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
"Text preceding deadline items in the agenda view.
:version "24.4"
:package-version '(Org . "8.0")
:type '(list
- (string :tag "Deadline today ")
- (choice :tag "Deadline relative"
- (string :tag "Format string")
- (function))))
+ (string :tag "Deadline today ")
+ (string :tag "Deadline in the future ")
+ (string :tag "Deadline in the past ")))
(defcustom org-agenda-remove-times-when-in-prefix t
"Non-nil means remove duplicate time specifications in agenda items.
:version "24.3"
:type '(choice
(const :tag "Show inherited tags when available" t)
- (const :tag "Always show inherited tags" 'always)
+ (const :tag "Always show inherited tags" always)
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
the normal rules apply."
:group 'org-agenda-line-format
:version "24.1"
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
all tags will be considered, so that this function will only ever see
the lower-case version of all tags."
:group 'org-agenda
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
;; Keep global-font-lock-mode from turning on font-lock-mode
(org-set-local 'font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
+ (setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'week)
- :keys "v w (or just w)"]
+ :keys "v w"]
+ ["Fortnight View" org-agenda-fortnight-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'fortnight)
+ :keys "v f"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
(put 'org-agenda-files 'org-restrict (list bfn))
(cond
((eq restriction 'region)
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(move-marker org-agenda-restrict-begin (region-beginning))
(move-marker org-agenda-restrict-end (region-end)))
((eq restriction 'subtree)
(save-excursion
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(org-back-to-heading t)
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
((equal org-keys "!") (customize-variable 'org-stuck-projects))
(t (user-error "Invalid agenda key"))))))
+(defvar org-agenda-multi)
+
(defun org-agenda-append-agenda ()
"Append another agenda view to the current one.
This function allows interactive building of block agendas.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
(org-eval-in-environment (org-make-parameter-alist parameters)
- (if (> (length cmd-key) 2)
- (org-tags-view nil cmd-key)
- (org-agenda nil cmd-key)))
+ (let (org-agenda-sticky)
+ (if (> (length cmd-key) 2)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(princ (buffer-string)))
(defvar org-agenda-regexp-filter-preset nil
"A preset of the regexp filter used for secondary agenda filtering.
-This must be a list of strings, each string must be a single category
+This must be a list of strings, each string must be a single regexp
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
(org-agenda-fontify-priorities))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(org-agenda-dim-blocked-tasks))
- ;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
- (when org-clock-current-task
- (save-restriction
- (widen)
- (org-agenda-mark-clocking-task)))
+ (org-agenda-mark-clocking-task)
(when org-agenda-entry-text-mode
(org-agenda-entry-text-hide)
(org-agenda-entry-text-show))
(delete-dups
(mapcar 'downcase (org-get-tags-at))))))))))
(run-hooks 'org-agenda-finalize-hook)
- (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
- (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter))
+ (when (get 'org-agenda-category-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-category-filter :preset-filter) 'category))
+ (when org-agenda-regexp-filter
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
+ (when (get 'org-agenda-regexp-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
(org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
- (org-agenda-unmark-clocking-task)
- (when (marker-buffer org-clock-hd-marker)
- (save-excursion
- (goto-char (point-min))
- (let (s ov)
- (while (setq s (next-single-property-change (point) 'org-hd-marker))
- (goto-char s)
- (when (equal (org-get-at-bol 'org-hd-marker)
- org-clock-hd-marker)
- (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
- (overlay-put ov 'type 'org-agenda-clocking)
- (overlay-put ov 'face 'org-agenda-clocking)
- (overlay-put ov 'help-echo
- "The clock is running in this item")))))))
+ ;; We need to widen when `org-agenda-finalize' is called from
+ ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
+ (when org-clock-current-task
+ (save-restriction
+ (widen)
+ (org-agenda-unmark-clocking-task)
+ (when (marker-buffer org-clock-hd-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (let (s ov)
+ (while (setq s (next-single-property-change (point) 'org-hd-marker))
+ (goto-char s)
+ (when (equal (org-get-at-bol 'org-hd-marker)
+ org-clock-hd-marker)
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
+ (overlay-put ov 'type 'org-agenda-clocking)
+ (overlay-put ov 'face 'org-agenda-clocking)
+ (overlay-put ov 'help-echo
+ "The clock is running in this item")))))))))
(defun org-agenda-unmark-clocking-task ()
"Unmark the current clocking task."
'org-priority))
(overlay-put ov 'org-type 'org-priority)))))
+(defvar org-depend-tag-blocked)
+
(defun org-agenda-dim-blocked-tasks (&optional invisible)
"Dim currently blocked TODO's in the agenda display.
When INVISIBLE is non-nil, hide currently blocked TODO instead of
e (point-at-eol)
ov (make-overlay b e))
(if invis1
- (overlay-put ov 'invisible t)
+ (progn (overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t))
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
- (when (org-called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks...done")))
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
(throw :skip t))))
(defun org-agenda-skip-eval (form)
- "If FORM is a function or a list, call (or eval) is and return result.
+ "If FORM is a function or a list, call (or eval) it and return the result.
`save-excursion' and `save-match-data' are wrapped around the call, so point
and match data are returned to the previous state no matter what these
functions do."
;;; Agenda timeline
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
+(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defun org-timeline (&optional dotodo)
"Show a time-sorted view of the entries in the current org file.
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
- (if (eq ndays 7)
+ (if (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
+ ((= n 14) 'fortnight)
(t n)))
(defun org-agenda-span-to-ndays (span &optional start-day)
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
+ ((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
(let ((case-fold-search t))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(goto-char (max (point-min) (1- (point))))
(while (re-search-forward regexp nil t)
(org-back-to-heading t)
- (while (and org-agenda-search-view-max-outline-level
+ (while (and (not (zerop org-agenda-search-view-max-outline-level))
(> (org-reduced-level (org-outline-level))
org-agenda-search-view-max-outline-level)
(forward-line -1)
beg1 (point)
end (progn
(outline-next-heading)
- (while (and org-agenda-search-view-max-outline-level
+ (while (and (not (zerop org-agenda-search-view-max-outline-level))
(> (org-reduced-level (org-outline-level))
org-agenda-search-view-max-outline-level)
(forward-line 1)
(error "Agenda file %s is not in `org-mode'" file))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(org-agenda-skip-if nil conditions))
(defun org-agenda-skip-subtree-if (&rest conditions)
- "Skip entry if any of CONDITIONS is true.
+ "Skip subtree if any of CONDITIONS is true.
See `org-agenda-skip-if' for details."
(org-agenda-skip-if t conditions))
(mapconcat 'identity re-list "\\|")
(error "No information how to identify unstuck projects")))
(org-tags-view nil matcher)
+ (setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
`(org-agenda-list-stuck-projects ,current-prefix-arg)))))
(let ((case-fold-search nil))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
(>= days n)
(<= days n))))
+;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- (&optional end)
+ (&optional end)
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
(when (or org-agenda-todo-ignore-with-date
org-agenda-todo-ignore-scheduled
(setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos 'tags tags
- 'level level
- 'type "sexp" 'warntime warntime)
+ 'org-category category 'date date 'todo-state todo-state
+ 'org-category-position category-pos 'tags tags
+ 'level level
+ 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
dayname skip-weeks)))
(make-obsolete 'org-diary-class 'org-class "")
-(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
category-pos (get-text-property (point) 'org-category-position))
(if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
'repeated-after-deadline)
+ (org-get-deadline-time (point))
(<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
(throw :skip nil))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
\"timestamp_ia\", compare within each of these type. When TYPE
is the empty string, compare all timestamps without respect of
their type."
- (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
+ (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
(ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
(get-text-property 1 'ts-date a)) def))
(tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
'help-echo "Agendas are currently limited to this subtree.")
(org-detach-overlay org-agenda-restriction-lock-overlay)
+;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
"Set restriction lock for agenda, to current subtree or file.
Restriction will be the file if TYPE is `file', or if type is the
(t 'file)))
(if (eq type 'subtree)
(progn
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(setq org-agenda-overriding-restriction 'subtree)
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (get-text-property (point) 'org-category))))
- (if (and cat (not (string= "" cat)))
- (org-agenda-filter-apply
- (setq org-agenda-category-filter
- (list (concat (if strip "-" "+") cat)))
- 'category)
- (error "No category at point")))))
+ (cond
+ ((and cat strip)
+ (org-agenda-filter-apply
+ (push (concat "-" cat) org-agenda-category-filter) 'category))
+ ((and cat)
+ (org-agenda-filter-apply
+ (setq org-agenda-category-filter
+ (list (concat "+" cat))) 'category))
+ ((error "No category at point"))))))
(defun org-find-top-headline (&optional pos)
"Find the topmost parent headline and return it."
(read-from-minibuffer
(if (equal strip '(4))
"Filter out entries matching regexp: "
- "Narrow to entries matching regexp: ")))))
+ "Narrow to entries matching regexp: ")))))
(push flt org-agenda-regexp-filter)
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
(org-agenda-filter-show-all-re)
(if notgroup
(push (cons 'and nf0) f)
(push (cons (or op 'or) nf0) f)))))
- (if (equal nfilter filter)
- (funcall ffunc f1 f filter t nil)
- (funcall ffunc nf1 nf nfilter nil nil)))))
+ (cond ((equal filter '("+"))
+ (setq f (list (list 'not 'tags))))
+ ((equal nfilter filter)
+ (funcall ffunc f1 f filter t nil))
+ (t (funcall ffunc nf1 nf nfilter nil nil))))))
;; Category filter
((eq type 'category)
(setq filter
(let* ((pos (org-get-at-bol 'org-hd-marker))
(tophl (and pos (org-find-top-headline pos))))
(if (and tophl (funcall (if negative 'identity 'not)
- (string= hl tophl)))
+ (string= hl tophl)))
(org-agenda-filter-hide-line 'category)))
(beginning-of-line 2)))
(if (get-char-property (point) 'invisible)
(defun org-agenda-filter-hide-line (type)
"Hide lines with TYPE in the agenda buffer."
- (let (ov)
- (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
- (point-at-eol)))
+ (let* ((b (max (point-min) (1- (point-at-bol))))
+ (e (point-at-eol))
+ (ov (make-overlay b e)))
(overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t)
(overlay-put ov 'type type)
(cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays))
((eq type 'category) (push ov org-agenda-cat-filter-overlays))
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd)))
+ ((eq span 'fortnight)
+ (setq sd (+ (* 14 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
- (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
+ (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(let ((a (read-char-exclusive)))
(?\ (call-interactively 'org-agenda-reset-view))
(?d (call-interactively 'org-agenda-day-view))
(?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
(?m (call-interactively 'org-agenda-month-view))
(?y (call-interactively 'org-agenda-year-view))
(?l (call-interactively 'org-agenda-log-mode))
written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'week iso-week))
+(defun org-agenda-fortnight-view (&optional iso-week)
+ "Switch to daily view for agenda.
+With argument ISO-WEEK, switch to the corresponding ISO week.
+If ISO-WEEK has more then 2 digits, only the last two encode the
+week. Any digits before this encode a year. So 200712 means
+week 12 of year 2007. Years in the range 1938-2037 can also be
+written as 2-digit years."
+ (interactive "P")
+ (org-agenda-change-time-span 'fortnight iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
With argument MONTH, switch to that month."
(defun org-agenda-change-time-span (span &optional n)
"Change the agenda view to SPAN.
-SPAN may be `day', `week', `month', `year'."
+SPAN may be `day', `week', `fortnight', `month', `year'."
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args)))
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
-SPAN may be `day', `week', `month', `year'. The return value
+SPAN may be `day', `week', `fortnight', `month', `year'. The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1))))
- ((eq span 'week)
+ ((or (eq span 'week) (eq span 'fortnight))
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
- (save-excursion
+ (save-window-excursion
(goto-char pos)
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda))
(org-get-at-bol 'org-marker)))
(buffer (and marker (marker-buffer marker)))
(prefix (buffer-substring (point-at-bol) (point-at-eol)))
- (lkall (org-offer-links-in-entry buffer marker arg prefix))
+ (lkall (and buffer (org-offer-links-in-entry
+ buffer marker arg prefix)))
(lk0 (car lkall))
(lk (if (stringp lk0) (list lk0) lk0))
(lkend (cdr lkall))
(org-back-to-heading)
(move-marker org-last-heading-marker (point))))
(beginning-of-line 1)
- (save-excursion
+ (save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
+ (when (org-bound-and-true-p org-clock-out-when-done)
+ (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
+ newhead)
+ (org-agenda-unmark-clocking-task))
(org-move-to-column col))))
(defun org-agenda-add-note (&optional arg)
(unless org-enable-priority-commands
(error "Priority commands are disabled"))
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
+ (let* ((col (current-column))
+ (marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(hdmarker (org-get-at-bol 'org-hd-marker))
(buffer (marker-buffer hdmarker))
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
+ (org-move-to-column col)))))
;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags (&optional tag onoff)
(goto-char (point-max))
(while (not (bobp))
(when (equal marker (org-get-at-bol 'org-marker))
+ (remove-text-properties (point-at-bol) (point-at-eol) '(display))
(org-move-to-column (- (window-width) (length stamp)) t)
+
(org-agenda-fix-tags-filter-overlays-at (point))
(if (featurep 'xemacs)
;; Use `duplicable' property to trigger undo recording
ex (list 'invisible t 'end-glyph gl 'duplicable t))
(insert-extent ex (1- (point)) (point-at-eol)))
(add-text-properties
- (1- (point)) (point-at-eol)
+ (1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
'face 'secondary-selection))))
(beginning-of-line 1))
;;; Dragging agenda lines forward/backward
-(defun org-agenda-drag-line-forward (arg)
- "Drag an agenda line forward by ARG lines."
+(defun org-agenda-reapply-filters ()
+ "Re-apply all agenda filters."
+ (mapcar
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ `((,org-agenda-tag-filter tag)
+ (,org-agenda-category-filter category)
+ (,org-agenda-regexp-filter regexp)
+ (,(get 'org-agenda-tag-filter :preset-filter) tag)
+ (,(get 'org-agenda-category-filter :preset-filter) category)
+ (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
+
+(defun org-agenda-drag-line-forward (arg &optional backward)
+ "Drag an agenda line forward by ARG lines.
+When the optional argument `backward' is non-nil, move backward."
(interactive "p")
- (let ((inhibit-read-only t) lst)
- (if (save-excursion
- (dotimes (n arg)
- (beginning-of-line 2)
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst))
+ (let ((inhibit-read-only t) lst line)
+ (if (or (not (get-text-property (point) 'txt))
+ (save-excursion
+ (dotimes (n arg)
+ (move-beginning-of-line (if backward 0 2))
+ (push (not (get-text-property (point) 'txt)) lst))
+ (delq nil lst)))
(message "Cannot move line forward")
- (org-drag-line-forward arg))))
+ (let ((end (save-excursion (move-beginning-of-line 2) (point))))
+ (move-beginning-of-line 1)
+ (setq line (buffer-substring (point) end))
+ (delete-region (point) end)
+ (move-beginning-of-line (funcall (if backward '1- '1+) arg))
+ (insert line)
+ (org-agenda-reapply-filters)
+ (org-agenda-mark-clocking-task)
+ (move-beginning-of-line 0)))))
(defun org-agenda-drag-line-backward (arg)
"Drag an agenda line backward by ARG lines."
(interactive "p")
- (let ((inhibit-read-only t) lst)
- (if (save-excursion
- (dotimes (n arg)
- (beginning-of-line 0)
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst))
- (message "Cannot move line backward")
- (org-drag-line-backward arg))))
+ (org-agenda-drag-line-forward arg t))
;;; Flagging notes
;;; org-archive.el --- Archiving for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
(match-string 1))
(t org-archive-location))))))
+;;;###autoload
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.
This implies visiting all these files and finding out what the
;;; org-attach.el --- Manage file attachments to org-mode tasks
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
(require 'cl))
(require 'org-id)
(require 'org)
+(require 'vc-git)
(defgroup org-attach nil
"Options concerning entry attachments in Org-mode."
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
- (let ((dir (expand-file-name org-attach-directory))
- (changes 0))
- (when (file-exists-p (expand-file-name ".git" dir))
+ (let* ((dir (expand-file-name org-attach-directory))
+ (git-dir (vc-git-root dir))
+ (changes 0))
+ (when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
(let ((have-annex
(and org-attach-git-annex-cutoff
- (file-exists-p (expand-file-name ".git/annex" dir)))))
+ (file-exists-p (expand-file-name "annex" git-dir)))))
(dolist (new-or-modified
(split-string
(shell-command-to-string
projects / emacs.git / commitdiff