Browse Source

STARTED re-work tangling system

  haven't done any debugging but all of the main code changes have
  been made in org-babel-tangle.el
Eric Schulte 16 years ago
parent
commit
56b18db9b8
2 changed files with 62 additions and 51 deletions
  1. 50 50
      lisp/org-babel-tangle.el
  2. 12 1
      org-babel.org

+ 50 - 50
lisp/org-babel-tangle.el

@@ -43,31 +43,32 @@ file.")
 org-mode formatted FILE.  This function will first export the
 org-mode formatted FILE.  This function will first export the
 source code using `org-babel-tangle' and then load the resulting
 source code using `org-babel-tangle' and then load the resulting
 file using `load-file'."
 file using `load-file'."
-  (let ((loadable-file (first (org-babel-tangle-file file "emacs-lisp"))))
-    (unless (file-exists-p loadable-file)
-      (error "can't load file that doesn't exist"))
-    (load-file loadable-file)
-    (message "loaded %s" loadable-file)))
-
-(defun org-babel-tangle-file (file &optional lang)
-  "Extract the bodies of all source code blocks in FILE with
-`org-babel-tangle'.  Optional argument LANG can be used to limit
-the exported source code blocks by language."
   (flet ((age (file)
   (flet ((age (file)
               (time-to-seconds
               (time-to-seconds
                (time-subtract (current-time)
                (time-subtract (current-time)
                               (sixth (file-attributes file))))))
                               (sixth (file-attributes file))))))
-    (let ((target-file (concat (file-name-sans-extension file) "."
-                               (second (assoc lang org-babel-tangle-langs)))))
-      (if (and lang (file-exists-p target-file) (> (age file) (age target-file)))
-          (list target-file)
-        (save-window-excursion (find-file file) (org-babel-tangle lang))))))
+    (let* ((base-name (file-name-sans-extension file))
+           (exported-file (concat base-name ".el")))
+      ;; tangle if the org-mode file is newer than the elisp file
+      (unless (and (file-exists-p exported-file) (> (age file) (age exported-file)))
+        (org-babel-tangle-file file base-name "emacs-lisp"))
+      (load-file exported-file)
+      (message "loaded %s" exported-file))))
+
+(defun org-babel-tangle-file (file &optional target-file lang)
+  "Extract the bodies of all source code blocks in FILE 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."
+  (save-window-excursion (find-file file) (org-babel-tangle target-file lang)))
 
 
-(defun org-babel-tangle (&optional lang)
+(defun org-babel-tangle (&optional target-file lang)
   "Extract the bodies of all source code blocks from the current
   "Extract the bodies of all source code blocks from the current
 file into their own source-specific files.  Optional argument
 file into their own source-specific files.  Optional argument
-LANG can be used to limit the exported source code blocks by
-language."
+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)
   (interactive)
   (save-excursion
   (save-excursion
     (let ((base-name (file-name-sans-extension (buffer-file-name)))
     (let ((base-name (file-name-sans-extension (buffer-file-name)))
@@ -76,37 +77,42 @@ language."
       (mapc ;; for every language create a file
       (mapc ;; for every language create a file
        (lambda (by-lang)
        (lambda (by-lang)
          (let* ((lang (car by-lang))
          (let* ((lang (car by-lang))
+                (specs (cdr by-lang))
                 (lang-f (intern (concat lang "-mode")))
                 (lang-f (intern (concat lang "-mode")))
                 (lang-specs (cdr (assoc lang org-babel-tangle-langs)))
                 (lang-specs (cdr (assoc lang org-babel-tangle-langs)))
                 (ext (first lang-specs))
                 (ext (first lang-specs))
-                (she-bang (second lang-specs))
-                (by-session (cdr by-lang)))
-           (flet ((to-file (filename specs)
-                           (add-to-list 'path-collector filename)
-                           (with-temp-file filename
-                             (funcall lang-f)
-                             (when she-bang (insert (concat she-bang "\n")))
-                             (comment-region
-			      (point) (progn (insert "generated by org-babel-tangle") (point)))
-                             (mapc #'org-babel-spec-to-string (reverse specs)))))
-             ;; if there are multiple sessions then break out by session
-             (if (> (length by-session) 1)
-                 (mapc (lambda (session-pair)
-                         (setq block-counter (+ block-counter (length (cdr session-pair))))
-                         (to-file (format
-				   "%s-%s.%s" base-name (car session-pair) ext) (cdr session-pair)))
-                       by-session)
-               (setq block-counter (+ block-counter (length (cdr (car by-session)))))
-               (to-file (format "%s.%s" base-name ext) (cdr (car by-session)))))))
+                (she-bang (second lang-specs)))
+           (mapc
+            (lambda (spec)
+              (let* ((tangle (cdr (assoc :tangle params)))
+                     (base-name (or (when (not (or (string= tangle "yes")
+                                                   (string= tangle "no")))
+                                      tangle)
+                                    target-file))
+                     (file-name (when base-name
+                                  (concat base-name "." ext))))
+                (when file-name
+                  ;; delete any old versions of file
+                  (unless (member file-name path-collector)
+                    (delete-file file-name))
+                  ;; drop source-block to file
+                  (with-temp-buffer
+                    (funcall lang-f)
+                    (when she-bang (insert (concat she-bang "\n")))
+                    (comment-region
+                     (point) (progn (insert "generated by org-babel-tangle") (point)))
+                    (org-babel-spec-to-string spec)
+                    (append-to-file nil nil file-name))
+                  (add-to-list 'path-collector file-name))))
+            specs)))
        (org-babel-tangle-collect-blocks lang))
        (org-babel-tangle-collect-blocks lang))
       (message "tangled %d source-code blocks" block-counter)
       (message "tangled %d source-code blocks" block-counter)
       path-collector)))
       path-collector)))
 
 
 (defun org-babel-tangle-collect-blocks (&optional lang)
 (defun org-babel-tangle-collect-blocks (&optional lang)
   "Collect all source blocks in the current org-mode file.
   "Collect all source blocks in the current org-mode file.
-Return two nested association lists, first grouped by language,
-then by session, the contents will be source-code block
-specifications of the form used by `org-babel-spec-to-string'.
+Return an association list of source-code block specifications of
+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 0) blocks)
@@ -121,20 +127,14 @@ code blocks by language."
              (body (second info))
              (body (second info))
              (params (third info))
              (params (third info))
              (spec (list link source-name params body))
              (spec (list link source-name params body))
-             (session (cdr (assoc :session params)))
-             by-lang by-session)
+             by-lang)
         (unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
         (unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
           (unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
           (unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
-            ;; add the spec for this block to blocks under it's language and session
+            ;; add the spec for this block to blocks under it's language
             (setq by-lang (cdr (assoc src-lang blocks)))
             (setq by-lang (cdr (assoc src-lang blocks)))
             (setq blocks (delq (assoc src-lang blocks) blocks))
             (setq blocks (delq (assoc src-lang blocks) blocks))
-            (setq by-session (cdr (assoc session by-lang)))
-            (setq by-lang (delq (assoc session by-lang) by-lang))
-            (setq blocks (cons ;; by-language
-                          (cons src-lang (cons ;; by-session
-                                          (cons session (cons spec by-session)) by-lang))
-                          blocks))))))
-    ;; blocks should contain all source-blocks organized by language and session
+            (setq blocks (cons (cons src-lang (cons spec by-lang)) blocks))))))
+    ;; blocks should contain all source-blocks organized by language
     ;; (message "blocks=%S" blocks) ;; debugging
     ;; (message "blocks=%S" blocks) ;; debugging
     blocks))
     blocks))
 
 

+ 12 - 1
org-babel.org

@@ -240,7 +240,7 @@ being generated at =ruby-nuweb.rb= with the following contents
 : puts "                            Ruby                            "
 : puts "                            Ruby                            "
 : puts "---------------------------footer---------------------------"
 : puts "---------------------------footer---------------------------"
 
 
-** TODO re-work tangling system
+** STARTED re-work tangling system
 Sometimes when tangling a file (e.g. when extracting elisp from a
 Sometimes when tangling a file (e.g. when extracting elisp from a
 org-mode file) we want to get nearly every source-code block.
 org-mode file) we want to get nearly every source-code block.
 
 
@@ -251,6 +251,17 @@ literate programming along the Nuweb model)
 I'm not sure how we can devise a single simple tangling system that
 I'm not sure how we can devise a single simple tangling system that
 naturally fits both of these use cases.
 naturally fits both of these use cases.
 
 
+*** new setup
+the =tangle= header argument will default to =no= meaning source-code
+blocks will *not* be exported by default.  In order for a source-code
+block to be tangled it needs to have an output file specified.  This
+can happen in two ways...
+
+1) a file-wide default output file can be passed to `org-babel-tangle'
+   which will then be used for all blocks
+2) if the value of the =tangle= header argument is anything other than
+   =no= or =yes= then it is used as the file name
+
 ** PROPOSED raise elisp error when source-blocks return errors
 ** PROPOSED raise elisp error when source-blocks return errors
 Not sure how/if this would work, but it may be desirable.
 Not sure how/if this would work, but it may be desirable.