瀏覽代碼

babel: added :shebang and :comments header arguments for finer control over tangled output

Eric Schulte 15 年之前
父節點
當前提交
3ce4962447
共有 2 個文件被更改,包括 55 次插入44 次删除
  1. 40 36
      contrib/babel/lisp/org-babel-tangle.el
  2. 15 8
      contrib/babel/lisp/org-babel.el

+ 40 - 36
contrib/babel/lisp/org-babel-tangle.el

@@ -95,41 +95,43 @@ exported source code blocks by language."
                 she-banged)
            (mapc
             (lambda (spec)
-              (let* ((tangle (cdr (assoc :tangle (third spec))))
-                     (base-name (or (cond
-                                     ((string= "yes" tangle)
-                                      (file-name-sans-extension (buffer-file-name)))
-                                     ((string= "no" tangle) nil)
-                                     ((> (length tangle) 0) tangle))
-                                    target-file))
-                     (file-name (when base-name
-                                  (if (and ext
-                                          (string= base-name
-                                                   (file-name-sans-extension base-name)))
-                                     (concat base-name "." ext) base-name))))
-                ;; ;; debugging
-                ;; (message "tangle=%S base-name=%S file-name=%S"
-                ;;          tangle base-name file-name)
-                (when file-name
-                  ;; 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
-                    (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)))
-                    (when commentable
-                      (comment-region
-                       (point) (progn (insert "generated by org-babel-tangle") (point)))
-                      (move-end-of-line nil))
-                    (org-babel-spec-to-string spec)
-                    (append-to-file nil nil file-name))
-                  ;; update counter
-                  (setq block-counter (+ 1 block-counter))
-                  (add-to-list 'path-collector file-name))))
+              (flet ((get-spec (name)
+                               (cdr (assoc name (third spec)))))
+                (let* ((tangle (get-spec :tangle))
+                       (she-bang (if (> (length (get-spec :shebang)) 0)
+                                     (get-spec :shebang)
+                                   she-bang))
+                       (base-name (or (cond
+                                       ((string= "yes" tangle)
+                                        (file-name-sans-extension (buffer-file-name)))
+                                       ((string= "no" tangle) nil)
+                                       ((> (length tangle) 0) tangle))
+                                      target-file))
+                       (file-name (when base-name
+                                    (if (and ext
+                                             (string= base-name
+                                                      (file-name-sans-extension base-name)))
+                                        (concat base-name "." ext) base-name))))
+                  ;; ;; debugging
+                  ;; (message
+                  ;;  "tangle=%S base-name=%S file-name=%S she-bang=%S commentable=%s"
+                  ;;  tangle base-name file-name she-bang commentable)
+                  (when file-name
+                    ;; 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
+                      (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)
+                      (append-to-file nil nil file-name))
+                    ;; 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" block-counter
@@ -197,7 +199,9 @@ form
     (let ((link (first spec))
           (source-name (second spec))
           (body (fourth spec))
-          (commentable (not (fifth spec))))
+          (commentable (not (if (> (length (cdr (assoc :comments (third spec)))) 0)
+                                (string= (cdr (assoc :comments (third spec))) "no")
+                              (fifth spec)))))
       (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
       (insert (format "%s" (org-babel-chomp body)))
       (insert-comment (format "%s ends here" source-name)))))

+ 15 - 8
contrib/babel/lisp/org-babel.el

@@ -835,7 +835,7 @@ parameters when merging lists."
 	   ("output" "value")))
 	(exports-exclusive-groups
 	 '(("code" "results" "both" "none")))
-	params results exports tangle noweb cache vars var ref)
+	params results exports tangle noweb cache vars var ref shebang comments)
     (flet ((e-merge (exclusive-groups &rest result-params)
                     ;; maintain exclusivity of mutually exclusive parameters
                     (let (output)
@@ -879,22 +879,29 @@ parameters when merging lists."
                          (setq tangle (or (list (cdr pair)) tangle)))
                         (:noweb
                          (setq noweb (e-merge '(("yes" "no"))
-                                               noweb (split-string (or (cdr pair) "")))))
+                                              noweb (split-string (or (cdr pair) "")))))
                         (:cache
                          (setq cache (e-merge '(("yes" "no"))
                                               cache (split-string (or (cdr pair) "")))))
+                        (:shebang ;; take the latest -- always overwrite
+                         (setq shebang (or (list (cdr pair)) shebang)))
+                        (:comments
+                         (setq comments (e-merge '(("yes" "no"))
+                                                 comments (split-string (or (cdr pair) "")))))
                         (t ;; replace: this covers e.g. :session
                          (setq params (cons pair (assq-delete-all (car pair) params))))))
                     plist))
             plists))
     (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars))
     (while vars (setq params (cons (cons :var (pop vars)) params)))
-    (cons (cons :cache (mapconcat 'identity cache " "))
-          (cons (cons :noweb (mapconcat 'identity noweb " "))
-                (cons (cons :tangle (mapconcat 'identity tangle " "))
-                      (cons (cons :exports (mapconcat 'identity exports " "))
-                            (cons (cons :results (mapconcat 'identity results " "))
-                                  params)))))))
+    (cons (cons :comments (mapconcat 'identity comments " "))
+          (cons (cons :shebang (mapconcat 'identity shebang " "))
+                (cons (cons :cache (mapconcat 'identity cache " "))
+                      (cons (cons :noweb (mapconcat 'identity noweb " "))
+                            (cons (cons :tangle (mapconcat 'identity tangle " "))
+                                  (cons (cons :exports (mapconcat 'identity exports " "))
+                                        (cons (cons :results (mapconcat 'identity results " "))
+                                              params)))))))))
 
 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   "This function expands Noweb style references in the body of