|
|
@@ -191,96 +191,95 @@ exported source code blocks by language."
|
|
|
(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"))
|
|
|
- (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)
|
|
|
- (org-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'.
|
|
|
@@ -298,6 +297,53 @@ references."
|
|
|
|
|
|
(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
|
|
|
@@ -390,51 +436,6 @@ code blocks by language."
|
|
|
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 (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))))
|
|
|
- (org-flet ((insert-comment (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))
|
Bastien Guerry