diff options
Diffstat (limited to '.emacs.d/elpa/org-20171120/ob-tangle.el')
| -rw-r--r-- | .emacs.d/elpa/org-20171120/ob-tangle.el | 601 |
1 files changed, 0 insertions, 601 deletions
diff --git a/.emacs.d/elpa/org-20171120/ob-tangle.el b/.emacs.d/elpa/org-20171120/ob-tangle.el deleted file mode 100644 index 09d011f..0000000 --- a/.emacs.d/elpa/org-20171120/ob-tangle.el +++ /dev/null @@ -1,601 +0,0 @@ -;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2017 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; 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, -;; 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. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Extract the code from source blocks out into raw source-code files. - -;;; Code: - -(require 'cl-lib) -(require 'org-src) -(require 'org-macs) - -(declare-function make-directory "files" (dir &optional parents)) -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-babel-update-block-body "ob-core" (new-body)) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-before-first-heading-p "org" ()) -(declare-function org-element-at-point "org-element" ()) -(declare-function org-element-type "org-element" (element)) -(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)) -(declare-function org-link-escape "org" (text &optional table merge)) -(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) -(declare-function org-remove-indentation "org" (code &optional n)) -(declare-function org-store-link "org" (arg)) -(declare-function org-trim "org" (s &optional keep-lead)) -(declare-function outline-previous-heading "outline" ()) -(declare-function org-id-find "org-id" (id &optional markerp)) - -(defvar org-link-types-re) - -(defcustom org-babel-tangle-lang-exts - '(("emacs-lisp" . "el") - ("elisp" . "el")) - "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 - :version "24.1" - :type '(repeat - (cons - (string "Language name") - (string "File Extension")))) - -(defcustom org-babel-tangle-use-relative-file-links t - "Use relative path names in links from tangled source back the Org file." - :group 'org-babel-tangle - :type 'boolean) - -(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]]" - "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 -%link --------- Org style link to the code block -%source-name -- name of the code block - -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. - -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" - "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 -%link --------- Org style link to the code block -%source-name -- name of the code block - -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. - -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-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) - -(defcustom org-babel-process-comment-text 'org-remove-indentation - "Function called to process raw Org 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-remove-indentation'." - :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." - (find-file-noselect file 'nowarn) - (with-current-buffer (get-file-buffer file) - (revert-buffer t t t))) - -(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)) - (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-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-tangle-file (file &optional target-file lang) - "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 -used to limit the exported source code blocks by language. -Return a list whose CAR is the tangled file name." - (interactive "fFile to tangle: \nP") - (let ((visited-p (get-file-buffer (expand-file-name file))) - to-be-removed) - (prog1 - (save-window-excursion - (find-file file) - (setq to-be-removed (current-buffer)) - (mapcar #'expand-file-name (org-babel-tangle nil target-file lang))) - (unless visited-p - (kill-buffer to-be-removed))))) - -(defun org-babel-tangle-publish (_ filename pub-dir) - "Tangle FILENAME and place the results in PUB-DIR." - (unless (file-exists-p pub-dir) - (make-directory pub-dir t)) - (setq pub-dir (file-name-as-directory pub-dir)) - (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) - -;;;###autoload -(defun org-babel-tangle (&optional arg target-file lang) - "Write code blocks to source-specific files. -Extract the bodies of all source code blocks from the current -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." - (interactive "P") - (run-hooks 'org-babel-pre-tangle-hook) - ;; Possibly Restrict the buffer to the current code block - (save-restriction - (save-excursion - (when (equal arg '(4)) - (let ((head (org-babel-where-is-src-block-head))) - (if head - (goto-char head) - (user-error "Point is not in a source code block")))) - (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)) - (tangle-file - (when (equal arg '(16)) - (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light)))) - (user-error "Point is not in a source code block")))) - 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 (let ((sheb (funcall get-spec :shebang))) - (when (> (length sheb) 0) sheb))) - (tangle-mode (funcall get-spec :tangle-mode)) - (base-name (cond - ((string= "yes" tangle) - (file-name-sans-extension - (nth 1 spec))) - ((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. - (let ((m (funcall get-spec :mkdirp)) - (fnd (file-name-directory file-name))) - (and m fnd (not (string= m "no")) - (make-directory fnd 'parents))) - ;; delete any old versions of file - (and (file-exists-p file-name) - (not (member file-name (mapcar #'car 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 - (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)))) - ;; if files contain she-bangs, then make the executable - (when she-bang - (unless tangle-mode (setq tangle-mode #o755))) - ;; update counter - (setq block-counter (+ 1 block-counter)) - (unless (assoc file-name path-collector) - (push (cons file-name tangle-mode) path-collector)))))) - specs))) - (if (equal arg '(4)) - (org-babel-tangle-single-block 1 t) - (org-babel-tangle-collect-blocks lang tangle-file))) - (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))) - (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))))) - -(defun org-babel-tangle-clean () - "Remove comments inserted by `org-babel-tangle'. -Call this function inside of a source-code file generated by -`org-babel-tangle' to remove all comments inserted automatically -by `org-babel-tangle'. Warning, this comment removes any lines -containing constructs which resemble Org file links or noweb -references." - (interactive) - (goto-char (point-min)) - (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" 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)" - (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")))))) - (when comment (funcall insert-comment comment)) - (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))))) - -(defun org-babel-tangle-collect-blocks (&optional language tangle-file) - "Collect source blocks in the current Org file. -Return an association list of source-code block specifications of -the form used by `org-babel-spec-to-string' grouped by language. -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." - (let ((counter 0) last-heading-pos blocks) - (org-babel-map-src-blocks (buffer-file-name) - (let ((current-heading-pos - (org-with-wide-buffer - (org-with-limited-levels (outline-previous-heading))))) - (if (eq last-heading-pos current-heading-pos) (cl-incf counter) - (setq counter 1) - (setq last-heading-pos current-heading-pos))) - (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))))) - (unless (or (string= src-tfile "no") - (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))) - -(defun org-babel-tangle-single-block (block-counter &optional only-this-block) - "Collect the tangled source for current block. -Return the list of block attributes needed by -`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." - (let* ((info (org-babel-get-src-block-info)) - (start-line - (save-restriction (widen) - (+ 1 (line-number-at-pos (point))))) - (file (buffer-file-name (buffer-base-buffer))) - (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)) - (link (let ((l (org-no-properties (org-store-link nil)))) - (and (string-match org-bracket-link-regexp l) - (match-string 1 l)))) - (source-name - (or (nth 4 info) - (format "%s:%d" - (or (ignore-errors (nth 4 (org-heading-components))) - "No heading") - block-counter))) - (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) - (assignments-cmd - (intern (concat "org-babel-variable-assignments:" src-lang))) - (body - ;; Run the tangle-body-hook. - (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. - (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) - (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)))) - (comment - (when (or (string= "both" (cdr (assq :comments params))) - (string= "org" (cdr (assq :comments params)))) - ;; From the previous heading or code-block end - (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))))) - (result - (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 - (if org-src-preserve-indentation - (org-trim body t) - (org-trim (org-remove-indentation body))) - comment))) - (if only-this-block - (list (cons src-lang (list result))) - result))) - -(defun org-babel-tangle-comment-links (&optional info) - "Return a list of begin and end link comments for the code block at point." - (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))))))) - (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 -(defvar org-bracket-link-analytic-regexp) -(defun org-babel-detangle (&optional source-code-file) - "Propagate changes in source file back original to Org file. -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)) - (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." - (interactive) - (let ((mid (point)) - start body-start end - target-buffer target-char link path block-name body) - (save-window-excursion - (save-excursion - (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) - (not ; ever wider searches until matching block comments - (and (setq start (line-beginning-position)) - (setq body-start (line-beginning-position 2)) - (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) - (setq end (line-beginning-position)))))))) - (unless (and start (< start mid) (< mid end)) - (error "Not in tangled code")) - (setq body (buffer-substring body-start end))) - (when (string-match "::" path) - (setq path (substring path 0 (match-beginning 0)))) - (find-file (or (car (org-id-find path)) path)) - (setq target-buffer (current-buffer)) - ;; Go to the beginning of the relative block in Org file. - (org-open-link-from-string link) - (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) - (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))))) - (org-babel-goto-named-src-block block-name)) - (goto-char (org-babel-where-is-src-block-head)) - ;; Preserve location of point within the source code in tangled - ;; code file. - (forward-line 1) - (forward-char (- mid body-start)) - (setq target-char (point))) - (org-src-switch-to-buffer target-buffer t) - (goto-char target-char) - body)) - -(provide 'ob-tangle) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob-tangle.el ends here |