Browse Source

Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode

Carsten Dominik 15 years ago
parent
commit
32b58fad32

+ 45 - 27
contrib/babel/lisp/org-babel-exp.el

@@ -112,12 +112,15 @@ options are taken from `org-babel-default-header-args'."
 			(org-babel-parse-header-arguments
 			 (org-babel-clean-text-properties
 			  (concat ":var results="
-				  (mapconcat #'identity (org-babel-lob-get-info) " "))))))
+				  (mapconcat #'identity
+					     (org-babel-lob-get-info) " "))))))
 		 'lob)))
 	(setq end (+ end (- (length replacement) (length (match-string 0)))))
 	(replace-match replacement t t)))))
 
 (defun org-babel-exp-do-export (info type)
+  "Return a string containing the exported content of the current
+code block respecting the value of the :exports header argument."
   (case (intern (or (cdr (assoc :exports (third info))) "code"))
     ('none "")
     ('code (org-babel-exp-code info type))
@@ -127,46 +130,60 @@ options are taken from `org-babel-default-header-args'."
                    (org-babel-exp-results info type)))))
 
 (defun org-babel-exp-code (info type)
+  "Return the code the current code block in a manner suitable
+for exportation by org-mode.  This function is called by
+`org-babel-exp-do-export'."
   (let ((lang (first info))
         (body (second info))
         (switches (fourth info))
         (name (fifth info))
-        (args (mapcar #'cdr
-                      (remove-if-not (lambda (el) (eq :var (car el))) (third info)))))
+        (args (mapcar
+	       #'cdr
+	       (remove-if-not (lambda (el) (eq :var (car el))) (third info)))))
     (case type
       ('inline (format "=%s=" body))
       ('block
-          (let ((str (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body
-                             (if (and body (string-match "\n$" body))
-				 "" "\n"))))
-            (when name (add-text-properties 0 (length str)
-                                           (list 'org-caption
-                                                 (format "%s(%s)"
-                                                         name (mapconcat #'identity args ", ")))
-                                           str))
-           str))
+          (let ((str
+		 (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body
+			 (if (and body (string-match "\n$" body))
+			     "" "\n"))))
+            (when name
+	      (add-text-properties
+	       0 (length str)
+	       (list 'org-caption
+		     (format "%s(%s)"
+			     name
+			     (mapconcat #'identity args ", ")))
+	       str))
+	    str))
       ('lob
        (let ((call-line (and (string-match "results=" (car args))
                              (substring (car args) (match-end 0)))))
          (cond
           ((eq backend 'html)
-           (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n" call-line))
+           (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n"
+		   call-line))
           ((t (format ": %s\n" call-line)))))))))
 
 (defun org-babel-exp-results (info type)
+  "Return the results of the current code block in a manner
+suitable for exportation by org-mode.  This function is called by
+`org-babel-exp-do-export'."
   (let ((lang (first info))
 	(body (second info))
 	(params
-         ;; lets ensure that we lookup references in the original file
-         (mapcar (lambda (pair)
-                   (if (and org-current-export-file
-                            (eq (car pair) :var)
-                            (string-match org-babel-ref-split-regexp (cdr pair)))
-                       `(:var . ,(concat (match-string 1 (cdr pair))
-                                         "=" org-current-export-file
-                                         ":" (match-string 2 (cdr pair))))
-                     pair))
-		 (third info))))
+	 ;; lets ensure that we lookup references in the original file
+	 (mapcar
+	  (lambda (pair)
+	    (if (and org-current-export-file
+		     (eq (car pair) :var)
+		     (string-match org-babel-ref-split-regexp (cdr pair))
+		     (null (org-babel-ref-literal (match-string 2 (cdr pair)))))
+		`(:var . ,(concat (match-string 1 (cdr pair))
+				  "=" org-current-export-file
+				  ":" (match-string 2 (cdr pair))))
+	      pair))
+	  (third info))))
     (case type
       ('inline
         (let ((raw (org-babel-execute-src-block
@@ -189,10 +206,11 @@ options are taken from `org-babel-default-header-args'."
            nil nil (org-babel-merge-params params '((:results . "replace"))))
         "")
       ('lob
-          (save-excursion
-            (re-search-backward org-babel-lob-one-liner-regexp nil t)
-            (org-babel-execute-src-block
-             nil (list lang body (org-babel-merge-params params '((:results . "replace"))))) "")))))
+       (save-excursion
+	 (re-search-backward org-babel-lob-one-liner-regexp nil t)
+	 (org-babel-execute-src-block
+	  nil (list lang body (org-babel-merge-params
+			       params '((:results . "replace"))))) "")))))
 
 (provide 'org-babel-exp)
 ;;; org-babel-exp.el ends here

+ 2 - 1
contrib/babel/lisp/org-babel-ref.el

@@ -84,7 +84,8 @@ emacs-lisp representation of the value of the variable."
 (defun org-babel-ref-literal (ref)
   "Determine if the right side of a header argument variable
 assignment is a literal value or is a reference to some external
-resource.  If REF is literal then return it's value, otherwise
+resource.  REF should be a string of the right hand side of the
+assignment.  If REF is literal then return it's value, otherwise
 return nil."
   (let ((out (org-babel-read ref)))
     (if (equal out ref)

+ 44 - 25
contrib/babel/lisp/org-babel-tangle.el

@@ -58,7 +58,8 @@ file using `load-file'."
     (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)))
+      (unless (and (file-exists-p exported-file)
+		   (> (age file) (age exported-file)))
         (org-babel-tangle-file file exported-file "emacs-lisp"))
       (load-file exported-file)
       (message "loaded %s" exported-file))))
@@ -70,7 +71,14 @@ 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 "fFile to tangle: \nP")
-  (save-window-excursion (find-file file) (org-babel-tangle target-file lang)))
+  (let ((visited-p (get-file-buffer (expand-file-name file)))
+	to-be-removed)
+    (save-window-excursion
+      (find-file file)
+      (setq to-be-removed (current-buffer))
+      (org-babel-tangle 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."
@@ -91,12 +99,13 @@ exported source code blocks by language."
        (lambda (by-lang)
          (let* ((lang (car by-lang))
                 (specs (cdr by-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")))
+                (lang-f (intern
+			 (concat
+			  (or (and (cdr (assoc lang org-src-lang-modes))
+				   (symbol-name
+				    (cdr (assoc lang org-src-lang-modes))))
+			      lang)
+			  "-mode")))
                 (lang-specs (cdr (assoc lang org-babel-tangle-langs)))
                 (ext (first lang-specs))
                 (she-bang (second lang-specs))
@@ -112,7 +121,8 @@ exported source code blocks by language."
                                    she-bang))
                        (base-name (or (cond
                                        ((string= "yes" tangle)
-                                        (file-name-sans-extension (buffer-file-name)))
+                                        (file-name-sans-extension
+					 (buffer-file-name)))
                                        ((string= "no" tangle) nil)
                                        ((> (length tangle) 0) tangle))
                                       target-file))
@@ -120,10 +130,6 @@ exported source code blocks by language."
                                     ;; decide if we want to add ext to base-name
                                     (if (and ext (string= "yes" tangle))
                                         (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)
@@ -178,7 +184,8 @@ code blocks by language."
     (org-babel-map-source-blocks (buffer-file-name)
       (setq block-counter (+ 1 block-counter))
       (let* ((link (progn (call-interactively 'org-store-link)
-                          (org-babel-clean-text-properties (car (pop org-stored-links)))))
+                          (org-babel-clean-text-properties
+			   (car (pop org-stored-links)))))
              (info (org-babel-get-src-block-info))
              (source-name (intern (or (fifth info)
                                       (format "block-%d" block-counter))))
@@ -186,8 +193,8 @@ code blocks by language."
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
              (params (third info))
              by-lang)
-        (unless (string= (cdr (assoc :tangle params)) "no") ;; maybe skip
-          (unless (and lang (not (string= lang src-lang))) ;; maybe limit by language
+        (unless (string= (cdr (assoc :tangle params)) "no") ;; skip
+          (unless (and lang (not (string= lang src-lang))) ;; limit by language
             ;; add the spec for this block to blocks under it's language
             (setq by-lang (cdr (assoc src-lang blocks)))
             (setq blocks (delq (assoc src-lang blocks) blocks))
@@ -199,18 +206,27 @@ code blocks by language."
                                         (if (assoc :no-expand params)
                                             body
                                           (funcall
-					   (if (fboundp expand-cmd) expand-cmd 'org-babel-expand-body:generic)
+					   (if (fboundp expand-cmd)
+					       expand-cmd
+					     'org-babel-expand-body:generic)
                                            body
                                            params)))
                                       (if (and (cdr (assoc :noweb params))
-                                               (string= "yes" (cdr (assoc :noweb params))))
-                                          (org-babel-expand-noweb-references info) (second info)))
-                                     (third (cdr (assoc
-                                                  src-lang org-babel-tangle-langs))))
+                                               (string=
+						"yes"
+						(cdr (assoc :noweb params))))
+                                          (org-babel-expand-noweb-references
+					   info)
+					(second info)))
+                                     (third
+				      (cdr (assoc src-lang
+						  org-babel-tangle-langs))))
                                by-lang)) blocks))))))
     ;; ensure blocks in the correct order
     (setq blocks
-          (mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks))
+          (mapcar
+	   (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
+	   blocks))
     ;; blocks should contain all source-blocks organized by language
     ;; (message "blocks=%S" blocks) ;; debugging
     blocks))
@@ -226,14 +242,17 @@ form
                          (when (and commentable
 				    org-babel-tangle-w-comments)
                            (insert "\n")
-                           (comment-region (point) (progn (insert text) (point)))
+                           (comment-region (point)
+					   (progn (insert text) (point)))
                            (end-of-line nil)
                            (insert "\n"))))
     (let ((link (first spec))
           (source-name (second spec))
           (body (fourth spec))
-          (commentable (not (if (> (length (cdr (assoc :comments (third spec)))) 0)
-                                (string= (cdr (assoc :comments (third spec))) "no")
+          (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)))

+ 7 - 3
contrib/babel/lisp/org-babel.el

@@ -562,14 +562,18 @@ with C-c C-c."
 (defmacro org-babel-map-source-blocks (file &rest body)
   "Evaluate BODY forms on each source-block in FILE."
   (declare (indent 1))
-  `(let ((visited-p (get-buffer (file-name-nondirectory ,file))))
+  `(let ((visited-p (get-file-buffer (expand-file-name ,file)))
+	 to-be-removed)
      (save-window-excursion
-       (find-file ,file) (goto-char (point-min))
+       (find-file ,file)
+       (setq to-be-removed (current-buffer))
+       (goto-char (point-min))
        (while (re-search-forward org-babel-src-block-regexp nil t)
          (goto-char (match-beginning 0))
          (save-match-data ,@body)
          (goto-char (match-end 0))))
-     (unless visited-p (kill-buffer (file-name-nondirectory ,file)))))
+     (unless visited-p
+       (kill-buffer to-be-removed))))
 
 (defun org-babel-params-from-properties (&optional lang)
   "Return an association list of any source block params which