mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-11 09:20:51 +00:00
Code Issues Releases Activity

Address some byte-compiler warnings.

Browse Source 
* lisp/org/ob-abc.el (org-babel-expand-body:abc): Use dolist.
(org-babel-execute:abc): Fix regexp quoting.
* lisp/org/ob-calc.el (org--var-syms): Rename from `var-syms'.
* lisp/org/ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
* lisp/org/ob-table.el (sbe): Move debug declaration.
* lisp/org/org-clock.el (org--msg-extra): Rename from `msg-extra'.
* lisp/org/org.el (org-version): Avoid var name starting with _.
(org-inhibit-startup, org-called-with-limited-levels)
(org-link-search-inhibit-query, org-time-was-given)
(org-end-time-was-given, org-def, org-defdecode, org-with-time):
* lisp/org/org-colview.el (org-agenda-overriding-columns-format):
* lisp/org/org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
(org-agenda-show-log-scoped):
* lisp/org/ob-python.el (py-which-bufname, python-shell-buffer-name):
* lisp/org/ob-haskell.el (org-export-copy-to-kill-ring):
* lisp/org/ob-exp.el (org-link-search-inhibit-query):
* lisp/org/ob-R.el (ess-eval-visibly-p):
* lisp/org/ob-core.el (org-src-window-setup): Declare before use.
(org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
* lisp/org/ox-odt.el (org-odt-hfy-face-to-css):
* lisp/org/org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
* lisp/org/org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
(org-bibtex-check):
* lisp/org/ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
(org-babel-tangle-single-block, org-babel-tangle-comment-links):
* ob-table.el (sbe):
* lisp/org/ob-sqlite.el (org-babel-sqlite-expand-vars):
* lisp/org/ob-sql.el (org-babel-sql-expand-vars):
* lisp/org/ob-shen.el (org-babel-execute:shen):
* lisp/org/ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
* lisp/org/ob-scala.el (org-babel-scala-evaluate):
* lisp/org/ob-ruby.el (org-babel-ruby-table-or-string)
(org-babel-ruby-evaluate):
* ob-python.el (org-babel-python-table-or-string)
(org-babel-python-evaluate-external-process)
(org-babel-python-evaluate-session):
* lisp/org/ob-picolisp.el (org-babel-execute:picolisp):
* lisp/org/ob-perl.el (org-babel-perl-evaluate):
* lisp/org/ob-maxima.el (org-babel-execute:maxima):
* lisp/org/ob-lisp.el (org-babel-execute:lisp):
* lisp/org/ob-java.el (org-babel-execute:java):
* lisp/org/ob-io.el (org-babel-io-evaluate):
* ob-haskell.el (org-babel-execute:haskell):
* lisp/org/ob-fortran.el (org-babel-execute:fortran):
* ob-exp.el (org-babel-exp-code):
* lisp/org/ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
* lisp/org/ob-ditaa.el (org-babel-execute:ditaa):
* ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
(org-babel-parse-header-arguments, org-babel-reassemble-table)
(org-babel-goto-src-block-head, org-babel-mark-block)
(org-babel-expand-noweb-references, org-babel-script-escape)
(org-babel-process-file-name):
* lisp/org/ob-clojure.el (org-babel-execute:clojure):
* ob-calc.el (org-babel-execute:calc):
* lisp/org/ob-awk.el (org-babel-execute:awk):
* ob-abc.el (org-babel-execute:abc):
* ob-R.el (org-babel-expand-body:R):
* lisp/org/ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
This commit is contained in:
Stefan Monnier 2013-11-12 14:11:22 -05:00
parent 32d15ad99c
commit 666ffc7e09
36 changed files with 793 additions and 723 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
lisp/org/ChangeLog
View File

@ -1,3 +1,65 @@
2013-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
Address some byte-compiler warnings.
* ob-abc.el (org-babel-expand-body:abc): Use dolist.
(org-babel-execute:abc): Fix regexp quoting.
* ob-calc.el (org--var-syms): Rename from `var-syms'.
* ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
* ob-table.el (sbe): Move debug declaration.
* org-clock.el (org--msg-extra): Rename from `msg-extra'.
* org.el (org-version): Avoid var name starting with _.
(org-inhibit-startup, org-called-with-limited-levels)
(org-link-search-inhibit-query, org-time-was-given)
(org-end-time-was-given, org-def, org-defdecode, org-with-time):
* org-colview.el (org-agenda-overriding-columns-format):
* org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
(org-agenda-show-log-scoped):
* ob-python.el (py-which-bufname, python-shell-buffer-name):
* ob-haskell.el (org-export-copy-to-kill-ring):
* ob-exp.el (org-link-search-inhibit-query):
* ob-R.el (ess-eval-visibly-p):
* ob-core.el (org-src-window-setup): Declare before use.
(org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
* ox-odt.el (org-odt-hfy-face-to-css):
* org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
* org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
(org-bibtex-check):
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
(org-babel-tangle-single-block, org-babel-tangle-comment-links):
* ob-table.el (sbe):
* ob-sqlite.el (org-babel-sqlite-expand-vars):
* ob-sql.el (org-babel-sql-expand-vars):
* ob-shen.el (org-babel-execute:shen):
* ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
* ob-scala.el (org-babel-scala-evaluate):
* ob-ruby.el (org-babel-ruby-table-or-string)
(org-babel-ruby-evaluate):
* ob-python.el (org-babel-python-table-or-string)
(org-babel-python-evaluate-external-process)
(org-babel-python-evaluate-session):
* ob-picolisp.el (org-babel-execute:picolisp):
* ob-perl.el (org-babel-perl-evaluate):
* ob-maxima.el (org-babel-execute:maxima):
* ob-lisp.el (org-babel-execute:lisp):
* ob-java.el (org-babel-execute:java):
* ob-io.el (org-babel-io-evaluate):
* ob-haskell.el (org-babel-execute:haskell):
* ob-fortran.el (org-babel-execute:fortran):
* ob-exp.el (org-babel-exp-code):
* ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
* ob-ditaa.el (org-babel-execute:ditaa):
* ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
(org-babel-parse-header-arguments, org-babel-reassemble-table)
(org-babel-goto-src-block-head, org-babel-mark-block)
(org-babel-expand-noweb-references, org-babel-script-escape)
(org-babel-process-file-name):
* ob-clojure.el (org-babel-execute:clojure):
* ob-calc.el (org-babel-execute:calc):
* ob-awk.el (org-babel-execute:awk):
* ob-abc.el (org-babel-execute:abc):
* ob-R.el (org-babel-expand-body:R):
* ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
2013-11-12 Glenn Morris <rgm@gnu.org> 2013-11-12 Glenn Morris <rgm@gnu.org>
* ox-html.el (org-html-scripts): Add 2013 to copyright years. * ox-html.el (org-html-scripts): Add 2013 to copyright years.
@ -14,7 +76,7 @@
* ob-python.el: Update the arglist passed to `declare-function' * ob-python.el: Update the arglist passed to `declare-function'
for `run-python'. for `run-python'.
* ob-tangle.el (org-babel-tangle): Use 'light argument to * ob-tangle.el (org-babel-tangle): Use `light' argument to
`org-babel-get-src-block-info'. `org-babel-get-src-block-info'.
* ob-core.el (org-babel-execute-src-block): Return nil in case of * ob-core.el (org-babel-execute-src-block): Return nil in case of
@ -5191,7 +5253,7 @@
* org-clock.el (org-clock-notify-once-if-expired): Honor * org-clock.el (org-clock-notify-once-if-expired): Honor
`org-clock-sound'. `org-clock-sound'.
2013-11-12 Rasmus Pank <rasmus.pank@gmail.com> 2013-11-12 Rasmus Pank <rasmus.pank@gmail.com>
* org.el (org-format-latex-header): Remove eucal and amsmath. * org.el (org-format-latex-header): Remove eucal and amsmath.
(org-latex-default-packages-alist): Remove amstext and add (org-latex-default-packages-alist): Remove amstext and add

29
lisp/org/ob-C.el
View File

@ -103,20 +103,21 @@ or `org-babel-execute:C++'."
(mapconcat 'identity (mapconcat 'identity
(if (listp flags) flags (list flags)) " ") (if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) "")))) (org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results) (let ((results
(org-babel-reassemble-table (org-babel-trim
(org-babel-result-cond (cdr (assoc :result-params params)) (org-babel-eval
(org-babel-read results) (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
(let ((tmp-file (org-babel-temp-file "c-"))) (org-babel-reassemble-table
(with-temp-file tmp-file (insert results)) (org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-import-elisp-from-file tmp-file))) (org-babel-read results)
(org-babel-pick-name (let ((tmp-file (org-babel-temp-file "c-")))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (with-temp-file tmp-file (insert results))
(org-babel-pick-name (org-babel-import-elisp-from-file tmp-file)))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-pick-name
(org-babel-trim (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-eval (org-babel-pick-name
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
))
(defun org-babel-C-expand (body params) (defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to "Expand a block of C or C++ code with org-babel according to

33
lisp/org/ob-R.el
View File

@ -85,21 +85,22 @@
(or graphics-file (org-babel-R-graphical-output-file params)))) (or graphics-file (org-babel-R-graphical-output-file params))))
(mapconcat (mapconcat
#'identity #'identity
((lambda (inside) (let ((inside
(if graphics-file (append
(append (when (cdr (assoc :prologue params))
(list (org-babel-R-construct-graphics-device-call (list (cdr (assoc :prologue params))))
graphics-file params)) (org-babel-variable-assignments:R params)
inside (list body)
(list "dev.off()")) (when (cdr (assoc :epilogue params))
inside)) (list (cdr (assoc :epilogue params)))))))
(append (if graphics-file
(when (cdr (assoc :prologue params)) (append
(list (cdr (assoc :prologue params)))) (list (org-babel-R-construct-graphics-device-call
(org-babel-variable-assignments:R params) graphics-file params))
(list body) inside
(when (cdr (assoc :epilogue params)) (list "dev.off()"))
(list (cdr (assoc :epilogue params)))))) "\n"))) inside))
"\n")))
(defun org-babel-execute:R (body params) (defun org-babel-execute:R (body params)
"Execute a block of R code. "Execute a block of R code.
@ -324,6 +325,8 @@ last statement in BODY, as elisp."
column-names-p))) column-names-p)))
(output (org-babel-eval org-babel-R-command body)))) (output (org-babel-eval org-babel-R-command body))))
(defvar ess-eval-visibly-p)
(defun org-babel-R-evaluate-session (defun org-babel-R-evaluate-session
(session body result-type result-params column-names-p row-names-p) (session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION. "Evaluate BODY in SESSION.

37
lisp/org/ob-abc.el
View File

@ -24,9 +24,11 @@
;;; Commentary: ;;; Commentary:
;;; This file adds support to Org Babel for music in ABC notation. ;; This file adds support to Org Babel for music in ABC notation.
;;; It requires that the abcm2ps program is installed. ;; It requires that the abcm2ps program is installed.
;;; See http://moinejf.free.fr/ ;; See http://moinejf.free.fr/
;;; Code:
(require 'ob) (require 'ob)
@ -40,18 +42,15 @@
(defun org-babel-expand-body:abc (body params) (defun org-babel-expand-body:abc (body params)
"Expand BODY according to PARAMS, return the expanded body." "Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(mapc (let ((name (symbol-name (car pair)))
(lambda (pair) (value (cdr pair)))
(let ((name (symbol-name (car pair))) (setq body
(value (cdr pair))) (replace-regexp-in-string
(setq body (concat "\$" (regexp-quote name)) ;FIXME: "\$" == "$"!
(replace-regexp-in-string (if (stringp value) value (format "%S" value))
(concat "\$" (regexp-quote name)) body))))
(if (stringp value) value (format "%S" value)) body)
body))))
vars)
body))
(defun org-babel-execute:abc (body params) (defun org-babel-execute:abc (body params)
"Execute a block of ABC code with org-babel. This function is "Execute a block of ABC code with org-babel. This function is
@ -59,10 +58,10 @@
(message "executing Abc source code block") (message "executing Abc source code block")
(let* ((result-params (split-string (or (cdr (assoc :results params))))) (let* ((result-params (split-string (or (cdr (assoc :results params)))))
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(out-file ((lambda (el) (out-file
(or el (let ((el (cdr (assoc :file params))))
(error "abc code block requires :file header argument"))) (if el (replace-regexp-in-string "\\.pdf\\'" ".ps" el)
(replace-regexp-in-string "\.pdf$" ".ps" (cdr (assoc :file params))))) (error "abc code block requires :file header argument"))))
(in-file (org-babel-temp-file "abc-")) (in-file (org-babel-temp-file "abc-"))
(render (concat "abcm2ps" " " cmdline (render (concat "abcm2ps" " " cmdline
" -O " (org-babel-process-file-name out-file) " -O " (org-babel-process-file-name out-file)

33
lisp/org/ob-awk.el
View File

@ -59,34 +59,33 @@ called by `org-babel-execute-src-block'"
(cmd-line (cdr (assoc :cmd-line params))) (cmd-line (cdr (assoc :cmd-line params)))
(in-file (cdr (assoc :in-file params))) (in-file (cdr (assoc :in-file params)))
(full-body (org-babel-expand-body:awk body params)) (full-body (org-babel-expand-body:awk body params))
(code-file ((lambda (file) (with-temp-file file (insert full-body)) file) (code-file (let ((file (org-babel-temp-file "awk-")))
(org-babel-temp-file "awk-"))) (with-temp-file file (insert full-body)) file))
(stdin ((lambda (stdin) (stdin (let ((stdin (cdr (assoc :stdin params))))
(when stdin (when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-")) (let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin))) (res (org-babel-ref-resolve stdin)))
(with-temp-file tmp (with-temp-file tmp
(insert (org-babel-awk-var-to-awk res))) (insert (org-babel-awk-var-to-awk res)))
tmp))) tmp))))
(cdr (assoc :stdin params))))
(cmd (mapconcat #'identity (remove nil (list org-babel-awk-command (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
"-f" code-file "-f" code-file
cmd-line cmd-line
in-file)) in-file))
" "))) " ")))
(org-babel-reassemble-table (org-babel-reassemble-table
((lambda (results) (let ((results
(when results (cond
(org-babel-result-cond result-params (stdin (with-temp-buffer
results (call-process-shell-command cmd stdin (current-buffer))
(let ((tmp (org-babel-temp-file "awk-results-"))) (buffer-string)))
(with-temp-file tmp (insert results)) (t (org-babel-eval cmd "")))))
(org-babel-import-elisp-from-file tmp))))) (when results
(cond (org-babel-result-cond result-params
(stdin (with-temp-buffer results
(call-process-shell-command cmd stdin (current-buffer)) (let ((tmp (org-babel-temp-file "awk-results-")))
(buffer-string))) (with-temp-file tmp (insert results))
(t (org-babel-eval cmd "")))) (org-babel-import-elisp-from-file tmp)))))
(org-babel-pick-name (org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name (org-babel-pick-name

43
lisp/org/ob-calc.el
View File

@ -42,13 +42,15 @@
(defun org-babel-expand-body:calc (body params) (defun org-babel-expand-body:calc (body params)
"Expand BODY according to PARAMS, return the expanded body." body) "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) (defun org-babel-execute:calc (body params)
"Execute a block of calc code with Babel." "Execute a block of calc code with Babel."
(unless (get-buffer "*Calculator*") (unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit))) (save-window-excursion (calc) (calc-quit)))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(var-syms (mapcar #'car vars)) (org--var-syms (mapcar #'car vars))
(var-names (mapcar #'symbol-name var-syms))) (var-names (mapcar #'symbol-name org--var-syms)))
(mapc (mapc
(lambda (pair) (lambda (pair)
(calc-push-list (list (cdr pair))) (calc-push-list (list (cdr pair)))
@ -66,33 +68,32 @@
;; complex expression ;; complex expression
(t (t
(calc-push-list (calc-push-list
(list ((lambda (res) (list (let ((res (calc-eval line)))
(cond (cond
((numberp res) res) ((numberp res) res)
((math-read-number res) (math-read-number res)) ((math-read-number res) (math-read-number res))
((listp res) (error "Calc error \"%s\" on input \"%s\"" ((listp res) (error "Calc error \"%s\" on input \"%s\""
(cadr res) line)) (cadr res) line))
(t (replace-regexp-in-string (t (replace-regexp-in-string
"'" "" "'" ""
(calc-eval (calc-eval
(math-evaluate-expr (math-evaluate-expr
;; resolve user variables, calc built in ;; resolve user variables, calc built in
;; variables are handled automatically ;; variables are handled automatically
;; upstream by calc ;; upstream by calc
(mapcar #'org-babel-calc-maybe-resolve-var (mapcar #'org-babel-calc-maybe-resolve-var
;; parse line into calc objects ;; parse line into calc objects
(car (math-read-exprs line))))))))) (car (math-read-exprs line)))))))))
(calc-eval line)))))))) ))))))
(mapcar #'org-babel-trim (mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion (save-excursion
(with-current-buffer (get-buffer "*Calculator*") (with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1))))) (calc-eval (calc-top 1)))))
(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun org-babel-calc-maybe-resolve-var (el) (defun org-babel-calc-maybe-resolve-var (el)
(if (consp 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 (progn
(calc-recall (cadr el)) (calc-recall (cadr el))
(prog1 (calc-top 1) (prog1 (calc-top 1)

34
lisp/org/ob-clojure.el
View File

@ -24,17 +24,17 @@
;;; Commentary: ;;; Commentary:
;;; support for evaluating clojure code, relies on slime for all eval ;; Support for evaluating clojure code, relies on slime for all eval.
;;; Requirements: ;;; Requirements:
;;; - clojure (at least 1.2.0) ;; - clojure (at least 1.2.0)
;;; - clojure-mode ;; - clojure-mode
;;; - slime ;; - slime
;;; By far, the best way to install these components is by following ;; By far, the best way to install these components is by following
;;; the directions as set out by Phil Hagelberg (Technomancy) on the ;; the directions as set out by Phil Hagelberg (Technomancy) on the
;;; web page: http://technomancy.us/126 ;; web page: http://technomancy.us/126
;;; Code: ;;; Code:
(require 'ob) (require 'ob)
@ -77,16 +77,16 @@
(require 'slime) (require 'slime)
(with-temp-buffer (with-temp-buffer
(insert (org-babel-expand-body:clojure body params)) (insert (org-babel-expand-body:clojure body params))
((lambda (result) (let ((result
(let ((result-params (cdr (assoc :result-params params)))) (slime-eval
(org-babel-result-cond result-params `(swank:eval-and-grab-output
result ,(buffer-substring-no-properties (point-min) (point-max)))
(condition-case nil (org-babel-script-escape result) (cdr (assoc :package params)))))
(error result))))) (let ((result-params (cdr (assoc :result-params params))))
(slime-eval (org-babel-result-cond result-params
`(swank:eval-and-grab-output result
,(buffer-substring-no-properties (point-min) (point-max))) (condition-case nil (org-babel-script-escape result)
(cdr (assoc :package params)))))) (error result)))))))
(provide 'ob-clojure) (provide 'ob-clojure)

300
lisp/org/ob-core.el
View File

@ -632,15 +632,14 @@ block."
(message "result silenced") (message "result silenced")
(setq result nil)) (setq result nil))
(setq result (setq result
((lambda (result) (let ((result (funcall cmd body params)))
(if (and (eq (cdr (assoc :result-type params)) (if (and (eq (cdr (assoc :result-type params))
'value) 'value)
(or (member "vector" result-params) (or (member "vector" result-params)
(member "table" result-params)) (member "table" result-params))
(not (listp result))) (not (listp result)))
(list (list result)) result)) (list (list result)) result)))
(funcall cmd body params))) ;; If non-empty result and :file then write to :file.
;; if non-empty result and :file then write to :file
(when (cdr (assoc :file params)) (when (cdr (assoc :file params))
(when result (when result
(with-temp-file (cdr (assoc :file params)) (with-temp-file (cdr (assoc :file params))
@ -648,7 +647,7 @@ block."
(org-babel-format-result (org-babel-format-result
result (cdr (assoc :sep (nth 2 info))))))) result (cdr (assoc :sep (nth 2 info)))))))
(setq result (cdr (assoc :file params)))) (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)) (when (cdr (assoc :post params))
(let ((*this* (if (cdr (assoc :file params)) (let ((*this* (if (cdr (assoc :file params))
(org-babel-result-to-file (org-babel-result-to-file
@ -893,6 +892,8 @@ with a prefix argument then this is passed on to
(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
(defvar org-src-window-setup)
;;;###autoload ;;;###autoload
(defun org-babel-switch-to-session-with-code (&optional arg info) (defun org-babel-switch-to-session-with-code (&optional arg info)
"Switch to code buffer and display session." "Switch to code buffer and display session."
@ -1157,18 +1158,18 @@ the current subtree."
(mapconcat #'identity (sort (funcall rm (split-string v)) (mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " ")) #'string<) " "))
(t v))))))) (t v)))))))
((lambda (hash) (let* ((it (format "%s-%s"
(when (org-called-interactively-p 'interactive) (message hash)) hash) (mapconcat
(let ((it (format "%s-%s" #'identity
(mapconcat (delq nil (mapcar (lambda (arg)
#'identity (let ((normalized (funcall norm arg)))
(delq nil (mapcar (lambda (arg) (when normalized
(let ((normalized (funcall norm arg))) (format "%S" normalized))))
(when normalized (nth 2 info))) ":")
(format "%S" normalized)))) (nth 1 info)))
(nth 2 info))) ":") (hash (sha1 it)))
(nth 1 info)))) (when (org-called-interactively-p 'interactive) (message hash))
(sha1 it)))))) hash))))
(defun org-babel-current-result-hash () (defun org-babel-current-result-hash ()
"Return the current in-buffer hash." "Return the current in-buffer hash."
@ -1453,9 +1454,8 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
(cons (intern (match-string 1 arg)) (cons (intern (match-string 1 arg))
(org-babel-read (org-babel-chomp (match-string 2 arg)))) (org-babel-read (org-babel-chomp (match-string 2 arg))))
(cons (intern (org-babel-chomp arg)) nil))) (cons (intern (org-babel-chomp arg)) nil)))
((lambda (raw) (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58))))
(cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))) (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
(org-babel-balanced-split arg-string '((32 9) . 58))))))))
(defun org-babel-parse-multiple-vars (header-arguments) (defun org-babel-parse-multiple-vars (header-arguments)
"Expand multiple variable assignments behind a single :var keyword. "Expand multiple variable assignments behind a single :var keyword.
@ -1598,12 +1598,11 @@ of the vars, cnames and rnames."
Given a TABLE and set of COLNAMES and ROWNAMES add the names Given a TABLE and set of COLNAMES and ROWNAMES add the names
to the table for reinsertion to org-mode." to the table for reinsertion to org-mode."
(if (listp table) (if (listp table)
((lambda (table) (let ((table (if (and rownames (= (length table) (length rownames)))
(if (and colnames (listp (car table)) (= (length (car table)) (org-babel-put-rownames table rownames) table)))
(length colnames))) (if (and colnames (listp (car table)) (= (length (car table))
(org-babel-put-colnames table colnames) table)) (length colnames)))
(if (and rownames (= (length table) (length rownames))) (org-babel-put-colnames table colnames) table))
(org-babel-put-rownames table rownames) table))
table)) table))
(defun org-babel-where-is-src-block-head () (defun org-babel-where-is-src-block-head ()
@ -1640,9 +1639,8 @@ If the point is not on a source block then return nil."
(defun org-babel-goto-src-block-head () (defun org-babel-goto-src-block-head ()
"Go to the beginning of the current code block." "Go to the beginning of the current code block."
(interactive) (interactive)
((lambda (head) (let ((head (org-babel-where-is-src-block-head)))
(if head (goto-char head) (error "Not currently in a code block"))) (if head (goto-char head) (error "Not currently in a code block"))))
(org-babel-where-is-src-block-head)))
;;;###autoload ;;;###autoload
(defun org-babel-goto-named-src-block (name) (defun org-babel-goto-named-src-block (name)
@ -1763,14 +1761,13 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
(defun org-babel-mark-block () (defun org-babel-mark-block ()
"Mark current src block." "Mark current src block."
(interactive) (interactive)
((lambda (head) (let ((head (org-babel-where-is-src-block-head)))
(when head (when head
(save-excursion (save-excursion
(goto-char head) (goto-char head)
(looking-at org-babel-src-block-regexp)) (looking-at org-babel-src-block-regexp))
(push-mark (match-end 5) nil t) (push-mark (match-end 5) nil t)
(goto-char (match-beginning 5)))) (goto-char (match-beginning 5)))))
(org-babel-where-is-src-block-head)))
(defun org-babel-demarcate-block (&optional arg) (defun org-babel-demarcate-block (&optional arg)
"Wrap or split the code in the region or on the point. "Wrap or split the code in the region or on the point.
@ -2450,7 +2447,7 @@ block but are passed literally to the \"example-block\"."
(funcall (intern (concat lang "-mode"))) (funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point))) (comment-region (point) (progn (insert text) (point)))
(org-babel-trim (buffer-string))))) (org-babel-trim (buffer-string)))))
index source-name evaluate prefix blocks-in-buffer) index source-name evaluate prefix)
(with-temp-buffer (with-temp-buffer
(org-set-local 'org-babel-noweb-wrap-start ob-nww-start) (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
(org-set-local 'org-babel-noweb-wrap-end ob-nww-end) (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
@ -2469,119 +2466,118 @@ block but are passed literally to the \"example-block\"."
(funcall nb-add (buffer-substring index (point))) (funcall nb-add (buffer-substring index (point)))
(goto-char (match-end 0)) (goto-char (match-end 0))
(setq index (point)) (setq index (point))
(funcall nb-add (funcall
(with-current-buffer parent-buffer nb-add
(save-restriction (with-current-buffer parent-buffer
(widen) (save-restriction
(mapconcat ;; interpose PREFIX between every line (widen)
#'identity (mapconcat ;; Interpose PREFIX between every line.
(split-string #'identity
(if evaluate (split-string
(let ((raw (org-babel-ref-resolve source-name))) (if evaluate
(if (stringp raw) raw (format "%S" raw))) (let ((raw (org-babel-ref-resolve source-name)))
(or (if (stringp raw) raw (format "%S" raw)))
;; retrieve from the library of babel (or
(nth 2 (assoc (intern source-name) ;; Retrieve from the library of babel.
org-babel-library-of-babel)) (nth 2 (assoc (intern source-name)
;; return the contents of headlines literally org-babel-library-of-babel))
(save-excursion ;; Return the contents of headlines literally.
(when (org-babel-ref-goto-headline-id source-name) (save-excursion
(when (org-babel-ref-goto-headline-id source-name)
(org-babel-ref-headline-body))) (org-babel-ref-headline-body)))
;; find the expansion of reference in this buffer ;; Find the expansion of reference in this buffer.
(let ((rx (concat rx-prefix source-name "[ \t\n]")) (let ((rx (concat rx-prefix source-name "[ \t\n]"))
expansion) expansion)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if org-babel-use-quick-and-dirty-noweb-expansion (if org-babel-use-quick-and-dirty-noweb-expansion
(while (re-search-forward rx nil t) (while (re-search-forward rx nil t)
(let* ((i (org-babel-get-src-block-info 'light)) (let* ((i (org-babel-get-src-block-info 'light))
(body (org-babel-expand-noweb-references i)) (body (org-babel-expand-noweb-references i))
(sep (or (cdr (assoc :noweb-sep (nth 2 i))) (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
"\n")) "\n"))
(full (if comment (full (if comment
((lambda (cs) (let ((cs (org-babel-tangle-comment-links i)))
(concat (funcall c-wrap (car cs)) "\n" (concat (funcall c-wrap (car cs)) "\n"
body "\n" body "\n"
(funcall c-wrap (cadr cs)))) (funcall c-wrap (cadr cs))))
(org-babel-tangle-comment-links i)) body)))
body))) (setq expansion (cons sep (cons full expansion)))))
(setq expansion (cons sep (cons full expansion))))) (org-babel-map-src-blocks nil
(org-babel-map-src-blocks nil (let ((i (org-babel-get-src-block-info 'light)))
(let ((i (org-babel-get-src-block-info 'light))) (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
(when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) (nth 4 i))
(nth 4 i)) source-name)
source-name) (let* ((body (org-babel-expand-noweb-references i))
(let* ((body (org-babel-expand-noweb-references i)) (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
(sep (or (cdr (assoc :noweb-sep (nth 2 i))) "\n"))
"\n")) (full (if comment
(full (if comment (let ((cs (org-babel-tangle-comment-links i)))
((lambda (cs) (concat (funcall c-wrap (car cs)) "\n"
(concat (funcall c-wrap (car cs)) "\n" body "\n"
body "\n" (funcall c-wrap (cadr cs))))
(funcall c-wrap (cadr cs)))) body)))
(org-babel-tangle-comment-links i)) (setq expansion
body))) (cons sep (cons full expansion)))))))))
(setq expansion (and expansion
(cons sep (cons full expansion))))))))) (mapconcat #'identity (nreverse (cdr expansion)) "")))
(and expansion ;; Possibly raise an error if named block doesn't exist.
(mapconcat #'identity (nreverse (cdr expansion)) ""))) (if (member lang org-babel-noweb-error-langs)
;; possibly raise an error if named block doesn't exist (error "%s" (concat
(if (member lang org-babel-noweb-error-langs) (org-babel-noweb-wrap source-name)
(error "%s" (concat "could not be resolved (see "
(org-babel-noweb-wrap source-name) "`org-babel-noweb-error-langs')"))
"could not be resolved (see " "")))
"`org-babel-noweb-error-langs')")) "[\n\r]") (concat "\n" prefix))))))
"")))
"[\n\r]") (concat "\n" prefix))))))
(funcall nb-add (buffer-substring index (point-max)))) (funcall nb-add (buffer-substring index (point-max))))
new-body)) new-body))
(defun org-babel-script-escape (str &optional force) (defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists." "Safely convert tables into elisp lists."
(let (in-single in-double out) (let ((escaped
((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped))) (if (or force
(if (or force (and (stringp str)
(and (stringp str) (> (length str) 2)
(> (length str) 2) (or (and (string-equal "[" (substring str 0 1))
(or (and (string-equal "[" (substring str 0 1)) (string-equal "]" (substring str -1)))
(string-equal "]" (substring str -1))) (and (string-equal "{" (substring str 0 1))
(and (string-equal "{" (substring str 0 1)) (string-equal "}" (substring str -1)))
(string-equal "}" (substring str -1))) (and (string-equal "(" (substring str 0 1))
(and (string-equal "(" (substring str 0 1)) (string-equal ")" (substring str -1))))))
(string-equal ")" (substring str -1)))))) (org-babel-read
(org-babel-read (concat
(concat "'"
"'" (let (in-single in-double out)
(progn (mapc
(mapc (lambda (ch)
(lambda (ch) (setq
(setq out
out (case ch
(case ch (91 (if (or in-double in-single) ; [
(91 (if (or in-double in-single) ; [ (cons 91 out)
(cons 91 out) (cons 40 out)))
(cons 40 out))) (93 (if (or in-double in-single) ; ]
(93 (if (or in-double in-single) ; ] (cons 93 out)
(cons 93 out) (cons 41 out)))
(cons 41 out))) (123 (if (or in-double in-single) ; {
(123 (if (or in-double in-single) ; { (cons 123 out)
(cons 123 out) (cons 40 out)))
(cons 40 out))) (125 (if (or in-double in-single) ; }
(125 (if (or in-double in-single) ; } (cons 125 out)
(cons 125 out) (cons 41 out)))
(cons 41 out))) (44 (if (or in-double in-single) ; ,
(44 (if (or in-double in-single) ; , (cons 44 out) (cons 32 out)))
(cons 44 out) (cons 32 out))) (39 (if in-double ; '
(39 (if in-double ; ' (cons 39 out)
(cons 39 out) (setq in-single (not in-single)) (cons 34 out)))
(setq in-single (not in-single)) (cons 34 out))) (34 (if in-single ; "
(34 (if in-single ; " (append (list 34 32) out)
(append (list 34 32) out) (setq in-double (not in-double)) (cons 34 out)))
(setq in-double (not in-double)) (cons 34 out))) (t (cons ch out)))))
(t (cons ch out))))) (string-to-list str))
(string-to-list str)) (apply #'string (reverse out)))))
(apply #'string (reverse out))))) str)))
str)))) (condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval) (defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate. "Convert the string value of CELL to a number if appropriate.
@ -2691,8 +2687,8 @@ name is removed, since in that case the process will be executing
remotely. The file name is then processed by `expand-file-name'. remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'" additionally processed by `shell-quote-argument'"
((lambda (f) (if no-quote-p f (shell-quote-argument f))) (let ((f (expand-file-name (org-babel-local-file-name name))))
(expand-file-name (org-babel-local-file-name name)))) (if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory) (defvar org-babel-temporary-directory)
(unless (or noninteractive (boundp 'org-babel-temporary-directory)) (unless (or noninteractive (boundp 'org-babel-temporary-directory))

9
lisp/org/ob-ditaa.el
View File

@ -82,11 +82,10 @@ Do not leave leading or trailing spaces in this string."
"Execute a block of Ditaa code with org-babel. "Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
(out-file ((lambda (el) (out-file (let ((el (cdr (assoc :file params))))
(or el (or el
(error (error
"ditaa code block requires :file header argument"))) "ditaa code block requires :file header argument"))))
(cdr (assoc :file params))))
(cmdline (cdr (assoc :cmdline params))) (cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params))) (java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-")) (in-file (org-babel-temp-file "ditaa-"))

39
lisp/org/ob-emacs-lisp.el
View File

@ -54,25 +54,26 @@
(defun org-babel-execute:emacs-lisp (body params) (defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel." "Execute a block of emacs-lisp code with Babel."
(save-window-excursion (save-window-excursion
((lambda (result) (let ((result
(org-babel-result-cond (cdr (assoc :result-params params)) (eval (read (format (if (member "output"
(let ((print-level nil) (cdr (assoc :result-params params)))
(print-length nil)) "(with-output-to-string %s)"
(if (or (member "scalar" (cdr (assoc :result-params params))) "(progn %s)")
(member "verbatim" (cdr (assoc :result-params params)))) (org-babel-expand-body:emacs-lisp
(format "%S" result) body params))))))
(format "%s" result))) (org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-reassemble-table (let ((print-level nil)
result (print-length nil))
(org-babel-pick-name (cdr (assoc :colname-names params)) (if (or (member "scalar" (cdr (assoc :result-params params)))
(cdr (assoc :colnames params))) (member "verbatim" (cdr (assoc :result-params params))))
(org-babel-pick-name (cdr (assoc :rowname-names params)) (format "%S" result)
(cdr (assoc :rownames params)))))) (format "%s" result)))
(eval (read (format (if (member "output" (org-babel-reassemble-table
(cdr (assoc :result-params params))) result
"(with-output-to-string %s)" (org-babel-pick-name (cdr (assoc :colname-names params))
"(progn %s)") (cdr (assoc :colnames params)))
(org-babel-expand-body:emacs-lisp body params))))))) (org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params))))))))
(provide 'ob-emacs-lisp) (provide 'ob-emacs-lisp)

4
lisp/org/ob-exp.el
View File

@ -69,6 +69,8 @@ be executed."
('otherwise ('otherwise
(error "Requested export buffer when `org-current-export-file' is nil")))) (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) (defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1)) (declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
@ -372,7 +374,7 @@ replaced with its value."
(cons (substring (symbol-name (car pair)) 1) (cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair)))) (format "%S" (cdr pair))))
(nth 2 info)) (nth 2 info))
("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) ("flags" . ,(let ((f (nth 3 info))) (when f (concat " " f))))
("name" . ,(or (nth 4 info) ""))))) ("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash) (defun org-babel-exp-results (info type &optional silent hash)

28
lisp/org/ob-fortran.el
View File

@ -60,20 +60,20 @@
(mapconcat 'identity (mapconcat 'identity
(if (listp flags) flags (list flags)) " ") (if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) "")))) (org-babel-process-file-name tmp-src-file)) ""))))
((lambda (results) (let ((results
(org-babel-reassemble-table (org-babel-trim
(org-babel-result-cond (cdr (assoc :result-params params)) (org-babel-eval
(org-babel-read results) (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
(let ((tmp-file (org-babel-temp-file "f-"))) (org-babel-reassemble-table
(with-temp-file tmp-file (insert results)) (org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-import-elisp-from-file tmp-file))) (org-babel-read results)
(org-babel-pick-name (let ((tmp-file (org-babel-temp-file "f-")))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (with-temp-file tmp-file (insert results))
(org-babel-pick-name (org-babel-import-elisp-from-file tmp-file)))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-pick-name
(org-babel-trim (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-eval (org-babel-pick-name
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(defun org-babel-expand-body:fortran (body params) (defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to "Expand a block of fortran or fortran code with org-babel according to

13
lisp/org/ob-haskell.el
View File

@ -79,12 +79,12 @@
(cdr (member org-babel-haskell-eoe (cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw))))))) (reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table (org-babel-reassemble-table
((lambda (result) (let ((result
(org-babel-result-cond (cdr (assoc :result-params params)) (case result-type
result (org-babel-haskell-table-or-string result))) (output (mapconcat #'identity (reverse (cdr results)) "\n"))
(case result-type (value (car results)))))
('output (mapconcat #'identity (reverse (cdr results)) "\n")) (org-babel-result-cond (cdr (assoc :result-params params))
('value (car results)))) result (org-babel-haskell-table-or-string result)))
(org-babel-pick-name (cdr (assoc :colname-names params)) (org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params))) (cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params)) (org-babel-pick-name (cdr (assoc :rowname-names params))
@ -148,6 +148,7 @@ specifying a variable of the same value."
(format "%S" var))) (format "%S" var)))
(defvar org-src-preserve-indentation) (defvar org-src-preserve-indentation)
(defvar org-export-copy-to-kill-ring)
(declare-function org-export-to-file "ox" (declare-function org-export-to-file "ox"
(backend file (backend file
&optional async subtreep visible-only body-only ext-plist)) &optional async subtreep visible-only body-only ext-plist))

11
lisp/org/ob-io.el
View File

@ -94,12 +94,11 @@ in BODY as elisp."
(value (let* ((src-file (org-babel-temp-file "io-")) (value (let* ((src-file (org-babel-temp-file "io-"))
(wrapper (format org-babel-io-wrapper-method body))) (wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper)) (with-temp-file src-file (insert wrapper))
((lambda (raw) (let ((raw (org-babel-eval
(org-babel-result-cond result-params (concat org-babel-io-command " " src-file) "")))
raw (org-babel-result-cond result-params
(org-babel-io-table-or-string raw))) raw
(org-babel-eval (org-babel-io-table-or-string raw)))))))
(concat org-babel-io-command " " src-file) ""))))))
(defun org-babel-prep-session:io (session params) (defun org-babel-prep-session:io (session params)

25
lisp/org/ob-java.el
View File

@ -55,19 +55,18 @@
;; created package-name directories if missing ;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename)) (unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents)) (make-directory packagename 'parents))
((lambda (results) (let ((results (org-babel-eval (concat org-babel-java-command
(org-babel-reassemble-table " " cmdline " " classname) "")))
(org-babel-result-cond (cdr (assoc :result-params params)) (org-babel-reassemble-table
(org-babel-read results) (org-babel-result-cond (cdr (assoc :result-params params))
(let ((tmp-file (org-babel-temp-file "c-"))) (org-babel-read results)
(with-temp-file tmp-file (insert results)) (let ((tmp-file (org-babel-temp-file "c-")))
(org-babel-import-elisp-from-file tmp-file))) (with-temp-file tmp-file (insert results))
(org-babel-pick-name (org-babel-import-elisp-from-file tmp-file)))
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name
(org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-pick-name
(org-babel-eval (concat org-babel-java-command (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
" " cmdline " " classname) ""))))
(provide 'ob-java) (provide 'ob-java)

1
lisp/org/ob-lilypond.el
View File

@ -200,7 +200,6 @@ FILE-NAME is full path to lilypond (.ly) file"
(let ((arg-1 (ly-determine-ly-path)) ;program (let ((arg-1 (ly-determine-ly-path)) ;program
(arg-2 nil) ;infile (arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer (arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
(arg-4 t) ;display (arg-4 t) ;display
(arg-5 (if ly-gen-png "--png" "")) ;&rest... (arg-5 (if ly-gen-png "--png" "")) ;&rest...
(arg-6 (if ly-gen-html "--html" "")) (arg-6 (if ly-gen-html "--html" ""))

35
lisp/org/ob-lisp.el
View File

@ -75,23 +75,24 @@ current directory string."
"Execute a block of Common Lisp code with Babel." "Execute a block of Common Lisp code with Babel."
(require 'slime) (require 'slime)
(org-babel-reassemble-table (org-babel-reassemble-table
((lambda (result) (let ((result
(org-babel-result-cond (cdr (assoc :result-params params)) (with-temp-buffer
(car result) (insert (org-babel-expand-body:lisp body params))
(condition-case nil (slime-eval `(swank:eval-and-grab-output
(read (org-babel-lisp-vector-to-list (cadr result))) ,(let ((dir (if (assoc :dir params)
(error (cadr result))))) (cdr (assoc :dir params))
(with-temp-buffer default-directory)))
(insert (org-babel-expand-body:lisp body params)) (format
(slime-eval `(swank:eval-and-grab-output (if dir (format org-babel-lisp-dir-fmt dir)
,(let ((dir (if (assoc :dir params) "(progn %s)")
(cdr (assoc :dir params)) (buffer-substring-no-properties
default-directory))) (point-min) (point-max)))))
(format (cdr (assoc :package params))))))
(if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)") (org-babel-result-cond (cdr (assoc :result-params params))
(buffer-substring-no-properties (car result)
(point-min) (point-max))))) (condition-case nil
(cdr (assoc :package params))))) (read (org-babel-lisp-vector-to-list (cadr result)))
(error (cadr result)))))
(org-babel-pick-name (cdr (assoc :colname-names params)) (org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params))) (cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params)) (org-babel-pick-name (cdr (assoc :rowname-names params))

28
lisp/org/ob-maxima.el
View File

@ -65,8 +65,8 @@
"\n"))) "\n")))
(defun org-babel-execute:maxima (body params) (defun org-babel-execute:maxima (body params)
"Execute a block of Maxima entries with org-babel. This function is "Execute a block of Maxima entries with org-babel.
called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code block") (message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result (result
@ -76,18 +76,18 @@ called by `org-babel-execute-src-block'."
org-babel-maxima-command in-file cmdline))) org-babel-maxima-command in-file cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params))) (with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd) (message cmd)
((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
(mapconcat (let ((raw (org-babel-eval cmd "")))
#'identity (mapconcat
(delq nil #'identity
(mapcar (lambda (line) (delq nil
(unless (or (string-match "batch" line) (mapcar (lambda (line)
(string-match "^rat: replaced .*$" line) (unless (or (string-match "batch" line)
(string-match "^;;; Loading #P" line) (string-match "^rat: replaced .*$" line)
(= 0 (length line))) (string-match "^;;; Loading #P" line)
line)) (= 0 (length line)))
(split-string raw "[\r\n]"))) "\n")) line))
(org-babel-eval cmd ""))))) (split-string raw "[\r\n]"))) "\n")))))
(if (org-babel-maxima-graphical-output-file params) (if (org-babel-maxima-graphical-output-file params)
nil nil
(org-babel-result-cond result-params (org-babel-result-cond result-params

30
lisp/org/ob-perl.el
View File

@ -135,21 +135,21 @@ return the value of the last statement in BODY, as elisp."
(tmp-file (org-babel-temp-file "perl-")) (tmp-file (org-babel-temp-file "perl-"))
(tmp-babel-file (org-babel-process-file-name (tmp-babel-file (org-babel-process-file-name
tmp-file 'noquote))) tmp-file 'noquote)))
((lambda (results) (let ((results
(when results (case result-type
(org-babel-result-cond result-params (output
(org-babel-eval-read-file tmp-file) (with-temp-file tmp-file
(org-babel-import-elisp-from-file tmp-file '(16))))) (insert
(case result-type (org-babel-eval org-babel-perl-command body))
(output (buffer-string)))
(with-temp-file tmp-file (value
(insert (org-babel-eval org-babel-perl-command
(org-babel-eval org-babel-perl-command body)) (format org-babel-perl-wrapper-method
(buffer-string))) body tmp-babel-file))))))
(value (when results
(org-babel-eval org-babel-perl-command (org-babel-result-cond result-params
(format org-babel-perl-wrapper-method (org-babel-eval-read-file tmp-file)
body tmp-babel-file))))))) (org-babel-import-elisp-from-file tmp-file '(16)))))))
(provide 'ob-perl) (provide 'ob-perl)

105
lisp/org/ob-picolisp.el
View File

@ -99,16 +99,16 @@
called by `org-babel-execute-src-block'" called by `org-babel-execute-src-block'"
(message "executing Picolisp source code block") (message "executing Picolisp source code block")
(let* ( (let* (
;; name of the session or "none" ;; Name of the session or "none".
(session-name (cdr (assoc :session params))) (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)) (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-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params 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)) (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 (wrapped-body
(cond (cond
((or (member "code" result-params) ((or (member "code" result-params)
@ -118,53 +118,54 @@
(format "(print (out \"/dev/null\" %s))" full-body)) (format "(print (out \"/dev/null\" %s))" full-body))
((member "value" result-params) ((member "value" result-params)
(format "(out \"/dev/null\" %s)" full-body)) (format "(out \"/dev/null\" %s)" full-body))
(t full-body)))) (t full-body)))
(result
((lambda (result) (if (not (string= session-name "none"))
(org-babel-result-cond result-params ;; Session based evaluation.
result (mapconcat ;; <- joins the list back into a single string
(read result))) #'identity
(if (not (string= session-name "none")) (butlast ;; <- remove the org-babel-picolisp-eoe line
;; session based evaluation (delq nil
(mapconcat ;; <- joins the list back together into a single string (mapcar
#'identity (lambda (line)
(butlast ;; <- remove the org-babel-picolisp-eoe line (org-babel-chomp ;; Remove trailing newlines.
(delq nil (when (> (length line) 0) ;; Remove empty lines.
(mapcar (cond
(lambda (line) ;; Remove leading "-> " from return values.
(org-babel-chomp ;; remove trailing newlines ((and (>= (length line) 3)
(when (> (length line) 0) ;; remove empty lines (string= "-> " (substring line 0 3)))
(cond (substring line 3))
;; remove leading "-> " from return values ;; Remove trailing "-> <<return-value>>" on the
((and (>= (length line) 3) ;; last line of output.
(string= "-> " (substring line 0 3))) ((and (member "output" result-params)
(substring line 3)) (string-match-p "->" line))
;; remove trailing "-> <<return-value>>" on the (substring line 0 (string-match "->" line)))
;; last line of output (t line)
((and (member "output" result-params) )
(string-match-p "->" line)) ;;(if (and (>= (length line) 3);Remove leading "<-"
(substring line 0 (string-match "->" line))) ;; (string= "-> " (substring line 0 3)))
(t line) ;; (substring line 3)
) ;; line)
;; (if (and (>= (length line) 3) ;; remove leading "<- " )))
;; (string= "-> " (substring line 0 3))) ;; Returns a list of the output of each evaluated exp.
;; (substring line 3) (org-babel-comint-with-output
;; line) (session org-babel-picolisp-eoe)
))) (insert wrapped-body) (comint-send-input)
;; returns a list of the output of each evaluated expression (insert "'" org-babel-picolisp-eoe)
(org-babel-comint-with-output (session org-babel-picolisp-eoe) (comint-send-input)))))
(insert wrapped-body) (comint-send-input) "\n")
(insert "'" org-babel-picolisp-eoe) (comint-send-input))))) ;; external evaluation
"\n") (let ((script-file (org-babel-temp-file "picolisp-script-")))
;; external evaluation (with-temp-file script-file
(let ((script-file (org-babel-temp-file "picolisp-script-"))) (insert (concat wrapped-body "(bye)")))
(with-temp-file script-file (org-babel-eval
(insert (concat wrapped-body "(bye)"))) (format "%s %s"
(org-babel-eval org-babel-picolisp-cmd
(format "%s %s" (org-babel-process-file-name script-file))
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) (defun org-babel-picolisp-initiate-session (&optional session-name)
"If there is not a current inferior-process-buffer in SESSION "If there is not a current inferior-process-buffer in SESSION

129
lisp/org/ob-python.el
View File

@ -143,13 +143,12 @@ specifying a variable of the same value."
"Convert RESULTS into an appropriate elisp value. "Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string." Emacs-lisp table, otherwise return the results as a string."
((lambda (res) (let ((res (org-babel-script-escape results)))
(if (listp res) (if (listp res)
(mapcar (lambda (el) (if (equal el 'None) (mapcar (lambda (el) (if (equal el 'None)
org-babel-python-None-to el)) org-babel-python-None-to el))
res) res)
res)) res)))
(org-babel-script-escape results)))
(defvar org-babel-python-buffers '((:default . "*Python*"))) (defvar org-babel-python-buffers '((:default . "*Python*")))
@ -172,6 +171,8 @@ Emacs-lisp table, otherwise return the results as a string."
name))) name)))
(defvar py-default-interpreter) (defvar py-default-interpreter)
(defvar py-which-bufname)
(defvar python-shell-buffer-name)
(defun org-babel-python-initiate-session-by-key (&optional session) (defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session. "Initiate a python session.
If there is not a current inferior-process-buffer in SESSION If there is not a current inferior-process-buffer in SESSION
@ -252,34 +253,34 @@ open('%s', 'w').write( pprint.pformat(main()) )")
If RESULT-TYPE equals 'output then return standard output as a If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp." last statement in BODY, as elisp."
((lambda (raw) (let ((raw
(org-babel-result-cond result-params (case result-type
raw (output (org-babel-eval org-babel-python-command
(org-babel-python-table-or-string (org-babel-trim raw)))) (concat (if preamble (concat preamble "\n"))
(case result-type body)))
(output (org-babel-eval org-babel-python-command (value (let ((tmp-file (org-babel-temp-file "python-")))
(concat (if preamble (concat preamble "\n") "") (org-babel-eval
body))) org-babel-python-command
(value (let ((tmp-file (org-babel-temp-file "python-"))) (concat
(org-babel-eval (if preamble (concat preamble "\n") "")
org-babel-python-command (format
(concat (if (member "pp" result-params)
(if preamble (concat preamble "\n") "") org-babel-python-pp-wrapper-method
(format org-babel-python-wrapper-method)
(if (member "pp" result-params) (mapconcat
org-babel-python-pp-wrapper-method (lambda (line) (format "\t%s" line))
org-babel-python-wrapper-method) (split-string
(mapconcat (org-remove-indentation
(lambda (line) (format "\t%s" line)) (org-babel-trim body))
(split-string "[\r\n]") "\n")
(org-remove-indentation (org-babel-process-file-name tmp-file 'noquote))))
(org-babel-trim body)) (org-babel-eval-read-file tmp-file))))))
"[\r\n]") "\n") (org-babel-result-cond result-params
(org-babel-process-file-name tmp-file 'noquote)))) raw
(org-babel-eval-read-file tmp-file)))))) (org-babel-python-table-or-string (org-babel-trim raw)))))
(defun org-babel-python-evaluate-session (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. "Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the string. If RESULT-TYPE equals 'value then return the value of the
@ -296,39 +297,41 @@ last statement in BODY, as elisp."
(format "open('%s', 'w').write(pprint.pformat(_))" (format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote))) (org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))" (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) (input-body (lambda (body)
(mapc (lambda (line) (insert line) (funcall send-wait)) (mapc (lambda (line) (insert line) (funcall send-wait))
(split-string body "[\r\n]")) (split-string body "[\r\n]"))
(funcall send-wait)))) (funcall send-wait)))
((lambda (results) (results
(unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) (case result-type
(org-babel-result-cond result-params (output
results (mapconcat
(org-babel-python-table-or-string results)))) #'org-babel-trim
(case result-type (butlast
(output (org-babel-comint-with-output
(mapconcat (session org-babel-python-eoe-indicator t body)
#'org-babel-trim (funcall input-body body)
(butlast (funcall send-wait) (funcall send-wait)
(org-babel-comint-with-output (insert org-babel-python-eoe-indicator)
(session org-babel-python-eoe-indicator t body) (funcall send-wait))
(funcall input-body body) 2) "\n"))
(funcall send-wait) (funcall send-wait) (value
(insert org-babel-python-eoe-indicator) (let ((tmp-file (org-babel-temp-file "python-")))
(funcall send-wait)) (org-babel-comint-with-output
2) "\n")) (session org-babel-python-eoe-indicator nil body)
(value (let ((comint-process-echoes nil))
(let ((tmp-file (org-babel-temp-file "python-"))) (funcall input-body body)
(org-babel-comint-with-output (funcall dump-last-value tmp-file
(session org-babel-python-eoe-indicator nil body) (member "pp" result-params))
(let ((comint-process-echoes nil)) (funcall send-wait) (funcall send-wait)
(funcall input-body body) (insert org-babel-python-eoe-indicator)
(funcall dump-last-value tmp-file (member "pp" result-params)) (funcall send-wait)))
(funcall send-wait) (funcall send-wait) (org-babel-eval-read-file tmp-file))))))
(insert org-babel-python-eoe-indicator) (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
(funcall send-wait))) (org-babel-result-cond result-params
(org-babel-eval-read-file tmp-file))))))) results
(org-babel-python-table-or-string results)))))
(defun org-babel-python-read-string (string) (defun org-babel-python-read-string (string)
"Strip 's from around Python string." "Strip 's from around Python string."

24
lisp/org/ob-ruby.el
View File

@ -139,13 +139,12 @@ specifying a variable of the same value."
"Convert RESULTS into an appropriate elisp value. "Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string." Emacs-lisp table, otherwise return the results as a string."
((lambda (res) (let ((res (org-babel-script-escape results)))
(if (listp res) (if (listp res)
(mapcar (lambda (el) (if (equal el 'nil) (mapcar (lambda (el) (if (equal el 'nil)
org-babel-ruby-nil-to el)) org-babel-ruby-nil-to el))
res) res)
res)) res)))
(org-babel-script-escape results)))
(defun org-babel-ruby-initiate-session (&optional session params) (defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session. "Initiate a ruby session.
@ -204,12 +203,11 @@ return the value of the last statement in BODY, as elisp."
org-babel-ruby-pp-wrapper-method org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method) org-babel-ruby-wrapper-method)
body (org-babel-process-file-name tmp-file 'noquote))) body (org-babel-process-file-name tmp-file 'noquote)))
((lambda (raw) (let ((raw (org-babel-eval-read-file tmp-file)))
(if (or (member "code" result-params) (if (or (member "code" result-params)
(member "pp" result-params)) (member "pp" result-params))
raw raw
(org-babel-ruby-table-or-string raw))) (org-babel-ruby-table-or-string raw))))))
(org-babel-eval-read-file tmp-file)))))
;; comint session evaluation ;; comint session evaluation
(case result-type (case result-type
(output (output

11
lisp/org/ob-scala.el
View File

@ -100,12 +100,11 @@ in BODY as elisp."
(let* ((src-file (org-babel-temp-file "scala-")) (let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body))) (wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper)) (with-temp-file src-file (insert wrapper))
((lambda (raw) (let ((raw (org-babel-eval
(org-babel-result-cond result-params (concat org-babel-scala-command " " src-file) "")))
raw (org-babel-result-cond result-params
(org-babel-scala-table-or-string raw))) raw
(org-babel-eval (org-babel-scala-table-or-string raw)))))))
(concat org-babel-scala-command " " src-file) ""))))))
(defun org-babel-prep-session:scala (session params) (defun org-babel-prep-session:scala (session params)

131
lisp/org/ob-sh.el
View File

@ -53,9 +53,9 @@ This will be passed to `shell-command-on-region'")
This function is called by `org-babel-execute-src-block'." This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session (let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params)))) (cdr (assoc :session params))))
(stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string (stdin (let ((stdin (cdr (assoc :stdin params))))
(org-babel-ref-resolve stdin)))) (when stdin (org-babel-sh-var-to-string
(cdr (assoc :stdin params)))) (org-babel-ref-resolve stdin)))))
(full-body (org-babel-expand-body:generic (full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params)))) body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table (org-babel-reassemble-table
@ -135,68 +135,69 @@ Emacs-lisp table, otherwise return the results as a string."
If RESULT-TYPE equals 'output then return a list of the outputs If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY." return the value of the last statement in BODY."
((lambda (results) (let ((results
(when results (cond
(let ((result-params (cdr (assoc :result-params params)))) (stdin ; external shell script w/STDIN
(org-babel-result-cond result-params (let ((script-file (org-babel-temp-file "sh-script-"))
results (stdin-file (org-babel-temp-file "sh-stdin-"))
(let ((tmp-file (org-babel-temp-file "sh-"))) (shebang (cdr (assoc :shebang params)))
(with-temp-file tmp-file (insert results)) (padline (not (string= "no" (cdr (assoc :padline params))))))
(org-babel-import-elisp-from-file tmp-file)))))) (with-temp-file script-file
(cond (when shebang (insert (concat shebang "\n")))
(stdin ; external shell script w/STDIN (when padline (insert "\n"))
(let ((script-file (org-babel-temp-file "sh-script-")) (insert body))
(stdin-file (org-babel-temp-file "sh-stdin-")) (set-file-modes script-file #o755)
(shebang (cdr (assoc :shebang params))) (with-temp-file stdin-file (insert stdin))
(padline (not (string= "no" (cdr (assoc :padline params)))))) (with-temp-buffer
(with-temp-file script-file (call-process-shell-command
(when shebang (insert (concat shebang "\n"))) (if shebang
(when padline (insert "\n")) script-file
(insert body)) (format "%s %s" org-babel-sh-command script-file))
(set-file-modes script-file #o755) stdin-file
(with-temp-file stdin-file (insert stdin)) (current-buffer))
(with-temp-buffer (buffer-string))))
(call-process-shell-command (session ; session evaluation
(if shebang (mapconcat
script-file #'org-babel-sh-strip-weird-long-prompt
(format "%s %s" org-babel-sh-command script-file)) (mapcar
stdin-file #'org-babel-trim
(current-buffer)) (butlast
(buffer-string)))) (org-babel-comint-with-output
(session ; session evaluation (session org-babel-sh-eoe-output t body)
(mapconcat (mapc
#'org-babel-sh-strip-weird-long-prompt (lambda (line)
(mapcar (insert line)
#'org-babel-trim (comint-send-input nil t)
(butlast (while (save-excursion
(org-babel-comint-with-output (goto-char comint-last-input-end)
(session org-babel-sh-eoe-output t body) (not (re-search-forward
(mapc comint-prompt-regexp nil t)))
(lambda (line) (accept-process-output
(insert line) (get-buffer-process (current-buffer)))))
(comint-send-input nil t) (append
(while (save-excursion (split-string (org-babel-trim body) "\n")
(goto-char comint-last-input-end) (list org-babel-sh-eoe-indicator))))
(not (re-search-forward 2)) "\n"))
comint-prompt-regexp nil t))) ('otherwise ; external shell script
(accept-process-output (get-buffer-process (current-buffer))))) (if (and (cdr (assoc :shebang params))
(append (> (length (cdr (assoc :shebang params))) 0))
(split-string (org-babel-trim body) "\n") (let ((script-file (org-babel-temp-file "sh-script-"))
(list org-babel-sh-eoe-indicator)))) (shebang (cdr (assoc :shebang params)))
2)) "\n")) (padline (not (equal "no" (cdr (assoc :padline params))))))
('otherwise ; external shell script (with-temp-file script-file
(if (and (cdr (assoc :shebang params)) (when shebang (insert (concat shebang "\n")))
(> (length (cdr (assoc :shebang params))) 0)) (when padline (insert "\n"))
(let ((script-file (org-babel-temp-file "sh-script-")) (insert body))
(shebang (cdr (assoc :shebang params))) (set-file-modes script-file #o755)
(padline (not (string= "no" (cdr (assoc :padline params)))))) (org-babel-eval script-file ""))
(with-temp-file script-file (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
(when shebang (insert (concat shebang "\n"))) (when results
(when padline (insert "\n")) (let ((result-params (cdr (assoc :result-params params))))
(insert body)) (org-babel-result-cond result-params
(set-file-modes script-file #o755) results
(org-babel-eval script-file "")) (let ((tmp-file (org-babel-temp-file "sh-")))
(org-babel-eval org-babel-sh-command (org-babel-trim body))))))) (with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))))))
(defun org-babel-sh-strip-weird-long-prompt (string) (defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output." "Remove prompt cruft from a string of shell output."

16
lisp/org/ob-shen.el
View File

@ -66,14 +66,14 @@ This function is called by `org-babel-execute-src-block'"
(let* ((result-type (cdr (assoc :result-type params))) (let* ((result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params))) (result-params (cdr (assoc :result-params params)))
(full-body (org-babel-expand-body:shen body params))) (full-body (org-babel-expand-body:shen body params)))
((lambda (results) (let ((results
(org-babel-result-cond result-params (with-temp-buffer
results (insert full-body)
(condition-case nil (org-babel-script-escape results) (call-interactively #'shen-eval-defun))))
(error results)))) (org-babel-result-cond result-params
(with-temp-buffer results
(insert full-body) (condition-case nil (org-babel-script-escape results)
(call-interactively #'shen-eval-defun))))) (error results))))))
(provide 'ob-shen) (provide 'ob-shen)
;;; ob-shen.el ends here ;;; ob-shen.el ends here

24
lisp/org/ob-sql.el
View File

@ -186,19 +186,17 @@ This function is called by `org-babel-execute-src-block'."
(lambda (pair) (lambda (pair)
(setq body (setq body
(replace-regexp-in-string (replace-regexp-in-string
(format "\$%s" (car pair)) (format "\$%s" (car pair)) ;FIXME: "\$" == "$"!
((lambda (val) (let ((val (cdr pair)))
(if (listp val) (if (listp val)
((lambda (data-file) (let ((data-file (org-babel-temp-file "sql-data-")))
(with-temp-file data-file (with-temp-file data-file
(insert (orgtbl-to-csv (insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el) val '(:fmt (lambda (el) (if (stringp el)
el el
(format "%S" el))))))) (format "%S" el)))))))
data-file) data-file)
(org-babel-temp-file "sql-data-")) (if (stringp val) val (format "%S" val))))
(if (stringp val) val (format "%S" val))))
(cdr pair))
body))) body)))
vars) vars)
body) body)

25
lisp/org/ob-sqlite.el
View File

@ -114,23 +114,22 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-sqlite-expand-vars (body vars) (defun org-babel-sqlite-expand-vars (body vars)
"Expand the variables held in VARS in BODY." "Expand the variables held in VARS in BODY."
;; FIXME: Redundancy with org-babel-sql-expand-vars!
(mapc (mapc
(lambda (pair) (lambda (pair)
(setq body (setq body
(replace-regexp-in-string (replace-regexp-in-string
(format "\$%s" (car pair)) (format "\$%s" (car pair)) ;FIXME: "\$" == "$"!
((lambda (val) (let ((val (cdr pair)))
(if (listp val) (if (listp val)
((lambda (data-file) (let ((data-file (org-babel-temp-file "sqlite-data-")))
(with-temp-file data-file (with-temp-file data-file
(insert (orgtbl-to-csv (insert (orgtbl-to-csv
val '(:fmt (lambda (el) (if (stringp el) val '(:fmt (lambda (el) (if (stringp el)
el el
(format "%S" el))))))) (format "%S" el)))))))
data-file) data-file)
(org-babel-temp-file "sqlite-data-")) (if (stringp val) val (format "%S" val))))
(if (stringp val) val (format "%S" val))))
(cdr pair))
body))) body)))
vars) vars)
body) body)

53
lisp/org/ob-table.el
View File

@ -60,7 +60,7 @@ character and replace it with ellipses."
(concat (substring string 0 (match-beginning 0)) (concat (substring string 0 (match-beginning 0))
(if (match-string 1 string) "...")) string)) (if (match-string 1 string) "...")) string))
(defmacro sbe (source-block &rest variables) (defmacro sbe (source-block &rest variables) ;FIXME: Namespace prefix!
"Return the results of calling SOURCE-BLOCK with VARIABLES. "Return the results of calling SOURCE-BLOCK with VARIABLES.
Each element of VARIABLES should be a two Each element of VARIABLES should be a two
element list, whose first element is the name of the variable and element list, whose first element is the name of the variable and
@ -85,6 +85,7 @@ as shown in the example below.
| 1 | 2 | :file nothing.png | nothing.png | | 1 | 2 | :file nothing.png | nothing.png |
#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))" #+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
(declare (debug (form form)))
(let* ((header-args (if (stringp (car variables)) (car variables) "")) (let* ((header-args (if (stringp (car variables)) (car variables) ""))
(variables (if (stringp (car variables)) (cdr variables) variables))) (variables (if (stringp (car variables)) (cdr variables) variables)))
(let* (quote (let* (quote
@ -107,31 +108,31 @@ as shown in the example below.
variables))) variables)))
(unless (stringp source-block) (unless (stringp source-block)
(setq source-block (symbol-name source-block))) (setq source-block (symbol-name source-block)))
((lambda (result) (let ((result
(org-babel-trim (if (stringp result) result (format "%S" result)))) (if (and source-block (> (length source-block) 0))
(if (and source-block (> (length source-block) 0)) (let ((params
(let ((params ;; FIXME: Why `eval'?!?!?
(eval `(org-babel-parse-header-arguments (eval `(org-babel-parse-header-arguments
(concat (concat
":var results=" ":var results="
,source-block ,source-block
"[" ,header-args "]" "[" ,header-args "]"
"(" "("
(mapconcat (mapconcat
(lambda (var-spec) (lambda (var-spec)
(if (> (length (cdr var-spec)) 1) (if (> (length (cdr var-spec)) 1)
(format "%S='%S" (format "%S='%S"
(car var-spec) (car var-spec)
(mapcar #'read (cdr var-spec))) (mapcar #'read (cdr var-spec)))
(format "%S=%s" (format "%S=%s"
(car var-spec) (cadr var-spec)))) (car var-spec) (cadr var-spec))))
',variables ", ") ',variables ", ")
")"))))) ")")))))
(org-babel-execute-src-block (org-babel-execute-src-block
nil (list "emacs-lisp" "results" params) nil (list "emacs-lisp" "results" params)
'((:results . "silent")))) '((:results . "silent"))))
""))))) "")))
(def-edebug-spec sbe (form form)) (org-babel-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table) (provide 'ob-table)

74
lisp/org/ob-tangle.el
View File

@ -210,8 +210,8 @@ used to limit the exported source code blocks by language."
(lambda (spec) (lambda (spec)
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
(let* ((tangle (funcall get-spec :tangle)) (let* ((tangle (funcall get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) (she-bang (let ((sheb (funcall get-spec :shebang)))
(funcall get-spec :shebang))) (when (> (length sheb) 0) sheb)))
(tangle-mode (funcall get-spec :tangle-mode)) (tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond (base-name (cond
((string= "yes" tangle) ((string= "yes" tangle)
@ -224,9 +224,9 @@ used to limit the exported source code blocks by language."
(if (and ext (string= "yes" tangle)) (if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name)))) (concat base-name "." ext) base-name))))
(when file-name (when file-name
;; possibly create the parent directories for file ;; Possibly create the parent directories for file.
(when ((lambda (m) (and m (not (string= m "no")))) (when (let ((m (funcall get-spec :mkdirp)))
(funcall get-spec :mkdirp)) (and m (not (string= m "no"))))
(make-directory (file-name-directory file-name) 'parents)) (make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file ;; delete any old versions of file
(when (and (file-exists-p file-name) (when (and (file-exists-p file-name)
@ -314,9 +314,8 @@ that the appropriate major-mode is set. SPEC has the form:
(string= comments "yes") (string= comments "noweb"))) (string= comments "yes") (string= comments "noweb")))
(link-data (mapcar (lambda (el) (link-data (mapcar (lambda (el)
(cons (symbol-name el) (cons (symbol-name el)
((lambda (le) (let ((le (eval el)))
(if (stringp le) le (format "%S" le))) (if (stringp le) le (format "%S" le)))))
(eval el))))
'(start-line file link source-name))) '(start-line file link source-name)))
(insert-comment (lambda (text) (insert-comment (lambda (text)
(when (and comments (not (string= comments "no")) (when (and comments (not (string= comments "no"))
@ -402,11 +401,10 @@ list to be used by `org-babel-tangle' directly."
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
(match-string 1 extra)) (match-string 1 extra))
org-coderef-label-format)) org-coderef-label-format))
(link ((lambda (link) (link (let ((link (org-no-properties
(and (string-match org-bracket-link-regexp link) (org-store-link nil))))
(match-string 1 link))) (and (string-match org-bracket-link-regexp link)
(org-no-properties (match-string 1 link))))
(org-store-link nil))))
(source-name (source-name
(intern (or (nth 4 info) (intern (or (nth 4 info)
(format "%s:%d" (format "%s:%d"
@ -418,28 +416,29 @@ list to be used by `org-babel-tangle' directly."
(assignments-cmd (assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang))) (intern (concat "org-babel-variable-assignments:" src-lang)))
(body (body
((lambda (body) ;; Run the tangle-body-hook ;; Run the tangle-body-hook.
(with-temp-buffer (let* ((body ;; Expand the body in language specific manner.
(insert body) (if (org-babel-noweb-p params :tangle)
(when (string-match "-r" extra) (org-babel-expand-noweb-references info)
(goto-char (point-min)) (nth 1 info)))
(while (re-search-forward (body
(replace-regexp-in-string "%s" ".+" cref-fmt) nil t) (if (assoc :no-expand params)
(replace-match ""))) body
(run-hooks 'org-babel-tangle-body-hook) (if (fboundp expand-cmd)
(buffer-string))) (funcall expand-cmd body params)
((lambda (body) ;; Expand the body in language specific manner (org-babel-expand-body:generic
(if (assoc :no-expand params) body params
body (and (fboundp assignments-cmd)
(if (fboundp expand-cmd) (funcall assignments-cmd params)))))))
(funcall expand-cmd body params) (with-temp-buffer
(org-babel-expand-body:generic (insert body)
body params (when (string-match "-r" extra)
(and (fboundp assignments-cmd) (goto-char (point-min))
(funcall assignments-cmd params)))))) (while (re-search-forward
(if (org-babel-noweb-p params :tangle) (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
(org-babel-expand-noweb-references info) (replace-match "")))
(nth 1 info))))) (run-hooks 'org-babel-tangle-body-hook)
(buffer-string))))
(comment (comment
(when (or (string= "both" (cdr (assoc :comments params))) (when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params)))) (string= "org" (cdr (assoc :comments params))))
@ -474,9 +473,8 @@ list to be used by `org-babel-tangle' directly."
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el) (link-data (mapcar (lambda (el)
(cons (symbol-name el) (cons (symbol-name el)
((lambda (le) (let ((le (eval el)))
(if (stringp le) le (format "%S" le))) (if (stringp le) le (format "%S" le)))))
(eval el))))
'(start-line file link source-name)))) '(start-line file link source-name))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data) (list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data)))) (org-fill-template org-babel-tangle-comment-format-end link-data))))

6
lisp/org/org-agenda.el
View File

@ -2840,6 +2840,8 @@ Pressing `<' twice means to restrict to the current subtree or region
((equal org-keys "!") (customize-variable 'org-stuck-projects)) ((equal org-keys "!") (customize-variable 'org-stuck-projects))
(t (user-error "Invalid agenda key")))))) (t (user-error "Invalid agenda key"))))))
(defvar org-agenda-multi)
(defun org-agenda-append-agenda () (defun org-agenda-append-agenda ()
"Append another agenda view to the current one. "Append another agenda view to the current one.
This function allows interactive building of block agendas. This function allows interactive building of block agendas.
@ -3814,6 +3816,8 @@ generating a new one."
'org-priority)) 'org-priority))
(overlay-put ov 'org-type 'org-priority))))) (overlay-put ov 'org-type 'org-priority)))))
(defvar org-depend-tag-blocked)
(defun org-agenda-dim-blocked-tasks (&optional invisible) (defun org-agenda-dim-blocked-tasks (&optional invisible)
"Dim currently blocked TODO's in the agenda display. "Dim currently blocked TODO's in the agenda display.
When INVISIBLE is non-nil, hide currently blocked TODO instead of When INVISIBLE is non-nil, hide currently blocked TODO instead of
@ -3982,6 +3986,7 @@ This check for agenda markers in all agenda buffers currently active."
;;; Agenda timeline ;;; Agenda timeline
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped (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) (defun org-timeline (&optional dotodo)
"Show a time-sorted view of the entries in the current org file. "Show a time-sorted view of the entries in the current org file.
@ -5762,7 +5767,6 @@ please use `org-class' instead."
dayname skip-weeks))) dayname skip-weeks)))
(make-obsolete 'org-diary-class 'org-class "") (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) (defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress () (defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display." "Return the logged TODO entries for agenda display."

50
lisp/org/org-bibtex.el
View File

@ -293,12 +293,13 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
;;; Utility functions ;;; Utility functions
(defun org-bibtex-get (property) (defun org-bibtex-get (property)
((lambda (it) (when it (org-babel-trim it))) (let ((it (let ((org-special-properties
(let ((org-special-properties (delete "FILE" (copy-sequence org-special-properties))))
(delete "FILE" (copy-sequence org-special-properties)))) (or
(or (org-entry-get (point) (upcase property))
(org-entry-get (point) (upcase property)) (org-entry-get (point) (concat org-bibtex-prefix
(org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))) (upcase property)))))))
(when it (org-babel-trim it))))
(defun org-bibtex-put (property value) (defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property) (let ((prop (upcase (if (keywordp property)
@ -384,8 +385,8 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
(princ (cdr (assoc field org-bibtex-fields)))) (princ (cdr (assoc field org-bibtex-fields))))
(with-current-buffer buf-name (visual-line-mode 1)) (with-current-buffer buf-name (visual-line-mode 1))
(org-fit-window-to-buffer (get-buffer-window buf-name)) (org-fit-window-to-buffer (get-buffer-window buf-name))
((lambda (result) (when (> (length result) 0) result)) (let ((result (read-from-minibuffer (format "%s: " name))))
(read-from-minibuffer (format "%s: " name)))))) (when (> (length result) 0) result)))))
(defun org-bibtex-autokey () (defun org-bibtex-autokey ()
"Generate an autokey for the current headline." "Generate an autokey for the current headline."
@ -539,20 +540,21 @@ Headlines are exported using `org-bibtex-export-headline'."
"Bibtex file: " nil nil nil "Bibtex file: " nil nil nil
(file-name-nondirectory (file-name-nondirectory
(concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) (concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
((lambda (error-point) (let ((error-point
(when error-point (catch 'bib
(goto-char error-point) (let ((bibtex-entries
(message "Bibtex error at %S" (nth 4 (org-heading-components))))) (remove nil (org-map-entries
(catch 'bib (lambda ()
(let ((bibtex-entries (remove nil (org-map-entries (condition-case foo
(lambda () (org-bibtex-headline)
(condition-case foo (error (throw 'bib (point)))))))))
(org-bibtex-headline) (with-temp-file filename
(error (throw 'bib (point))))))))) (insert (mapconcat #'identity bibtex-entries "\n")))
(with-temp-file filename (message "Successfully exported %d BibTeX entries to %s"
(insert (mapconcat #'identity bibtex-entries "\n"))) (length bibtex-entries) filename) nil))))
(message "Successfully exported %d BibTeX entries to %s" (when error-point
(length bibtex-entries) filename) nil)))) (goto-char error-point)
(message "Bibtex error at %S" (nth 4 (org-heading-components))))))
(defun org-bibtex-check (&optional optional) (defun org-bibtex-check (&optional optional)
"Check the current headline for required fields. "Check the current headline for required fields.
@ -560,8 +562,8 @@ With prefix argument OPTIONAL also prompt for optional fields."
(interactive "P") (interactive "P")
(save-restriction (save-restriction
(org-narrow-to-subtree) (org-narrow-to-subtree)
(let ((type ((lambda (name) (when name (intern (concat ":" name)))) (let ((type (let ((name (org-bibtex-get org-bibtex-type-property-name)))
(org-bibtex-get org-bibtex-type-property-name)))) (when name (intern (concat ":" name))))))
(when type (org-bibtex-fleshout type optional))))) (when type (org-bibtex-fleshout type optional)))))
(defun org-bibtex-check-all (&optional optional) (defun org-bibtex-check-all (&optional optional)

14
lisp/org/org-clock.el
View File

@ -1114,6 +1114,7 @@ so long."
(defvar org-clock-current-task nil "Task currently clocked in.") (defvar org-clock-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out (defvar org-clock-out-time nil) ; store the time of the last clock-out
(defvar org--msg-extra)
;;;###autoload ;;;###autoload
(defun org-clock-in (&optional select start-time) (defun org-clock-in (&optional select start-time)
@ -1133,7 +1134,7 @@ make this the default behavior.)"
(catch 'abort (catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p))) (org-clocking-p)))
ts selected-task target-pos (msg-extra "") ts selected-task target-pos (org--msg-extra "")
(leftover (and (not org-clock-resolving-clocks) (leftover (and (not org-clock-resolving-clocks)
org-clock-leftover-time))) org-clock-leftover-time)))
@ -1305,7 +1306,7 @@ make this the default behavior.)"
(setq org-clock-idle-timer nil)) (setq org-clock-idle-timer nil))
(setq org-clock-idle-timer (setq org-clock-idle-timer
(run-with-timer 60 60 'org-resolve-clocks-if-idle)) (run-with-timer 60 60 'org-resolve-clocks-if-idle))
(message "Clock starts at %s - %s" ts msg-extra) (message "Clock starts at %s - %s" ts org--msg-extra)
(run-hooks 'org-clock-in-hook))))))) (run-hooks 'org-clock-in-hook)))))))
;;;###autoload ;;;###autoload
@ -1351,7 +1352,6 @@ for a todo state to switch to, overriding the existing value
(org-back-to-heading t) (org-back-to-heading t)
(move-marker org-clock-default-task (point)))) (move-marker org-clock-default-task (point))))
(defvar msg-extra)
(defun org-clock-get-sum-start () (defun org-clock-get-sum-start ()
"Return the time from which clock times should be counted. "Return the time from which clock times should be counted.
This is for the currently running clock as it is displayed This is for the currently running clock as it is displayed
@ -1364,10 +1364,10 @@ decides which time to use."
(lr (org-entry-get nil "LAST_REPEAT"))) (lr (org-entry-get nil "LAST_REPEAT")))
(cond (cond
((equal cmt "current") ((equal cmt "current")
(setq msg-extra "showing time in current clock instance") (setq org--msg-extra "showing time in current clock instance")
(current-time)) (current-time))
((equal cmt "today") ((equal cmt "today")
(setq msg-extra "showing today's task time.") (setq org--msg-extra "showing today's task time.")
(let* ((dt (decode-time (current-time)))) (let* ((dt (decode-time (current-time))))
(setq dt (append (list 0 0 0) (nthcdr 3 dt))) (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
(if org-extend-today-until (if org-extend-today-until
@ -1376,12 +1376,12 @@ decides which time to use."
((or (equal cmt "all") ((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto")) (and (or (not cmt) (equal cmt "auto"))
(not lr))) (not lr)))
(setq msg-extra "showing entire task time.") (setq org--msg-extra "showing entire task time.")
nil) nil)
((or (equal cmt "repeat") ((or (equal cmt "repeat")
(and (or (not cmt) (equal cmt "auto")) (and (or (not cmt) (equal cmt "auto"))
lr)) lr))
(setq msg-extra "showing task time since last repeat.") (setq org--msg-extra "showing task time since last repeat.")
(if (not lr) (if (not lr)
nil nil
(org-time-string-to-time lr))) (org-time-string-to-time lr)))

8
lisp/org/org-colview.el
View File

@ -416,6 +416,10 @@ If yes, throw an error indicating that changing it does not make sense."
(org-columns-next-allowed-value) (org-columns-next-allowed-value)
(org-columns-edit-value "TAGS"))) (org-columns-edit-value "TAGS")))
(defvar org-agenda-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
Don't set this, this is meant for dynamic scoping.")
(defun org-columns-edit-value (&optional key) (defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view. "Edit the value of the property at point in column view.
Where possible, use the standard interface for changing this line." Where possible, use the standard interface for changing this line."
@ -901,10 +905,6 @@ display, or in the #+COLUMNS line of the current buffer."
(insert-before-markers "#+COLUMNS: " fmt "\n"))) (insert-before-markers "#+COLUMNS: " fmt "\n")))
(org-set-local 'org-columns-default-format fmt)))))) (org-set-local 'org-columns-default-format fmt))))))
(defvar org-agenda-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
Don't set this, this is meant for dynamic scoping.")
(defun org-columns-get-autowidth-alist (s cache) (defun org-columns-get-autowidth-alist (s cache)
"Derive the maximum column widths from the format and the cache." "Derive the maximum column widths from the format and the cache."
(let ((start 0) rtn) (let ((start 0) rtn)

10
lisp/org/org-src.el
View File

@ -844,8 +844,9 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(let ((session (cdr (assoc :session (nth 2 info))))) (let ((session (cdr (assoc :session (nth 2 info)))))
(and session (not (string= session "none")) (and session (not (string= session "none"))
(org-babel-comint-buffer-livep session) (org-babel-comint-buffer-livep session)
((lambda (f) (and (fboundp f) (funcall f session))) (let ((f (intern (format "org-babel-%s-associate-session"
(intern (format "org-babel-%s-associate-session" (nth 0 info))))))) (nth 0 info)))))
(and (fboundp f) (funcall f session))))))
(defun org-src-babel-configure-edit-buffer () (defun org-src-babel-configure-edit-buffer ()
(when org-src-babel-info (when org-src-babel-info
@ -953,8 +954,9 @@ fontification of code blocks see `org-src-fontify-block' and
LANG is a string, and the returned major mode is a symbol." LANG is a string, and the returned major mode is a symbol."
(intern (intern
(concat (concat
((lambda (l) (if (symbolp l) (symbol-name l) l)) (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
(or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) (if (symbolp l) (symbol-name l) l))
"-mode")))
(provide 'org-src) (provide 'org-src)

27
lisp/org/org.el
View File

@ -82,7 +82,7 @@
(require 'org-macs) (require 'org-macs)
(require 'org-compat) (require 'org-compat)
;; `org-outline-regexp' ought to be a defconst but is let-binding in ;; `org-outline-regexp' ought to be a defconst but is let-bound in
;; some places -- e.g. see the macro `org-with-limited-levels'. ;; some places -- e.g. see the macro `org-with-limited-levels'.
;; ;;
;; In Org buffers, the value of `outline-regexp' is that of ;; In Org buffers, the value of `outline-regexp' is that of
@ -304,13 +304,13 @@ When MESSAGE is non-nil, display a message with the version."
org-install-dir org-install-dir
(concat "mixed installation! " org-install-dir " and " org-dir)) (concat "mixed installation! " org-install-dir " and " org-dir))
"org-loaddefs.el can not be found!"))) "org-loaddefs.el can not be found!")))
(_version (if full version org-version))) (version1 (if full version org-version)))
(if (org-called-interactively-p 'interactive) (if (org-called-interactively-p 'interactive)
(if here (if here
(insert version) (insert version)
(message version)) (message version))
(if message (message _version)) (if message (message _version))
_version))) version1)))
(defconst org-version (org-version)) (defconst org-version (org-version))
@ -4804,6 +4804,8 @@ This can be turned on/off through `org-toggle-tags-groups'."
:group 'org-startup :group 'org-startup
:type 'boolean) :type 'boolean)
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defun org-toggle-tags-groups () (defun org-toggle-tags-groups ()
"Toggle support for group tags. "Toggle support for group tags.
Support for group tags is controlled by the option Support for group tags is controlled by the option
@ -5264,7 +5266,6 @@ This variable is set by `org-before-change-function'.
"Every change indicates that a table might need an update." "Every change indicates that a table might need an update."
(setq org-table-may-need-update t)) (setq org-table-may-need-update t))
(defvar org-mode-map) (defvar org-mode-map)
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
(defvar org-inhibit-logging nil) ; Dynamically-scoped param. (defvar org-inhibit-logging nil) ; Dynamically-scoped param.
@ -6714,6 +6715,8 @@ in special contexts.
(setq org-cycle-global-status 'overview) (setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview))))) (run-hook-with-args 'org-cycle-hook 'overview)))))
(defvar org-called-with-limited-levels);Dyn-bound in ̀org-with-limited-levels'.
(defun org-cycle-internal-local () (defun org-cycle-internal-local ()
"Do the local cycling action." "Do the local cycling action."
(let ((goal-column 0) eoh eol eos has-children children-skipped struct) (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
@ -7944,8 +7947,6 @@ even level numbers will become the next higher odd number."
(define-obsolete-function-alias 'org-get-legal-level (define-obsolete-function-alias 'org-get-legal-level
'org-get-valid-level "23.1"))) 'org-get-valid-level "23.1")))
(defvar org-called-with-limited-levels nil) ;; Dynamically bound in
;; ̀org-with-limited-levels'
(defun org-promote () (defun org-promote ()
"Promote the current heading higher up the tree. "Promote the current heading higher up the tree.
If the region is active in `transient-mark-mode', promote all headings If the region is active in `transient-mark-mode', promote all headings
@ -10321,6 +10322,7 @@ Functions in this hook must return t if they identify and follow
a link at point. If they don't find anything interesting at point, a link at point. If they don't find anything interesting at point,
they must return nil.") they must return nil.")
(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el (defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
(defun org-open-at-point (&optional arg reference-buffer) (defun org-open-at-point (&optional arg reference-buffer)
"Open link at or after point. "Open link at or after point.
@ -10696,7 +10698,6 @@ the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)") (set-window-configuration org-window-config-before-follow-link)")
(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
(defun org-link-search (s &optional type avoid-pos stealth) (defun org-link-search (s &optional type avoid-pos stealth)
"Search for a link search option. "Search for a link search option.
If S is surrounded by forward slashes, it is interpreted as a If S is surrounded by forward slashes, it is interpreted as a
@ -13104,6 +13105,9 @@ nil."
(delete-region (point-at-bol) (delete-region (point-at-bol)
(min (point-max) (1+ (point-at-eol)))))))))) (min (point-max) (1+ (point-at-eol))))))))))
(defvar org-time-was-given) ; dynamically scoped parameter
(defvar org-end-time-was-given) ; dynamically scoped parameter
(defun org-add-planning-info (what &optional time &rest remove) (defun org-add-planning-info (what &optional time &rest remove)
"Insert new timestamp with keyword in the line directly after the headline. "Insert new timestamp with keyword in the line directly after the headline.
WHAT indicates what kind of time stamp to add. TIME indicates the time to use. WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
@ -16035,8 +16039,6 @@ Return the position where this entry starts, or nil if there is no such entry."
(defvar org-last-changed-timestamp nil) (defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil (defvar org-last-inserted-timestamp nil
"The last time stamp inserted with `org-insert-time-stamp'.") "The last time stamp inserted with `org-insert-time-stamp'.")
(defvar org-time-was-given) ; dynamically scoped parameter
(defvar org-end-time-was-given) ; dynamically scoped parameter
(defvar org-ts-what) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter
(defun org-time-stamp (arg &optional inactive) (defun org-time-stamp (arg &optional inactive)
@ -16225,6 +16227,10 @@ So these are more for recording a certain time/date."
map) map)
"Keymap for minibuffer commands when using `org-read-date'.") "Keymap for minibuffer commands when using `org-read-date'.")
(defvar org-def)
(defvar org-defdecode)
(defvar org-with-time)
(defun org-read-date (&optional org-with-time to-time from-string prompt (defun org-read-date (&optional org-with-time to-time from-string prompt
default-time default-input inactive) default-time default-input inactive)
"Read a date, possibly a time, and make things smooth for the user. "Read a date, possibly a time, and make things smooth for the user.
@ -16371,9 +16377,6 @@ user."
(nth 2 final) (nth 1 final)) (nth 2 final) (nth 1 final))
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
(defvar org-def)
(defvar org-defdecode)
(defvar org-with-time)
(defun org-read-date-display () (defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer." "Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live (when org-read-date-display-live

11
lisp/org/ox-odt.el
View File

@ -3113,12 +3113,11 @@ and prefix with \"OrgSrc\". For example,
`font-lock-function-name-face' is associated with `font-lock-function-name-face' is associated with
\"OrgSrcFontLockFunctionNameFace\"." \"OrgSrcFontLockFunctionNameFace\"."
(let* ((css-list (hfy-face-to-style fn)) (let* ((css-list (hfy-face-to-style fn))
(style-name ((lambda (fn) (style-name (concat "OrgSrc"
(concat "OrgSrc" (mapconcat
(mapconcat 'capitalize (split-string
'capitalize (split-string (hfy-face-or-def-to-name fn) "-")
(hfy-face-or-def-to-name fn) "-") "")))
""))) fn))
(color-val (cdr (assoc "color" css-list))) (color-val (cdr (assoc "color" css-list)))
(background-color-val (cdr (assoc "background" css-list))) (background-color-val (cdr (assoc "background" css-list)))
(style (and org-odt-create-custom-styles-for-srcblocks (style (and org-odt-create-custom-styles-for-srcblocks