1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-02-08 21:38:10 +00:00

babel: adding new function `org-babel-expand-src-block'

org-babel-expand-body:lang function needs to be implemented by every
  language, and is used to expand the body of a code block for
  execution or tangling
This commit is contained in:
Eric Schulte 2010-04-19 23:40:58 -06:00
parent 788779e16c
commit 2fe12b99f4
2 changed files with 45 additions and 6 deletions

View File

@ -177,17 +177,26 @@ code blocks by language."
(format "block-%d" block-counter))))
(src-lang (first info))
(params (third info))
(body (if (equal "no" (cdr (assoc :noweb params)))
(second info)
(org-babel-expand-noweb-references info)))
(spec (list link source-name params body (third (cdr (assoc src-lang org-babel-tangle-langs)))))
by-lang)
(unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
(unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
(setq blocks (delq (assoc src-lang blocks) blocks))
(setq blocks (cons (cons src-lang (cons spec by-lang)) blocks))))))
(setq blocks
(cons
(cons src-lang
(cons (list link source-name params
(funcall
(intern
(concat "org-babel-expand-body:" src-lang))
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (second info))
params)
(third (cdr (assoc
src-lang org-babel-tangle-langs))))
by-lang)) blocks))))))
;; ensure blocks in the correct order
(setq blocks
(mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks))

View File

@ -41,6 +41,13 @@ then run `org-babel-execute-src-block'."
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe)
(defun org-babel-expand-src-block-maybe ()
"Detect if this is context for a org-babel src-block and if so
then run `org-babel-expand-src-block'."
(interactive)
(let ((info (org-babel-get-src-block-info)))
(if info (progn (org-babel-expand-src-block current-prefix-arg info) t) nil)))
(defadvice org-edit-special (around org-babel-prep-session-for-edit activate)
"Prepare the current source block's session according to it's
header arguments before editing in an org-src buffer. This
@ -255,6 +262,29 @@ block."
result))
(setq call-process-region 'call-process-region-original))))
(defun org-babel-expand-src-block (&optional arg info params)
"Expand the current source code block according to it's header
arguments, and pop open the results in a preview buffer."
(interactive)
;; (message "supplied params=%S" params) ;; debugging
(let* ((info (or info (org-babel-get-src-block-info)))
(lang (first info))
(params (setf (third info)
(sort (org-babel-merge-params (third info) params)
(lambda (el1 el2) (string< (symbol-name (car el1))
(symbol-name (car el2)))))))
(body (setf (second info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references info) (second info))))
(cmd (intern (concat "org-babel-expand-body:" lang)))
(expanded (funcall cmd body params))
(buf (get-buffer-create "*Org-Babel Code Body Preview*")))
(with-current-buffer buf
(insert expanded)
(funcall (intern (concat lang "-mode"))))
(pop-to-buffer buf)))
(defun org-babel-load-in-session (&optional arg info)
"Load the body of the current source-code block. Evaluate the
header arguments for the source block before entering the
@ -533,7 +563,7 @@ with C-c C-c."
(goto-char (match-beginning 0))
(save-match-data ,@body)
(goto-char (match-end 0))))
(unless visited-p (kill-buffer (file-name-nondirectory file)))))
(unless visited-p (kill-buffer (file-name-nondirectory ,file)))))
(defun org-babel-params-from-properties ()
"Return an association list of any source block params which