0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 22:47:56 +00:00

more lightening

This commit is contained in:
Eric Schulte 2010-10-15 09:13:51 -06:00 committed by Dan Davison
parent 07b45a64f2
commit c2dce939e8
4 changed files with 48 additions and 39 deletions

View file

@ -95,15 +95,10 @@ none ----- do not display either code or results upon export"
(message "org-babel-exp processing...")
(save-excursion
(goto-char (match-beginning 0))
(let* ((raw-header (match-string 3))
(info (org-babel-get-src-block-info))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
(lang-headers
(intern (concat "org-babel-default-header-args:" lang)))
(raw-params
(org-babel-parse-header-arguments
(org-babel-clean-text-properties
(mapconcat #'identity (cdr (split-string raw-header)) " "))))
(raw-params (nth 2 info))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(heading (nth 4 (ignore-errors (org-heading-components))))
(link (when org-current-export-file
(org-make-link-string
@ -114,10 +109,10 @@ none ----- do not display either code or results upon export"
;; bail if we couldn't get any info from the block
(when info
(when link
;; resolve parameters in the original file so that headline
;; and file-wide parameters are included
;; attempt to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
;; resolve parameters in the original file so that
;; headline and file-wide parameters are included, attempt
;; to go to the same heading in the original file
(set-buffer (get-file-buffer org-current-export-file))
(save-restriction
(condition-case nil
(org-open-link-from-string link)
@ -138,8 +133,8 @@ none ----- do not display either code or results upon export"
(string= "yes" (cdr (assoc :noweb (nth 2 info)))))
(org-babel-expand-noweb-references
info (get-file-buffer org-current-export-file))
(nth 1 info))))
(org-babel-exp-do-export info 'block))))
(nth 1 info)))
(org-babel-exp-do-export info 'block)))))
(defun org-babel-exp-inline-src-blocks (start end)
"Process inline source blocks between START and END for export.

View file

@ -50,7 +50,7 @@ To add files to this list use the `org-babel-lob-ingest' command."
(interactive "f")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
(let* ((info (org-babel-get-src-block-info))
(let* ((info (org-babel-get-src-block-info 'light))
(source-name (nth 4 info)))
(when source-name
(setq source-name (intern source-name)

View file

@ -61,11 +61,8 @@
"Convert PARAMS to variable names and values.
Takes a parameter alist, and return an alist of variable names,
and the emacs-lisp representation of the related value."
(let ((assignments
(delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params)))
(others
(delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params))))
(mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments)))
(mapcar (lambda (el) (org-babel-ref-parse (cdr el)))
(org-babel-get-header params :var)))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")

View file

@ -138,34 +138,51 @@ remove code block execution from the C-c C-c keybinding."
"{\\([^\f\n\r\v]+?\\)}\\)")
"Regexp used to identify inline src-blocks.")
(defun org-babel-get-src-block-info ()
(defun org-babel-get-header (params key &optional others)
"Select only header argument of type KEY from a list.
Optional argument OTHERS indicates that only the header that do
not match KEY should be returned."
(delq nil (mapcar
(lambda (p) (when ((if others #'not #'identity) (eq (car p) key)) p))
params)))
(defun org-babel-get-src-block-info (&optional light)
"Get information on the current source block.
Optional argument LIGHT does not resolve remote variable
references; a process which could likely result in the execution
of other code blocks.
Returns a list
(language body header-arguments-alist switches name function-args indent)."
(let ((case-fold-search t) head info name args indent)
(language body header-arguments-alist switches name indent)."
(let ((case-fold-search t) head info name indent)
;; full code block
(if (setq head (org-babel-where-is-src-block-head))
(save-excursion
(save-excursion
(goto-char head)
(setq info (org-babel-parse-src-block-match))
(setq indent (car (last info)))
(setq info (butlast info))
(forward-line -1)
(when (and (looking-at org-babel-src-name-w-name-regexp)
(setq name (match-string 2)))
(setq name (org-babel-clean-text-properties name))
(when (setq args (match-string 4))
(setq args (mapcar
(lambda (ref) (cons :var ref))
(org-babel-ref-split-args args)))
(setf (nth 2 info)
(org-babel-merge-params args (nth 2 info)))))
(append info (list name args indent)))
(if (save-excursion ;; inline source block
(re-search-backward "[ \f\t\n\r\v]" nil t)
(looking-at org-babel-inline-src-block-regexp))
(org-babel-parse-inline-src-block-match)
nil))))
(when (looking-at org-babel-src-name-w-name-regexp)
(setq name (org-babel-clean-text-properties (match-string 2)))
(when (match-string 4)
(setf (nth 2 info) ;; merge functional-syntax vars and header-args
(org-babel-merge-params
(mapcar (lambda (ref) (cons :var ref))
(org-babel-ref-split-args (match-string 4)))
(nth 2 info)))))
(append info (list name indent)))
;; inline source block
(when (save-excursion (re-search-backward "[ \f\t\n\r\v]" nil t)
(looking-at org-babel-inline-src-block-regexp))
(setq info (org-babel-parse-inline-src-block-match))))
;; resolve variable references
(when (and info (not light))
(setf (nth 2 info)
(append (org-babel-ref-variables (nth 2 info))
(org-babel-get-header (nth 2 info) :var 'other))))
info))
(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.