Browse Source

babel: more informative automatically generated block names in tangled comments

* lisp/ob-tangle.el (org-babel-tangle-collect-blocks): more
  informative automatically generated block names in comments
Eric Schulte 14 years ago
parent
commit
e3aaaec91c
1 changed files with 12 additions and 3 deletions
  1. 12 3
      lisp/ob-tangle.el

+ 12 - 3
lisp/ob-tangle.el

@@ -33,6 +33,7 @@
   (require 'cl))
   (require 'cl))
 
 
 (declare-function org-link-escape "org" (text &optional table))
 (declare-function org-link-escape "org" (text &optional table))
+(declare-function org-heading-components "org" ())
 (declare-function with-temp-filebuffer "org-interaction" (file &rest body))
 (declare-function with-temp-filebuffer "org-interaction" (file &rest body))
 
 
 (defcustom org-babel-tangle-lang-exts
 (defcustom org-babel-tangle-lang-exts
@@ -199,15 +200,23 @@ Return an association list of source-code block specifications of
 the form used by `org-babel-spec-to-string' grouped by language.
 the form used by `org-babel-spec-to-string' grouped by language.
 Optional argument LANG can be used to limit the collected source
 Optional argument LANG can be used to limit the collected source
 code blocks by language."
 code blocks by language."
-  (let ((block-counter 0) blocks)
+  (let ((block-counter 1) (current-heading "") blocks)
     (org-babel-map-src-blocks (buffer-file-name)
     (org-babel-map-src-blocks (buffer-file-name)
-      (setq block-counter (+ 1 block-counter))
+      ((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]" "-"
+				 (nth 4 (org-heading-components))))
       (let* ((link (progn (call-interactively 'org-store-link)
       (let* ((link (progn (call-interactively 'org-store-link)
                           (org-babel-clean-text-properties
                           (org-babel-clean-text-properties
 			   (car (pop org-stored-links)))))
 			   (car (pop org-stored-links)))))
              (info (org-babel-get-src-block-info))
              (info (org-babel-get-src-block-info))
              (source-name (intern (or (nth 4 info)
              (source-name (intern (or (nth 4 info)
-                                      (format "block-%d" block-counter))))
+                                      (format "%s:%d"
+					      current-heading block-counter))))
              (src-lang (nth 0 info))
              (src-lang (nth 0 info))
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
              (params (nth 2 info))
              (params (nth 2 info))