2016-06-18 18:05:25 -04:00
|
|
|
;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
|
2009-06-14 21:30:29 -04:00
|
|
|
|
2017-01-05 20:19:23 -05:00
|
|
|
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
|
2009-06-14 21:30:29 -04:00
|
|
|
|
2009-10-29 19:03:43 -04:00
|
|
|
;; Author: Eric Schulte
|
2009-06-14 21:30:29 -04:00
|
|
|
;; Keywords: literate programming, reproducible research
|
|
|
|
;; Homepage: http://orgmode.org
|
|
|
|
|
2010-06-25 12:20:39 -04:00
|
|
|
;; This file is part of GNU Emacs.
|
2009-06-14 21:30:29 -04:00
|
|
|
|
2010-06-25 12:20:39 -04:00
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2009-06-14 21:30:29 -04:00
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2010-06-25 12:20:39 -04:00
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
2009-06-14 21:30:29 -04:00
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
2010-06-25 12:20:39 -04:00
|
|
|
|
2009-06-14 21:30:29 -04:00
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 18:52:52 -04:00
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2009-06-14 21:30:29 -04:00
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;; Extract the code from source blocks out into raw source-code files.
|
|
|
|
|
|
|
|
;;; Code:
|
2016-07-25 10:34:48 -04:00
|
|
|
|
|
|
|
(require 'cl-lib)
|
2010-06-23 14:24:33 -04:00
|
|
|
(require 'org-src)
|
2016-12-10 03:54:55 -05:00
|
|
|
(require 'org-macs)
|
2009-06-14 21:30:29 -04:00
|
|
|
|
2015-06-15 18:09:20 -04:00
|
|
|
(declare-function make-directory "files" (dir &optional parents))
|
2016-01-31 05:37:05 -05:00
|
|
|
(declare-function org-at-heading-p "org" (&optional ignored))
|
2016-05-14 22:56:53 -04:00
|
|
|
(declare-function org-babel-update-block-body "ob-core" (new-body))
|
|
|
|
(declare-function org-back-to-heading "org" (&optional invisible-ok))
|
2015-06-15 18:09:20 -04:00
|
|
|
(declare-function org-before-first-heading-p "org" ())
|
2016-01-31 05:37:05 -05:00
|
|
|
(declare-function org-element-at-point "org-element" ())
|
|
|
|
(declare-function org-element-type "org-element" (element))
|
2015-06-15 18:09:20 -04:00
|
|
|
(declare-function org-fill-template "org" (template alist))
|
|
|
|
(declare-function org-heading-components "org" ())
|
|
|
|
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
|
2016-05-14 22:56:53 -04:00
|
|
|
(declare-function org-link-escape "org" (text &optional table merge))
|
2013-06-01 05:21:48 -04:00
|
|
|
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
|
2016-06-21 09:24:06 -04:00
|
|
|
(declare-function org-remove-indentation "org" (code &optional n))
|
2015-06-15 18:09:20 -04:00
|
|
|
(declare-function org-store-link "org" (arg))
|
2016-06-21 09:24:06 -04:00
|
|
|
(declare-function org-trim "org" (s &optional keep-lead))
|
2015-06-15 18:09:20 -04:00
|
|
|
(declare-function outline-previous-heading "outline" ())
|
2016-09-28 08:07:56 -04:00
|
|
|
(declare-function org-id-find "org-id" (id &optional markerp))
|
2010-06-23 14:24:33 -04:00
|
|
|
|
2016-01-02 11:40:22 -05:00
|
|
|
(defvar org-link-types-re)
|
|
|
|
|
2010-06-17 12:01:24 -04:00
|
|
|
(defcustom org-babel-tangle-lang-exts
|
2014-03-05 10:49:30 -05:00
|
|
|
'(("emacs-lisp" . "el")
|
|
|
|
("elisp" . "el"))
|
2010-06-17 12:01:24 -04:00
|
|
|
"Alist mapping languages to their file extensions.
|
|
|
|
The key is the language name, the value is the string that should
|
|
|
|
be inserted as the extension commonly used to identify files
|
|
|
|
written in this language. If no entry is found in this list,
|
|
|
|
then the name of the language is used."
|
|
|
|
:group 'org-babel-tangle
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2010-06-17 12:01:24 -04:00
|
|
|
:type '(repeat
|
|
|
|
(cons
|
|
|
|
(string "Language name")
|
|
|
|
(string "File Extension"))))
|
2010-05-27 18:32:10 -04:00
|
|
|
|
2013-10-09 12:00:28 -04:00
|
|
|
(defcustom org-babel-tangle-use-relative-file-links t
|
2016-08-23 16:13:56 -04:00
|
|
|
"Use relative path names in links from tangled source back the Org file."
|
2013-10-09 12:00:28 -04:00
|
|
|
:group 'org-babel-tangle
|
|
|
|
:type 'boolean)
|
|
|
|
|
2010-07-08 14:53:51 -04:00
|
|
|
(defcustom org-babel-post-tangle-hook nil
|
|
|
|
"Hook run in code files tangled by `org-babel-tangle'."
|
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2010-07-08 14:53:51 -04:00
|
|
|
:type 'hook)
|
|
|
|
|
2010-09-03 09:51:13 -04:00
|
|
|
(defcustom org-babel-pre-tangle-hook '(save-buffer)
|
|
|
|
"Hook run at the beginning of `org-babel-tangle'."
|
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2010-09-03 09:51:13 -04:00
|
|
|
:type 'hook)
|
|
|
|
|
2011-03-14 11:31:33 -04:00
|
|
|
(defcustom org-babel-tangle-body-hook nil
|
|
|
|
"Hook run over the contents of each code block body."
|
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2011-03-14 11:31:33 -04:00
|
|
|
:type 'hook)
|
|
|
|
|
2010-10-29 03:37:28 -04:00
|
|
|
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
|
2010-09-05 17:12:43 -04:00
|
|
|
"Format of inserted comments in tangled code files.
|
|
|
|
The following format strings can be used to insert special
|
|
|
|
information into the output using `org-fill-template'.
|
|
|
|
%start-line --- the line number at the start of the code block
|
|
|
|
%file --------- the file from which the code block was tangled
|
2016-08-23 16:13:56 -04:00
|
|
|
%link --------- Org style link to the code block
|
2010-10-17 13:18:20 -04:00
|
|
|
%source-name -- name of the code block
|
|
|
|
|
2014-06-07 11:29:03 -04:00
|
|
|
Upon insertion the formatted comment will be commented out, and
|
|
|
|
followed by a newline. To inhibit this post-insertion processing
|
|
|
|
set the `org-babel-tangle-uncomment-comments' variable to a
|
|
|
|
non-nil value.
|
|
|
|
|
2010-10-17 13:18:20 -04:00
|
|
|
Whether or not comments are inserted during tangling is
|
|
|
|
controlled by the :comments header argument."
|
2010-09-05 17:12:43 -04:00
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2010-09-05 17:12:43 -04:00
|
|
|
:type 'string)
|
|
|
|
|
2010-10-29 03:37:28 -04:00
|
|
|
(defcustom org-babel-tangle-comment-format-end "%source-name ends here"
|
2010-09-05 17:12:43 -04:00
|
|
|
"Format of inserted comments in tangled code files.
|
|
|
|
The following format strings can be used to insert special
|
|
|
|
information into the output using `org-fill-template'.
|
|
|
|
%start-line --- the line number at the start of the code block
|
|
|
|
%file --------- the file from which the code block was tangled
|
2016-08-23 16:13:56 -04:00
|
|
|
%link --------- Org style link to the code block
|
2010-10-17 13:18:20 -04:00
|
|
|
%source-name -- name of the code block
|
|
|
|
|
2014-06-07 11:29:03 -04:00
|
|
|
Upon insertion the formatted comment will be commented out, and
|
|
|
|
followed by a newline. To inhibit this post-insertion processing
|
|
|
|
set the `org-babel-tangle-uncomment-comments' variable to a
|
|
|
|
non-nil value.
|
|
|
|
|
2010-10-17 13:18:20 -04:00
|
|
|
Whether or not comments are inserted during tangling is
|
|
|
|
controlled by the :comments header argument."
|
2010-09-05 17:12:43 -04:00
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2010-09-05 17:12:43 -04:00
|
|
|
:type 'string)
|
|
|
|
|
2014-06-07 11:29:03 -04:00
|
|
|
(defcustom org-babel-tangle-uncomment-comments nil
|
|
|
|
"Inhibits automatic commenting and addition of trailing newline
|
|
|
|
of tangle comments. Use `org-babel-tangle-comment-format-beg'
|
|
|
|
and `org-babel-tangle-comment-format-end' to customize the format
|
|
|
|
of tangled comments."
|
|
|
|
:group 'org-babel
|
|
|
|
:type 'boolean)
|
|
|
|
|
2016-06-18 18:05:25 -04:00
|
|
|
(defcustom org-babel-process-comment-text 'org-remove-indentation
|
2016-08-23 16:13:56 -04:00
|
|
|
"Function called to process raw Org text collected to be
|
2011-09-15 18:00:10 -04:00
|
|
|
inserted as comments in tangled source-code files. The function
|
|
|
|
should take a single string argument and return a string
|
2013-11-23 17:57:29 -05:00
|
|
|
result. The default value is `org-remove-indentation'."
|
2011-09-15 18:00:10 -04:00
|
|
|
:group 'org-babel
|
2012-03-19 16:38:12 -04:00
|
|
|
:version "24.1"
|
2011-09-15 18:00:10 -04:00
|
|
|
:type 'function)
|
|
|
|
|
2010-07-28 09:34:08 -04:00
|
|
|
(defun org-babel-find-file-noselect-refresh (file)
|
|
|
|
"Find file ensuring that the latest changes on disk are
|
|
|
|
represented in the file."
|
2013-06-07 06:43:55 -04:00
|
|
|
(find-file-noselect file 'nowarn)
|
2010-07-28 09:34:08 -04:00
|
|
|
(with-current-buffer (get-file-buffer file)
|
|
|
|
(revert-buffer t t t)))
|
|
|
|
|
2010-07-16 18:55:40 -04:00
|
|
|
(defmacro org-babel-with-temp-filebuffer (file &rest body)
|
|
|
|
"Open FILE into a temporary buffer execute BODY there like
|
|
|
|
`progn', then kill the FILE buffer returning the result of
|
|
|
|
evaluating BODY."
|
|
|
|
(declare (indent 1))
|
2012-08-03 15:33:31 -04:00
|
|
|
(let ((temp-path (make-symbol "temp-path"))
|
|
|
|
(temp-result (make-symbol "temp-result"))
|
2010-07-28 09:34:08 -04:00
|
|
|
(temp-file (make-symbol "temp-file"))
|
2010-07-28 20:45:34 -04:00
|
|
|
(visited-p (make-symbol "visited-p")))
|
2012-08-03 15:33:31 -04:00
|
|
|
`(let* ((,temp-path ,file)
|
|
|
|
(,visited-p (get-file-buffer ,temp-path))
|
|
|
|
,temp-result ,temp-file)
|
|
|
|
(org-babel-find-file-noselect-refresh ,temp-path)
|
|
|
|
(setf ,temp-file (get-file-buffer ,temp-path))
|
2010-07-28 09:34:08 -04:00
|
|
|
(with-current-buffer ,temp-file
|
|
|
|
(setf ,temp-result (progn ,@body)))
|
|
|
|
(unless ,visited-p (kill-buffer ,temp-file))
|
2010-07-16 18:55:40 -04:00
|
|
|
,temp-result)))
|
Provide edebug specifications for macros
* org-macs.el (org-with-gensyms, org-called-interactively-p)
(with-silent-modifications, org-bound-and-true-p)
(org-unmodified, org-re, org-preserve-lc)
(org-without-partial-completion, org-with-point-at)
(org-no-warnings, org-if-unprotected, org-if-unprotected-1)
(org-if-unprotected-at, org-with-remote-undo)
(org-no-read-only, org-save-outline-visibility)
(org-with-wide-buffer, org-with-limited-levels)
(org-eval-in-environment): Provide edebug specifications.
* org-src.el (org-src-do-at-code-block): Dto.
* org-publish.el (org-publish-with-aux-preprocess-maybe): Dto.
* org-compat.el (org-xemacs-without-invisibility): Dto.
* org-clock.el (org-with-clock-position, org-with-clock): Dto.
* org-agenda.el (org-agenda-with-point-at-orig-entry)
(org-batch-agenda, org-batch-agenda-csv)
(org-batch-store-agenda-views): Dto.
* ob.el (org-babel-do-in-edit-buffer)
(org-babel-map-src-blocks, org-babel-map-inline-src-blocks): Dto.
* ob-tangle.el (org-babel-with-temp-filebuffer): Dto.
* ob-table.el (sbe): Dto.
* ob-exp.el (org-babel-exp-in-export-file): Dto.
* ob-comint.el (org-babel-comint-in-buffer)
(org-babel-comint-with-output): Dto.
2011-08-11 02:57:25 -04:00
|
|
|
(def-edebug-spec org-babel-with-temp-filebuffer (form body))
|
2010-07-16 18:55:40 -04:00
|
|
|
|
2010-06-23 14:24:33 -04:00
|
|
|
;;;###autoload
|
2009-07-30 10:57:26 -04:00
|
|
|
(defun org-babel-tangle-file (file &optional target-file lang)
|
2010-07-13 19:20:08 -04:00
|
|
|
"Extract the bodies of source code blocks in FILE.
|
|
|
|
Source code blocks are extracted with `org-babel-tangle'.
|
|
|
|
Optional argument TARGET-FILE can be used to specify a default
|
|
|
|
export file for all source blocks. Optional argument LANG can be
|
2013-11-04 06:19:45 -05:00
|
|
|
used to limit the exported source code blocks by language.
|
|
|
|
Return a list whose CAR is the tangled file name."
|
2009-10-20 10:17:42 -04:00
|
|
|
(interactive "fFile to tangle: \nP")
|
2010-06-02 09:18:36 -04:00
|
|
|
(let ((visited-p (get-file-buffer (expand-file-name file)))
|
|
|
|
to-be-removed)
|
2013-11-04 06:19:45 -05:00
|
|
|
(prog1
|
|
|
|
(save-window-excursion
|
|
|
|
(find-file file)
|
|
|
|
(setq to-be-removed (current-buffer))
|
2015-10-02 23:19:40 -04:00
|
|
|
(mapcar #'expand-file-name (org-babel-tangle nil target-file lang)))
|
2013-11-04 06:19:45 -05:00
|
|
|
(unless visited-p
|
|
|
|
(kill-buffer to-be-removed)))))
|
2009-07-14 21:26:15 -04:00
|
|
|
|
2010-04-12 01:54:31 -04:00
|
|
|
(defun org-babel-tangle-publish (_ filename pub-dir)
|
|
|
|
"Tangle FILENAME and place the results in PUB-DIR."
|
2015-10-03 18:08:52 -04:00
|
|
|
(unless (file-exists-p pub-dir)
|
|
|
|
(make-directory pub-dir t))
|
2017-09-11 01:22:55 -04:00
|
|
|
(setq pub-dir (file-name-as-directory pub-dir))
|
2010-04-12 01:54:31 -04:00
|
|
|
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
|
|
|
|
|
2010-06-23 14:24:33 -04:00
|
|
|
;;;###autoload
|
2013-03-02 12:10:39 -05:00
|
|
|
(defun org-babel-tangle (&optional arg target-file lang)
|
2010-07-13 19:20:08 -04:00
|
|
|
"Write code blocks to source-specific files.
|
|
|
|
Extract the bodies of all source code blocks from the current
|
2013-03-02 09:27:25 -05:00
|
|
|
file into their own source-specific files.
|
|
|
|
With one universal prefix argument, only tangle the block at point.
|
|
|
|
When two universal prefix arguments, only tangle blocks for the
|
|
|
|
tangle file of the block at point.
|
|
|
|
Optional argument TARGET-FILE can be used to specify a default
|
|
|
|
export file for all source blocks. Optional argument LANG can be
|
|
|
|
used to limit the exported source code blocks by language."
|
2011-06-17 19:41:50 -04:00
|
|
|
(interactive "P")
|
2010-09-03 09:51:13 -04:00
|
|
|
(run-hooks 'org-babel-pre-tangle-hook)
|
2013-03-02 09:27:25 -05:00
|
|
|
;; Possibly Restrict the buffer to the current code block
|
2011-06-17 19:41:50 -04:00
|
|
|
(save-restriction
|
2013-10-31 01:47:44 -04:00
|
|
|
(save-excursion
|
|
|
|
(when (equal arg '(4))
|
|
|
|
(let ((head (org-babel-where-is-src-block-head)))
|
2013-03-02 11:15:08 -05:00
|
|
|
(if head
|
|
|
|
(goto-char head)
|
|
|
|
(user-error "Point is not in a source code block"))))
|
2012-08-10 09:40:00 -04:00
|
|
|
(let ((block-counter 0)
|
|
|
|
(org-babel-default-header-args
|
|
|
|
(if target-file
|
|
|
|
(org-babel-merge-params org-babel-default-header-args
|
|
|
|
(list (cons :tangle target-file)))
|
|
|
|
org-babel-default-header-args))
|
2013-03-02 09:27:25 -05:00
|
|
|
(tangle-file
|
|
|
|
(when (equal arg '(16))
|
2016-09-22 13:45:15 -04:00
|
|
|
(or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
|
2013-03-02 11:15:08 -05:00
|
|
|
(user-error "Point is not in a source code block"))))
|
2012-08-10 09:40:00 -04:00
|
|
|
path-collector)
|
|
|
|
(mapc ;; map over all languages
|
|
|
|
(lambda (by-lang)
|
|
|
|
(let* ((lang (car by-lang))
|
|
|
|
(specs (cdr by-lang))
|
|
|
|
(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
|
|
|
|
(lang-f (intern
|
|
|
|
(concat
|
|
|
|
(or (and (cdr (assoc lang org-src-lang-modes))
|
|
|
|
(symbol-name
|
|
|
|
(cdr (assoc lang org-src-lang-modes))))
|
|
|
|
lang)
|
|
|
|
"-mode")))
|
|
|
|
she-banged)
|
|
|
|
(mapc
|
|
|
|
(lambda (spec)
|
|
|
|
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
|
|
|
|
(let* ((tangle (funcall get-spec :tangle))
|
Backport changes from Emacs revs 115081 and 115082
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>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 14:57:31 -05:00
|
|
|
(she-bang (let ((sheb (funcall get-spec :shebang)))
|
|
|
|
(when (> (length sheb) 0) sheb)))
|
2013-06-08 14:29:02 -04:00
|
|
|
(tangle-mode (funcall get-spec :tangle-mode))
|
2012-08-10 09:40:00 -04:00
|
|
|
(base-name (cond
|
|
|
|
((string= "yes" tangle)
|
|
|
|
(file-name-sans-extension
|
2015-09-08 23:48:44 -04:00
|
|
|
(nth 1 spec)))
|
2012-08-10 09:40:00 -04:00
|
|
|
((string= "no" tangle) nil)
|
|
|
|
((> (length tangle) 0) tangle)))
|
|
|
|
(file-name (when base-name
|
|
|
|
;; decide if we want to add ext to base-name
|
|
|
|
(if (and ext (string= "yes" tangle))
|
|
|
|
(concat base-name "." ext) base-name))))
|
|
|
|
(when file-name
|
Backport changes from Emacs revs 115081 and 115082
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>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 14:57:31 -05:00
|
|
|
;; Possibly create the parent directories for file.
|
2014-05-03 04:12:10 -04:00
|
|
|
(let ((m (funcall get-spec :mkdirp))
|
|
|
|
(fnd (file-name-directory file-name)))
|
|
|
|
(and m fnd (not (string= m "no"))
|
|
|
|
(make-directory fnd 'parents)))
|
2012-08-10 09:40:00 -04:00
|
|
|
;; delete any old versions of file
|
2014-05-03 04:12:10 -04:00
|
|
|
(and (file-exists-p file-name)
|
|
|
|
(not (member file-name (mapcar #'car path-collector)))
|
|
|
|
(delete-file file-name))
|
2016-12-09 18:19:45 -05:00
|
|
|
;; drop source-block to file
|
|
|
|
(with-temp-buffer
|
|
|
|
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
|
|
|
|
(when (and she-bang (not (member file-name she-banged)))
|
|
|
|
(insert (concat she-bang "\n"))
|
|
|
|
(setq she-banged (cons file-name she-banged)))
|
|
|
|
(org-babel-spec-to-string spec)
|
|
|
|
;; We avoid append-to-file as it does not work with tramp.
|
|
|
|
(let ((content (buffer-string)))
|
|
|
|
(with-temp-buffer
|
|
|
|
(when (file-exists-p file-name)
|
|
|
|
(insert-file-contents file-name))
|
|
|
|
(goto-char (point-max))
|
|
|
|
;; Handle :padlines unless first line in file
|
|
|
|
(unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
|
|
|
|
(= (point) (point-min)))
|
|
|
|
(insert "\n"))
|
|
|
|
(insert content)
|
|
|
|
(write-region nil nil file-name))))
|
2013-06-10 11:55:28 -04:00
|
|
|
;; if files contain she-bangs, then make the executable
|
|
|
|
(when she-bang
|
|
|
|
(unless tangle-mode (setq tangle-mode #o755)))
|
2012-08-10 09:40:00 -04:00
|
|
|
;; update counter
|
|
|
|
(setq block-counter (+ 1 block-counter))
|
2016-06-18 18:57:03 -04:00
|
|
|
(unless (assoc file-name path-collector)
|
|
|
|
(push (cons file-name tangle-mode) path-collector))))))
|
2012-08-10 09:40:00 -04:00
|
|
|
specs)))
|
2013-03-02 11:15:08 -05:00
|
|
|
(if (equal arg '(4))
|
|
|
|
(org-babel-tangle-single-block 1 t)
|
|
|
|
(org-babel-tangle-collect-blocks lang tangle-file)))
|
2012-08-12 23:59:44 -04:00
|
|
|
(message "Tangled %d code block%s from %s" block-counter
|
2012-08-10 09:40:00 -04:00
|
|
|
(if (= block-counter 1) "" "s")
|
|
|
|
(file-name-nondirectory
|
2013-06-10 11:55:28 -04:00
|
|
|
(buffer-file-name
|
|
|
|
(or (buffer-base-buffer) (current-buffer)))))
|
2012-08-10 09:40:00 -04:00
|
|
|
;; run `org-babel-post-tangle-hook' in all tangled files
|
|
|
|
(when org-babel-post-tangle-hook
|
|
|
|
(mapc
|
|
|
|
(lambda (file)
|
|
|
|
(org-babel-with-temp-filebuffer file
|
|
|
|
(run-hooks 'org-babel-post-tangle-hook)))
|
2013-06-10 11:55:28 -04:00
|
|
|
(mapcar #'car path-collector)))
|
|
|
|
;; set permissions on tangled files
|
|
|
|
(mapc (lambda (pair)
|
|
|
|
(when (cdr pair) (set-file-modes (car pair) (cdr pair))))
|
|
|
|
path-collector)
|
|
|
|
(mapcar #'car path-collector)))))
|
2009-06-26 14:43:50 -04:00
|
|
|
|
2009-08-20 18:32:57 -04:00
|
|
|
(defun org-babel-tangle-clean ()
|
2010-07-13 19:20:08 -04:00
|
|
|
"Remove comments inserted by `org-babel-tangle'.
|
|
|
|
Call this function inside of a source-code file generated by
|
2009-08-20 18:32:57 -04:00
|
|
|
`org-babel-tangle' to remove all comments inserted automatically
|
|
|
|
by `org-babel-tangle'. Warning, this comment removes any lines
|
2016-08-23 16:13:56 -04:00
|
|
|
containing constructs which resemble Org file links or noweb
|
2009-08-20 18:32:57 -04:00
|
|
|
references."
|
|
|
|
(interactive)
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
|
2012-03-19 16:38:12 -04:00
|
|
|
(re-search-forward (org-babel-noweb-wrap) nil t))
|
Xemacs incompatibilities
Carsten Dominik <carsten.dominik@gmail.com> writes:
> On May 17, 2010, at 4:39 PM, Michael Sperber wrote:
>
>> In particular, fixing the require won't be enough: org-babel-python.el
>> uses `run-python' and interacts with the inferior Python, whereas
>> python-mode.el defines `py-shell'.
>>
>> Should I try to abstract over the differences?
>
> Yes, this would be much appreciated. (I think, Eric or Dan?)
OK, I've attached a patch that makes `org-babel-python' work on XEmacs.
Most of the issues are pure XEmacs issues. Notes:
- XEmacs doesn't have [[:digit:]] - I hope to rectify this in the
future, but it seems there's no downside in this particular case to
replacing by [0-9].
- XEmacs doesn't have `move-end-of-line', but does have `end-of-line'.
I don't understand the intent of having both of these, but the code
seems fine with `end-of-line'.
- It seems there are way too few `require's throughout org-babel. I
don't know if it's OK to add the ones I needed.
- `org-babel-python-evaluate' looked broken as-is: It doesn't use the
`body' argument properly, the result is (I think) processed in the
wrong order and not properly split into lines. I've fixed all these,
but a review is probably in order.
2010-05-24 15:22:50 -04:00
|
|
|
(delete-region (save-excursion (beginning-of-line 1) (point))
|
|
|
|
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
|
2009-08-20 18:32:57 -04:00
|
|
|
|
2010-06-23 14:24:33 -04:00
|
|
|
(defvar org-stored-links)
|
2011-06-14 14:23:56 -04:00
|
|
|
(defvar org-bracket-link-regexp)
|
2012-08-10 09:40:00 -04:00
|
|
|
(defun org-babel-spec-to-string (spec)
|
|
|
|
"Insert SPEC into the current file.
|
|
|
|
|
2013-02-27 02:58:32 -05:00
|
|
|
Insert the source-code specified by SPEC into the current source
|
|
|
|
code file. This function uses `comment-region' which assumes
|
|
|
|
that the appropriate major-mode is set. SPEC has the form:
|
|
|
|
|
2015-09-17 19:08:20 -04:00
|
|
|
(start-line file link source-name params body comment)"
|
2016-12-09 18:20:11 -05:00
|
|
|
(pcase-let*
|
|
|
|
((`(,start ,file ,link ,source ,info ,body ,comment) spec)
|
|
|
|
(comments (cdr (assq :comments info)))
|
|
|
|
(link? (or (string= comments "both") (string= comments "link")
|
|
|
|
(string= comments "yes") (string= comments "noweb")))
|
|
|
|
(link-data `(("start-line" . ,(number-to-string start))
|
|
|
|
("file" . ,file)
|
|
|
|
("link" . ,link)
|
|
|
|
("source-name" . ,source)))
|
|
|
|
(insert-comment (lambda (text)
|
|
|
|
(when (and comments
|
|
|
|
(not (string= comments "no"))
|
|
|
|
(org-string-nw-p text))
|
|
|
|
(if org-babel-tangle-uncomment-comments
|
|
|
|
;; Plain comments: no processing.
|
|
|
|
(insert text)
|
|
|
|
;; Ensure comments are made to be
|
|
|
|
;; comments, and add a trailing newline.
|
|
|
|
;; Also ignore invisible characters when
|
|
|
|
;; commenting.
|
|
|
|
(comment-region
|
|
|
|
(point)
|
|
|
|
(progn (insert (org-no-properties text))
|
|
|
|
(point)))
|
|
|
|
(end-of-line)
|
|
|
|
(insert "\n"))))))
|
2012-08-10 09:40:00 -04:00
|
|
|
(when comment (funcall insert-comment comment))
|
2016-12-09 18:20:11 -05:00
|
|
|
(when link?
|
|
|
|
(funcall insert-comment
|
|
|
|
(org-fill-template
|
|
|
|
org-babel-tangle-comment-format-beg link-data)))
|
|
|
|
(insert body "\n")
|
|
|
|
(when link?
|
|
|
|
(funcall insert-comment
|
|
|
|
(org-fill-template
|
|
|
|
org-babel-tangle-comment-format-end link-data)))))
|
2012-08-10 09:40:00 -04:00
|
|
|
|
2013-03-04 07:52:04 -05:00
|
|
|
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
|
2015-06-15 15:38:14 -04:00
|
|
|
"Collect source blocks in the current Org file.
|
2009-07-30 10:57:26 -04:00
|
|
|
Return an association list of source-code block specifications of
|
|
|
|
the form used by `org-babel-spec-to-string' grouped by language.
|
2013-03-04 08:44:31 -05:00
|
|
|
Optional argument LANGUAGE can be used to limit the collected
|
|
|
|
source code blocks by language. Optional argument TANGLE-FILE
|
|
|
|
can be used to limit the collected code blocks by target file."
|
2015-06-15 15:38:14 -04:00
|
|
|
(let ((counter 0) last-heading-pos blocks)
|
2010-07-12 00:35:58 -04:00
|
|
|
(org-babel-map-src-blocks (buffer-file-name)
|
2015-06-15 15:38:14 -04:00
|
|
|
(let ((current-heading-pos
|
|
|
|
(org-with-wide-buffer
|
|
|
|
(org-with-limited-levels (outline-previous-heading)))))
|
2016-07-25 10:34:48 -04:00
|
|
|
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
|
2016-01-02 11:05:00 -05:00
|
|
|
(setq counter 1)
|
|
|
|
(setq last-heading-pos current-heading-pos)))
|
2015-06-15 15:38:14 -04:00
|
|
|
(unless (org-in-commented-heading-p)
|
|
|
|
(let* ((info (org-babel-get-src-block-info 'light))
|
|
|
|
(src-lang (nth 0 info))
|
|
|
|
(src-tfile (cdr (assq :tangle (nth 2 info)))))
|
2016-01-02 11:05:00 -05:00
|
|
|
(unless (or (string= src-tfile "no")
|
2015-06-15 15:38:14 -04:00
|
|
|
(and tangle-file (not (equal tangle-file src-tfile)))
|
|
|
|
(and language (not (string= language src-lang))))
|
|
|
|
;; Add the spec for this block to blocks under its
|
|
|
|
;; language.
|
|
|
|
(let ((by-lang (assoc src-lang blocks))
|
|
|
|
(block (org-babel-tangle-single-block counter)))
|
|
|
|
(if by-lang (setcdr by-lang (cons block (cdr by-lang)))
|
|
|
|
(push (cons src-lang (list block)) blocks)))))))
|
|
|
|
;; Ensure blocks are in the correct order.
|
|
|
|
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
|
2009-06-27 20:25:01 -04:00
|
|
|
|
2016-12-09 18:20:11 -05:00
|
|
|
(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
|
2013-03-02 11:15:08 -05:00
|
|
|
"Collect the tangled source for current block.
|
|
|
|
Return the list of block attributes needed by
|
2016-12-09 18:20:11 -05:00
|
|
|
`org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is
|
|
|
|
non-nil, return the full association list to be used by
|
|
|
|
`org-babel-tangle' directly."
|
2013-03-02 11:15:08 -05:00
|
|
|
(let* ((info (org-babel-get-src-block-info))
|
|
|
|
(start-line
|
|
|
|
(save-restriction (widen)
|
|
|
|
(+ 1 (line-number-at-pos (point)))))
|
2015-09-08 23:48:44 -04:00
|
|
|
(file (buffer-file-name (buffer-base-buffer)))
|
2013-03-02 11:15:08 -05:00
|
|
|
(src-lang (nth 0 info))
|
|
|
|
(params (nth 2 info))
|
|
|
|
(extra (nth 3 info))
|
|
|
|
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
|
|
|
|
(match-string 1 extra))
|
|
|
|
org-coderef-label-format))
|
2016-12-09 18:20:11 -05:00
|
|
|
(link (let ((l (org-no-properties (org-store-link nil))))
|
|
|
|
(and (string-match org-bracket-link-regexp l)
|
|
|
|
(match-string 1 l))))
|
2013-03-02 11:15:08 -05:00
|
|
|
(source-name
|
2016-06-18 18:05:25 -04:00
|
|
|
(or (nth 4 info)
|
|
|
|
(format "%s:%d"
|
|
|
|
(or (ignore-errors (nth 4 (org-heading-components)))
|
|
|
|
"No heading")
|
|
|
|
block-counter)))
|
2016-12-09 18:20:11 -05:00
|
|
|
(expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
|
2013-03-02 11:15:08 -05:00
|
|
|
(assignments-cmd
|
|
|
|
(intern (concat "org-babel-variable-assignments:" src-lang)))
|
|
|
|
(body
|
Backport changes from Emacs revs 115081 and 115082
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>
* ox-html.el (org-html-scripts): Add 2013 to copyright years.
(org-html-infojs-template): Copyright holder to FSF.
2013-11-12 14:57:31 -05:00
|
|
|
;; Run the tangle-body-hook.
|
2016-12-09 18:59:08 -05:00
|
|
|
(let ((body (if (org-babel-noweb-p params :tangle)
|
|
|
|
(org-babel-expand-noweb-references info)
|
|
|
|
(nth 1 info))))
|
|
|
|
(with-temp-buffer
|
|
|
|
(insert
|
|
|
|
;; Expand body in language specific manner.
|
2016-12-09 18:20:11 -05:00
|
|
|
(cond ((assq :no-expand params) body)
|
|
|
|
((fboundp expand-cmd) (funcall expand-cmd body params))
|
|
|
|
(t
|
|
|
|
(org-babel-expand-body:generic
|
|
|
|
body params (and (fboundp assignments-cmd)
|
2016-12-09 18:59:08 -05:00
|
|
|
(funcall assignments-cmd params))))))
|
|
|
|
(when (string-match "-r" extra)
|
|
|
|
(goto-char (point-min))
|
|
|
|
(while (re-search-forward
|
|
|
|
(replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
|
|
|
|
(replace-match "")))
|
|
|
|
(run-hooks 'org-babel-tangle-body-hook)
|
|
|
|
(buffer-string))))
|
2013-03-02 11:15:08 -05:00
|
|
|
(comment
|
2016-09-22 13:45:15 -04:00
|
|
|
(when (or (string= "both" (cdr (assq :comments params)))
|
|
|
|
(string= "org" (cdr (assq :comments params))))
|
2013-03-02 11:15:08 -05:00
|
|
|
;; From the previous heading or code-block end
|
|
|
|
(funcall
|
|
|
|
org-babel-process-comment-text
|
|
|
|
(buffer-substring
|
|
|
|
(max (condition-case nil
|
|
|
|
(save-excursion
|
2016-12-09 18:20:11 -05:00
|
|
|
(org-back-to-heading t) ; Sets match data
|
2013-03-02 11:15:08 -05:00
|
|
|
(match-end 0))
|
|
|
|
(error (point-min)))
|
|
|
|
(save-excursion
|
|
|
|
(if (re-search-backward
|
|
|
|
org-babel-src-block-regexp nil t)
|
|
|
|
(match-end 0)
|
|
|
|
(point-min))))
|
|
|
|
(point)))))
|
|
|
|
(result
|
2016-12-09 18:20:11 -05:00
|
|
|
(list start-line
|
|
|
|
(if org-babel-tangle-use-relative-file-links
|
|
|
|
(file-relative-name file)
|
|
|
|
file)
|
|
|
|
(if (and org-babel-tangle-use-relative-file-links
|
|
|
|
(string-match org-link-types-re link)
|
|
|
|
(string= (match-string 0 link) "file"))
|
|
|
|
(concat "file:"
|
|
|
|
(file-relative-name (match-string 1 link)
|
|
|
|
(file-name-directory
|
|
|
|
(cdr (assq :tangle params)))))
|
|
|
|
link)
|
|
|
|
source-name
|
|
|
|
params
|
|
|
|
(org-unescape-code-in-string
|
|
|
|
(if org-src-preserve-indentation
|
|
|
|
(org-trim body t)
|
|
|
|
(org-trim (org-remove-indentation body))))
|
|
|
|
comment)))
|
2013-03-02 11:15:08 -05:00
|
|
|
(if only-this-block
|
|
|
|
(list (cons src-lang (list result)))
|
|
|
|
result)))
|
|
|
|
|
2016-06-18 18:05:25 -04:00
|
|
|
(defun org-babel-tangle-comment-links (&optional info)
|
2011-01-16 10:21:16 -05:00
|
|
|
"Return a list of begin and end link comments for the code block at point."
|
2016-06-18 18:05:25 -04:00
|
|
|
(let ((link-data
|
|
|
|
`(("start-line" . ,(number-to-string
|
|
|
|
(org-babel-where-is-src-block-head)))
|
|
|
|
("file" . ,(buffer-file-name))
|
|
|
|
("link" . ,(org-link-escape
|
|
|
|
(progn
|
|
|
|
(call-interactively #'org-store-link)
|
|
|
|
(org-no-properties (car (pop org-stored-links))))))
|
|
|
|
("source-name" .
|
|
|
|
,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
|
2011-01-16 10:21:16 -05:00
|
|
|
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
|
|
|
|
(org-fill-template org-babel-tangle-comment-format-end link-data))))
|
|
|
|
|
|
|
|
;; de-tangling functions
|
2010-10-29 03:49:47 -04:00
|
|
|
(defvar org-bracket-link-analytic-regexp)
|
|
|
|
(defun org-babel-detangle (&optional source-code-file)
|
2016-08-23 16:13:56 -04:00
|
|
|
"Propagate changes in source file back original to Org file.
|
2010-10-29 03:49:47 -04:00
|
|
|
This requires that code blocks were tangled with link comments
|
|
|
|
which enable the original code blocks to be found."
|
|
|
|
(interactive)
|
|
|
|
(save-excursion
|
|
|
|
(when source-code-file (find-file source-code-file))
|
|
|
|
(goto-char (point-min))
|
|
|
|
(let ((counter 0) new-body end)
|
|
|
|
(while (re-search-forward org-bracket-link-analytic-regexp nil t)
|
|
|
|
(when (re-search-forward
|
|
|
|
(concat " " (regexp-quote (match-string 5)) " ends here"))
|
|
|
|
(setq end (match-end 0))
|
|
|
|
(forward-line -1)
|
|
|
|
(save-excursion
|
|
|
|
(when (setq new-body (org-babel-tangle-jump-to-org))
|
|
|
|
(org-babel-update-block-body new-body)))
|
|
|
|
(setq counter (+ 1 counter)))
|
|
|
|
(goto-char end))
|
2012-08-12 23:59:44 -04:00
|
|
|
(prog1 counter (message "Detangled %d code blocks" counter)))))
|
2010-10-29 03:49:47 -04:00
|
|
|
|
|
|
|
(defun org-babel-tangle-jump-to-org ()
|
2016-01-31 05:37:05 -05:00
|
|
|
"Jump from a tangled code file to the related Org mode file."
|
2010-10-29 03:49:47 -04:00
|
|
|
(interactive)
|
|
|
|
(let ((mid (point))
|
2016-06-18 18:05:25 -04:00
|
|
|
start body-start end
|
2011-01-13 16:04:28 -05:00
|
|
|
target-buffer target-char link path block-name body)
|
2010-10-29 03:49:47 -04:00
|
|
|
(save-window-excursion
|
|
|
|
(save-excursion
|
2011-01-13 16:04:28 -05:00
|
|
|
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
|
|
|
|
(not ; ever wider searches until matching block comments
|
2016-01-31 05:37:05 -05:00
|
|
|
(and (setq start (line-beginning-position))
|
|
|
|
(setq body-start (line-beginning-position 2))
|
2011-01-13 16:04:28 -05:00
|
|
|
(setq link (match-string 0))
|
|
|
|
(setq path (match-string 3))
|
|
|
|
(setq block-name (match-string 5))
|
|
|
|
(save-excursion
|
|
|
|
(save-match-data
|
|
|
|
(re-search-forward
|
|
|
|
(concat " " (regexp-quote block-name)
|
|
|
|
" ends here") nil t)
|
2016-01-31 05:37:05 -05:00
|
|
|
(setq end (line-beginning-position))))))))
|
2011-01-13 16:04:28 -05:00
|
|
|
(unless (and start (< start mid) (< mid end))
|
2012-08-12 23:59:44 -04:00
|
|
|
(error "Not in tangled code"))
|
2016-01-31 05:37:05 -05:00
|
|
|
(setq body (buffer-substring body-start end)))
|
2010-10-29 03:49:47 -04:00
|
|
|
(when (string-match "::" path)
|
|
|
|
(setq path (substring path 0 (match-beginning 0))))
|
2016-09-28 08:07:56 -04:00
|
|
|
(find-file (or (car (org-id-find path)) path))
|
2016-01-31 05:37:05 -05:00
|
|
|
(setq target-buffer (current-buffer))
|
|
|
|
;; Go to the beginning of the relative block in Org file.
|
|
|
|
(org-open-link-from-string link)
|
2010-10-29 03:49:47 -04:00
|
|
|
(if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
|
2016-01-31 05:37:05 -05:00
|
|
|
(let ((n (string-to-number (match-string 1 block-name))))
|
|
|
|
(if (org-before-first-heading-p) (goto-char (point-min))
|
|
|
|
(org-back-to-heading t))
|
|
|
|
;; Do not skip the first block if it begins at point min.
|
|
|
|
(cond ((or (org-at-heading-p)
|
|
|
|
(not (eq (org-element-type (org-element-at-point))
|
|
|
|
'src-block)))
|
|
|
|
(org-babel-next-src-block n))
|
|
|
|
((= n 1))
|
|
|
|
(t (org-babel-next-src-block (1- n)))))
|
2010-10-29 03:49:47 -04:00
|
|
|
(org-babel-goto-named-src-block block-name))
|
2013-05-30 18:03:21 -04:00
|
|
|
(goto-char (org-babel-where-is-src-block-head))
|
2016-01-31 05:37:05 -05:00
|
|
|
;; Preserve location of point within the source code in tangled
|
|
|
|
;; code file.
|
2013-05-30 18:03:21 -04:00
|
|
|
(forward-line 1)
|
|
|
|
(forward-char (- mid body-start))
|
2010-10-29 03:49:47 -04:00
|
|
|
(setq target-char (point)))
|
2013-06-06 11:11:54 -04:00
|
|
|
(org-src-switch-to-buffer target-buffer t)
|
2016-06-18 18:05:25 -04:00
|
|
|
(goto-char target-char)
|
|
|
|
body))
|
2010-10-29 03:49:47 -04:00
|
|
|
|
2010-06-11 19:02:42 -04:00
|
|
|
(provide 'ob-tangle)
|
2010-06-25 12:20:39 -04:00
|
|
|
|
2012-10-02 02:50:46 -04:00
|
|
|
;; Local variables:
|
|
|
|
;; generated-autoload-file: "org-loaddefs.el"
|
|
|
|
;; End:
|
2010-06-25 12:20:39 -04:00
|
|
|
|
2010-06-11 19:02:42 -04:00
|
|
|
;;; ob-tangle.el ends here
|