;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
-;; Version: 7.7
;; This file is part of GNU Emacs.
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function make-directory "files" (dir &optional parents))
-;;;###autoload
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions.
written in this language. If no entry is found in this list,
then the name of the language is used."
:group 'org-babel-tangle
+ :version "24.1"
:type '(repeat
(cons
(string "Language name")
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-pre-tangle-hook '(save-buffer)
"Hook run at the beginning of `org-babel-tangle'."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-tangle-body-hook nil
"Hook run over the contents of each code block body."
:group 'org-babel
+ :version "24.1"
:type 'hook)
(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
+ :version "24.1"
:type 'string)
(defcustom org-babel-tangle-comment-format-end "%source-name ends here"
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
+ :version "24.1"
:type 'string)
+(defcustom org-babel-process-comment-text #'org-babel-trim
+ "Function called to process raw Org-mode text collected to be
+inserted as comments in tangled source-code files. The function
+should take a single string argument and return a string
+result. The default value is `org-babel-trim'."
+ :group 'org-babel
+ :version "24.1"
+ :type 'function)
+
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
(declare (indent 1))
- (let ((temp-result (make-symbol "temp-result"))
+ (let ((temp-path (make-symbol "temp-path"))
+ (temp-result (make-symbol "temp-result"))
(temp-file (make-symbol "temp-file"))
(visited-p (make-symbol "visited-p")))
- `(let (,temp-result ,temp-file
- (,visited-p (get-file-buffer ,file)))
- (org-babel-find-file-noselect-refresh ,file)
- (setf ,temp-file (get-file-buffer ,file))
+ `(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))
(with-current-buffer ,temp-file
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
,temp-result)))
+(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
(defun org-babel-load-file (file)
`org-babel-tangle' and then loads the resulting file using
`load-file'."
(interactive "fFile to load: ")
- (flet ((age (file)
- (float-time
- (time-subtract (current-time)
- (nth 5 (or (file-attributes (file-truename file))
- (file-attributes file)))))))
- (let* ((base-name (file-name-sans-extension file))
- (exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
- (unless (and (file-exists-p exported-file)
- (> (age file) (age exported-file)))
- (org-babel-tangle-file file exported-file "emacs-lisp"))
- (load-file exported-file)
- (message "loaded %s" exported-file))))
+ (let* ((age (lambda (file)
+ (float-time
+ (time-subtract (current-time)
+ (nth 5 (or (file-attributes (file-truename file))
+ (file-attributes file)))))))
+ (base-name (file-name-sans-extension file))
+ (exported-file (concat base-name ".el")))
+ ;; tangle if the org-mode file is newer than the elisp file
+ (unless (and (file-exists-p exported-file)
+ (> (funcall age file) (funcall age exported-file)))
+ (org-babel-tangle-file file exported-file "emacs-lisp"))
+ (load-file exported-file)
+ (message "Loaded %s" exported-file)))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
(run-hooks 'org-babel-pre-tangle-hook)
;; possibly restrict the buffer to the current code block
(save-restriction
- (when only-this-block
- (unless (org-babel-where-is-src-block-head)
- (error "Point is not currently inside of a code block"))
- (unless target-file
- (setq target-file
- (read-from-minibuffer "Tangle to: " (buffer-file-name))))
- (narrow-to-region (match-beginning 0) (match-end 0)))
- (save-excursion
- (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))
- 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)
- (flet ((get-spec (name)
- (cdr (assoc name (nth 4 spec)))))
- (let* ((tangle (get-spec :tangle))
- (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
- (get-spec :shebang)))
- (base-name (cond
- ((string= "yes" tangle)
- (file-name-sans-extension
- (buffer-file-name)))
- ((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
- ;; possibly create the parent directories for file
- (when ((lambda (m) (and m (not (string= m "no"))))
- (get-spec :mkdirp))
- (make-directory (file-name-directory file-name) 'parents))
- ;; delete any old versions of file
- (when (and (file-exists-p file-name)
- (not (member file-name path-collector)))
- (delete-file file-name))
- ;; 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
- (if (file-exists-p file-name)
- (insert-file-contents file-name))
- (goto-char (point-max))
- (insert content)
- (write-region nil nil file-name))))
- ;; if files contain she-bangs, then make the executable
- (when she-bang (set-file-modes file-name #o755))
- ;; update counter
- (setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
- specs)))
- (org-babel-tangle-collect-blocks lang))
- (message "tangled %d code block%s from %s" block-counter
- (if (= block-counter 1) "" "s")
- (file-name-nondirectory
- (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
- ;; 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)))
- path-collector))
- path-collector))))
+ (when only-this-block
+ (unless (org-babel-where-is-src-block-head)
+ (error "Point is not currently inside of a code block"))
+ (save-match-data
+ (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ target-file)
+ (setq target-file
+ (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
+ (narrow-to-region (match-beginning 0) (match-end 0)))
+ (save-excursion
+ (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))
+ 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))
+ (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
+ (funcall get-spec :shebang)))
+ (base-name (cond
+ ((string= "yes" tangle)
+ (file-name-sans-extension
+ (buffer-file-name)))
+ ((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
+ ;; possibly create the parent directories for file
+ (when ((lambda (m) (and m (not (string= m "no"))))
+ (funcall get-spec :mkdirp))
+ (make-directory (file-name-directory file-name) 'parents))
+ ;; delete any old versions of file
+ (when (and (file-exists-p file-name)
+ (not (member file-name path-collector)))
+ (delete-file file-name))
+ ;; 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
+ (if (file-exists-p file-name)
+ (insert-file-contents file-name))
+ (goto-char (point-max))
+ (insert content)
+ (write-region nil nil file-name))))
+ ;; if files contain she-bangs, then make the executable
+ (when she-bang (set-file-modes file-name #o755))
+ ;; update counter
+ (setq block-counter (+ 1 block-counter))
+ (add-to-list 'path-collector file-name)))))
+ specs)))
+ (org-babel-tangle-collect-blocks lang))
+ (message "Tangled %d code block%s from %s" block-counter
+ (if (= block-counter 1) "" "s")
+ (file-name-nondirectory
+ (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ ;; 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)))
+ path-collector))
+ path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
(interactive)
(goto-char (point-min))
(while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
- (re-search-forward "<<[^[:space:]]*>>" nil t))
+ (re-search-forward (org-babel-noweb-wrap) nil t))
(delete-region (save-excursion (beginning-of-line 1) (point))
(save-excursion (end-of-line 1) (forward-char 1) (point)))))
(defvar org-stored-links)
(defvar org-bracket-link-regexp)
+(defun org-babel-spec-to-string (spec)
+ "Insert SPEC into the current file.
+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
+
+ (start-line file link source-name params body comment)"
+ (let* ((start-line (nth 0 spec))
+ (file (nth 1 spec))
+ (link (nth 2 spec))
+ (source-name (nth 3 spec))
+ (body (nth 5 spec))
+ (comment (nth 6 spec))
+ (comments (cdr (assoc :comments (nth 4 spec))))
+ (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
+ (link-p (or (string= comments "both") (string= comments "link")
+ (string= comments "yes") (string= comments "noweb")))
+ (link-data (mapcar (lambda (el)
+ (cons (symbol-name el)
+ ((lambda (le)
+ (if (stringp le) le (format "%S" le)))
+ (eval el))))
+ '(start-line file link source-name)))
+ (insert-comment (lambda (text)
+ (when (and comments (not (string= comments "no"))
+ (> (length text) 0))
+ (when padline (insert "\n"))
+ (comment-region (point) (progn (insert text) (point)))
+ (end-of-line nil) (insert "\n")))))
+ (when comment (funcall insert-comment comment))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-beg link-data)))
+ (when padline (insert "\n"))
+ (insert
+ (format
+ "%s\n"
+ (replace-regexp-in-string
+ "^," ""
+ (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-end link-data)))))
+
(defun org-babel-tangle-collect-blocks (&optional language)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
(setq block-counter (+ 1 block-counter))))
(replace-regexp-in-string "[ \t]" "-"
(condition-case nil
- (nth 4 (org-heading-components))
+ (or (nth 4 (org-heading-components))
+ "(dummy for heading without text)")
(error (buffer-file-name)))))
(let* ((start-line (save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
(unless (and language (not (string= language src-lang)))
(let* ((info (org-babel-get-src-block-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))
(link ((lambda (link)
(and (string-match org-bracket-link-regexp link)
(match-string 1 link)))
- (org-babel-clean-text-properties
+ (org-no-properties
(org-store-link nil))))
(source-name
(intern (or (nth 4 info)
((lambda (body) ;; run the tangle-body-hook
(with-temp-buffer
(insert body)
+ (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)))
((lambda (body) ;; expand the body in language specific manner
body params
(and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
- (if (and (cdr (assoc :noweb params)) ;; expand noweb refs
- (let ((nowebs (split-string
- (cdr (assoc :noweb params)))))
- (or (member "yes" nowebs)
- (member "tangle" nowebs))))
+ (if (org-babel-noweb-p params :tangle)
(org-babel-expand-noweb-references info)
(nth 1 info)))))
(comment
(when (or (string= "both" (cdr (assoc :comments params)))
(string= "org" (cdr (assoc :comments params))))
;; from the previous heading or code-block end
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) (point))
- (error 0))
- (save-excursion
- (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)))
- (point))))
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; sets match data
+ (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)))))
by-lang)
;; add the spec for this block to blocks under it's language
(setq by-lang (cdr (assoc src-lang blocks)))
blocks))
blocks))
-(defun org-babel-spec-to-string (spec)
- "Insert SPEC into the current file.
-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
-
- (start-line file link source-name params body comment)"
- (let* ((start-line (nth 0 spec))
- (file (nth 1 spec))
- (link (org-link-escape (nth 2 spec)))
- (source-name (nth 3 spec))
- (body (nth 5 spec))
- (comment (nth 6 spec))
- (comments (cdr (assoc :comments (nth 4 spec))))
- (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
- (link-p (or (string= comments "both") (string= comments "link")
- (string= comments "yes") (string= comments "noweb")))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
- '(start-line file link source-name))))
- (flet ((insert-comment (text)
- (let ((text (org-babel-trim text)))
- (when (and comments (not (string= comments "no"))
- (> (length text) 0))
- (when padline (insert "\n"))
- (comment-region (point) (progn (insert text) (point)))
- (end-of-line nil) (insert "\n")))))
- (when comment (insert-comment comment))
- (when link-p
- (insert-comment
- (org-fill-template org-babel-tangle-comment-format-beg link-data)))
- (when padline (insert "\n"))
- (insert
- (format
- "%s\n"
- (replace-regexp-in-string
- "^," ""
- (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
- (when link-p
- (insert-comment
- (org-fill-template org-babel-tangle-comment-format-end link-data))))))
-
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
(file (buffer-file-name))
(link (org-link-escape (progn (call-interactively 'org-store-link)
- (org-babel-clean-text-properties
+ (org-no-properties
(car (pop org-stored-links))))))
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
(org-babel-update-block-body new-body)))
(setq counter (+ 1 counter)))
(goto-char end))
- (prog1 counter (message "detangled %d code blocks" counter)))))
+ (prog1 counter (message "Detangled %d code blocks" counter)))))
(defun org-babel-tangle-jump-to-org ()
"Jump from a tangled code file to the related Org-mode file."
" ends here") nil t)
(setq end (point-at-bol))))))))
(unless (and start (< start mid) (< mid end))
- (error "not in tangled code"))
+ (error "Not in tangled code"))
(setq body (org-babel-trim (buffer-substring start end))))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
(provide 'ob-tangle)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob-tangle.el ends here