mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Update to Org 9.5

Browse source
This commit is contained in:
Kyle Meyer 2021-09-29 18:48:59 -04:00
parent dc94ca7b2b
commit bf9ec3d91a
120 changed files with 12483 additions and 5416 deletions
Download patch file Download diff file Expand all files Collapse all files

162
lisp/org/ob-core.el
View file

@ -290,9 +290,9 @@ environment, to override this check."
(format "Evaluate this %s code block%son your system? "
lang name-string)))
(progn
(message "Evaluation of this %s code block%sis aborted."
lang name-string)
nil)))
(message "Evaluation of this %s code block%sis aborted."
lang name-string)
nil)))
(x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x)))))
;;;###autoload
@ -472,7 +472,35 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.")
"Default arguments to use when evaluating a source block.
This is a list in which each element is an alist. Each key
corresponds to a header argument, and each value to that header's
value. The value can either be a string or a closure that
evaluates to a string. The closure is evaluated when the source
block is being evaluated (e.g. during execution or export), with
point at the source block. It is not possible to use an
arbitrary function symbol (e.g. 'some-func), since org uses
lexical binding. To achieve the same functionality, call the
function within a closure (e.g. (lambda () (some-func))).
To understand how closures can be used as default header
arguments, imagine you'd like to set the file name output of a
latex source block to a sha1 of its contents. We could achieve
this with:
(defun org-src-sha ()
(let ((elem (org-element-at-point)))
(concat (sha1 (org-element-property :value elem)) \".svg\")))
(setq org-babel-default-header-args:latex
`((:results . \"file link replace\")
(:file . (lambda () (org-src-sha)))))
Because the closure is evaluated with point at the source block,
the call to `org-element-at-point' above will always retrieve
information about the current source block.")
(put 'org-babel-default-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
@ -538,7 +566,7 @@ to raise errors for all languages.")
"Number of initial characters to show of a hidden results hash.")
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'")
"Hook for functions to be called after `org-babel-execute-src-block'.")
(defun org-babel-named-src-block-regexp-for-name (&optional name)
"Generate a regexp used to match a source block named NAME.
@ -581,7 +609,17 @@ multiple blocks are being executed (e.g., in chained execution
through use of the :var header argument) this marker points to
the outer-most code block.")
(defvar *this*)
(defun org-babel-eval-headers (headers)
"Compute header list set with HEADERS.
Evaluate all header arguments set to functions prior to returning
the list of header arguments."
(let ((lst nil))
(dolist (elem headers)
(if (and (cdr elem) (functionp (cdr elem)))
(push `(,(car elem) . ,(funcall (cdr elem))) lst)
(push elem lst)))
(reverse lst)))
(defun org-babel-get-src-block-info (&optional light datum)
"Extract information from a source block or inline source block.
@ -646,6 +684,16 @@ a list with the following pattern:
(replace-regexp-in-string
(org-src-coderef-regexp coderef) "" expand nil nil 1))))
(defun org-babel--file-desc (params result)
"Retrieve file description."
(pcase (assq :file-desc params)
(`nil nil)
(`(:file-desc) result)
(`(:file-desc . ,(and (pred stringp) val)) val)))
(defvar *this*) ; Dynamically bound in `org-babel-execute-src-block'
; and `org-babel-read'
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
@ -749,8 +797,7 @@ block."
(let ((*this* (if (not file) result
(org-babel-result-to-file
file
(let ((desc (assq :file-desc params)))
(and desc (or (cdr desc) result)))))))
(org-babel--file-desc params result)))))
(setq result (org-babel-ref-resolve post))
(when file
(setq result-params (remove "file" result-params))))))
@ -802,27 +849,6 @@ arguments and pop open the results in a preview buffer."
expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
(defun org-babel-edit-distance (s1 s2)
"Return the edit (levenshtein) distance between strings S1 S2."
(let* ((l1 (length s1))
(l2 (length s2))
(dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
(number-sequence 1 (1+ l1)))))
(in (lambda (i j) (aref (aref dist i) j))))
(setf (aref (aref dist 0) 0) 0)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist 0) j) j))
(dolist (i (number-sequence 1 l1))
(setf (aref (aref dist i) 0) i)
(dolist (j (number-sequence 1 l2))
(setf (aref (aref dist i) j)
(min
(1+ (funcall in (1- i) j))
(1+ (funcall in i (1- j)))
(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
(funcall in (1- i) (1- j)))))))
(funcall in l1 l2)))
(defun org-babel-combine-header-arg-lists (original &rest others)
"Combine a number of lists of header argument names and arguments."
(let ((results (copy-sequence original)))
@ -851,7 +877,7 @@ arguments and pop open the results in a preview buffer."
(match-string 4))))))
(dolist (name names)
(when (and (not (string= header name))
(<= (org-babel-edit-distance header name) too-close)
(<= (org-string-distance header name) too-close)
(not (member header names)))
(error "Supplied header \"%S\" is suspiciously close to \"%S\""
header name))))
@ -1446,7 +1472,7 @@ portions of results lines."
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
#'org-babel-show-result-all 'append 'local)))
#'org-babel-show-result-all 'append 'local)))
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
@ -1550,11 +1576,11 @@ balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
(first= (lambda (str) (= ch (aref str 0)))))
(reverse
(cl-reduce (lambda (acc el)
(let ((head (car acc)))
(if (and head (or (funcall last= head) (funcall first= el)))
(cons (concat head el) (cdr acc))
(cons el acc))))
list :initial-value nil))))
(let ((head (car acc)))
(if (and head (or (funcall last= head) (funcall first= el)))
(cons (concat head el) (cdr acc))
(cons el acc))))
list :initial-value nil))))
(defun org-babel-parse-header-arguments (string &optional no-eval)
"Parse header arguments in STRING.
@ -1628,7 +1654,7 @@ shown below.
(t 'value))))
(cl-remove-if
(lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
:result-type :var)))
:result-type :var)))
params))))
;; row and column names
@ -1698,9 +1724,12 @@ of the vars, cnames and rnames."
(list
(mapcar
(lambda (var)
(when (listp (cdr var))
(when (proper-list-p (cdr var))
(when (and (not (equal colnames "no"))
(or colnames (and (eq (nth 1 (cdr var)) 'hline)
;; Compatibility note: avoid `length>', which
;; isn't available until Emacs 28.
(or colnames (and (> (length (cdr var)) 1)
(eq (nth 1 (cdr var)) 'hline)
(not (member 'hline (cddr (cdr var)))))))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
@ -1720,7 +1749,7 @@ of the vars, cnames and rnames."
(defun org-babel-reassemble-table (table colnames rownames)
"Add column and row names to a table.
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)
(let ((table (if (and rownames (= (length table) (length rownames)))
(org-babel-put-rownames table rownames) table)))
@ -1755,7 +1784,7 @@ If the point is not on a source block then return nil."
"Go to the beginning of the current code block."
(interactive)
(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"))))
;;;###autoload
(defun org-babel-goto-named-src-block (name)
@ -2199,6 +2228,10 @@ silent -- no results are inserted into the Org buffer but
ingested by Emacs (a potentially time consuming
process).
none ---- no results are inserted into the Org buffer nor
echoed to the minibuffer. they are not processed into
Emacs-lisp objects at all.
file ---- the results are interpreted as a file path, and are
inserted into the buffer using the Org file syntax.
@ -2256,9 +2289,8 @@ INFO may provide the values of these header arguments (in the
(setq result (org-no-properties result))
(when (member "file" result-params)
(setq result (org-babel-result-to-file
result (when (assq :file-desc (nth 2 info))
(or (cdr (assq :file-desc (nth 2 info)))
result))))))
result
(org-babel--file-desc (nth 2 info) result)))))
((listp result))
(t (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
@ -2324,7 +2356,7 @@ INFO may provide the values of these header arguments (in the
(if results-switches (concat " " results-switches) ""))
(let ((wrap
(lambda (start finish &optional no-escape no-newlines
inline-start inline-finish)
inline-start inline-finish)
(when inline
(setq start inline-start)
(setq finish inline-finish)
@ -2553,8 +2585,9 @@ in the buffer."
(let ((element (org-element-at-point)))
(if (memq (org-element-type element)
;; Possible results types.
'(drawer example-block export-block fixed-width item
plain-list special-block src-block table))
'(drawer example-block export-block fixed-width
special-block src-block item plain-list table
latex-environment))
(save-excursion
(goto-char (min (point-max) ;for narrowed buffers
(org-element-property :end element)))
@ -2570,9 +2603,9 @@ file's directory then expand relative links."
(let ((same-directory?
(and (buffer-file-name (buffer-base-buffer))
(not (string= (expand-file-name default-directory)
(expand-file-name
(file-name-directory
(buffer-file-name (buffer-base-buffer)))))))))
(expand-file-name
(file-name-directory
(buffer-file-name (buffer-base-buffer)))))))))
(format "[[file:%s]%s]"
(if (and default-directory
(buffer-file-name (buffer-base-buffer)) same-directory?)
@ -2706,12 +2739,17 @@ parameters when merging lists."
results-exclusive-groups
results
(split-string
(if (stringp value) value (eval value t))))))
(cond ((stringp value) value)
((functionp value) (funcall value))
(t (eval value t)))))))
(`(:exports . ,value)
(setq exports (funcall merge
exports-exclusive-groups
exports
(split-string (or value "")))))
(split-string
(cond ((and value (functionp value)) (funcall value))
(value value)
(t ""))))))
;; Regular keywords: any value overwrites the previous one.
(_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
;; Handle `:var' and clear out colnames and rownames for replaced
@ -2726,14 +2764,14 @@ parameters when merging lists."
(cdr (assq param params))))
(setq params
(cl-remove-if (lambda (pair) (and (equal (car pair) param)
(null (cdr pair))))
(null (cdr pair))))
params)))))
;; Handle other special keywords, which accept multiple values.
(setq params (nconc (list (cons :results (mapconcat #'identity results " "))
(cons :exports (mapconcat #'identity exports " ")))
params))
;; Return merged params.
params))
(org-babel-eval-headers params)))
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
@ -2842,8 +2880,6 @@ block but are passed literally to the \"example-block\"."
(setq cache nil)
(let ((raw (org-babel-ref-resolve id)))
(if (stringp raw) raw (format "%S" raw))))
;; Retrieve from the Library of Babel.
((nth 2 (assoc-string id org-babel-library-of-babel)))
;; Return the contents of headlines literally.
((org-babel-ref-goto-headline-id id)
(org-babel-ref-headline-body))
@ -2856,6 +2892,8 @@ block but are passed literally to the \"example-block\"."
(not (org-in-commented-heading-p))
(funcall expand-body
(org-babel-get-src-block-info t))))))
;; Retrieve from the Library of Babel.
((nth 2 (assoc-string id org-babel-library-of-babel)))
;; All Noweb references were cached in a previous
;; run. Extract the information from the cache.
((hash-table-p cache)
@ -2976,7 +3014,7 @@ block but are passed literally to the \"example-block\"."
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
Otherwise if CELL looks like lisp (meaning it starts with a
Otherwise if CELL looks like Lisp (meaning it starts with a
\"(\", \"\\='\", \"\\=`\" or a \"[\") then read and evaluate it as
lisp, otherwise return it unmodified as a string. Optional
argument INHIBIT-LISP-EVAL inhibits lisp evaluation for
@ -3148,7 +3186,7 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(and entry
(consp entry)
(cond ((functionp (cdr entry))
(funcall (cdr entry) (cdr pair)))
(funcall (cdr entry) (cdr pair)))
((listp (cdr entry))
(member (cdr pair) (cdr entry)))
(t nil)))))))
@ -3168,10 +3206,10 @@ Otherwise, the :file parameter is treated as a full file name,
and the output file name is the directory (as calculated above)
plus the parameter value."
(let* ((file-cons (assq :file params))
(file-ext-cons (assq :file-ext params))
(file-ext (cdr-safe file-ext-cons))
(dir (cdr-safe (assq :output-dir params)))
fname)
(file-ext-cons (assq :file-ext params))
(file-ext (cdr-safe file-ext-cons))
(dir (cdr-safe (assq :output-dir params)))
fname)
;; create the output-dir if it does not exist
(when dir
(make-directory dir t))