Changes
[emacs.git] / .emacs.d / elisp / org / ob-tangle.el
index 3a43b42..1c159a5 100644 (file)
@@ -27,8 +27,6 @@
 
 ;;; Code:
 (require 'org-src)
-(eval-when-compile
-  (require 'cl))
 
 (declare-function org-edit-special "org" (&optional arg))
 (declare-function org-link-escape "org" (text &optional table))
 (declare-function org-back-to-heading "org" (invisible-ok))
 (declare-function org-fill-template "org" (template alist))
 (declare-function org-babel-update-block-body "org" (new-body))
+(declare-function org-up-heading-safe "org" ())
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
 (declare-function make-directory "files" (dir &optional parents))
+(declare-function org-before-first-heading-p "org" ())
 
 (defcustom org-babel-tangle-lang-exts
-  '(("emacs-lisp" . "el"))
+  '(("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
@@ -54,6 +56,11 @@ then the name of the language is used."
           (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-mode 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
@@ -81,6 +88,11 @@ information into the output using `org-fill-template'.
 %link --------- Org-mode 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
@@ -96,17 +108,30 @@ information into the output using `org-fill-template'.
 %link --------- Org-mode 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-process-comment-text #'org-babel-trim
+(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-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'."
+result.  The default value is `org-remove-indentation'."
   :group 'org-babel
   :version "24.1"
   :type 'function)
@@ -176,12 +201,12 @@ used to limit the 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 (equal arg '(4))
-      (let ((head (org-babel-where-is-src-block-head)))
+    (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"))))
-    (save-excursion
       (let ((block-counter 0)
            (org-babel-default-header-args
             (if target-file
@@ -246,6 +271,10 @@ used to limit the exported source code blocks by language."
                            (if (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 (assoc :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
@@ -304,13 +333,23 @@ 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))
+        (file (if org-babel-tangle-use-relative-file-links
+                  (file-relative-name (nth 1 spec))
+                (nth 1 spec)))
+        (link (let ((link (nth 2 spec)))
+                (if org-babel-tangle-use-relative-file-links
+                    (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
+                      (let* ((type (match-string 1 link))
+                             (path (match-string 2 link))
+                             (origpath path)
+                             (case-fold-search nil))
+                        (setq path (file-relative-name path))
+                        (concat type path)))
+                  link)))
         (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)
@@ -321,15 +360,20 @@ that the appropriate major-mode is set.  SPEC has the form:
         (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")))))
+                            (if org-babel-tangle-uncomment-comments
+                                ;; just plain comments with no processing
+                                (insert text)
+                              ;; ensure comments are made to be
+                              ;; comments, and add a trailing newline
+                              (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"
@@ -340,7 +384,6 @@ that the appropriate major-mode is set.  SPEC has the form:
        insert-comment
        (org-fill-template org-babel-tangle-comment-format-end link-data)))))
 
-(defvar org-comment-string) ;; Defined in org.el
 (defun org-babel-tangle-collect-blocks (&optional language tangle-file)
   "Collect source blocks in the current Org-mode file.
 Return an association list of source-code block specifications of
@@ -350,21 +393,21 @@ source code blocks by language.  Optional argument TANGLE-FILE
 can be used to limit the collected code blocks by target file."
   (let ((block-counter 1) (current-heading "") blocks by-lang)
     (org-babel-map-src-blocks (buffer-file-name)
-      (lambda (new-heading)
-       (if (not (string= new-heading current-heading))
-           (progn
-             (setq block-counter 1)
-             (setq current-heading new-heading))
-         (setq block-counter (+ 1 block-counter))))
-      (replace-regexp-in-string "[ \t]" "-"
-                               (condition-case nil
-                                   (or (nth 4 (org-heading-components))
-                                       "(dummy for heading without text)")
-                                 (error (buffer-file-name))))
+      ((lambda (new-heading)
+        (if (not (string= new-heading current-heading))
+            (progn
+              (setq block-counter 1)
+              (setq current-heading new-heading))
+          (setq block-counter (+ 1 block-counter))))
+       (replace-regexp-in-string "[ \t]" "-"
+                                (condition-case nil
+                                    (or (nth 4 (org-heading-components))
+                                        "(dummy for heading without text)")
+                                  (error (buffer-file-name)))))
       (let* ((info (org-babel-get-src-block-info 'light))
             (src-lang (nth 0 info))
             (src-tfile (cdr (assoc :tangle (nth 2 info)))))
-        (unless (or (string-match (concat "^" org-comment-string) current-heading)
+        (unless (or (org-in-commented-heading-p)
                    (string= (cdr (assoc :tangle (nth 2 info))) "no")
                    (and tangle-file (not (equal tangle-file src-tfile))))
           (unless (and language (not (string= language src-lang)))