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-parse-header-arguments
 			 (org-babel-clean-text-properties
 			 (org-babel-clean-text-properties
 			  (concat ":var results="
 			  (concat ":var results="
-				  (mapconcat #'identity (org-babel-lob-get-info) " "))))))
+				  (mapconcat #'identity
+					     (org-babel-lob-get-info) " "))))))
 		 'lob)))
 		 'lob)))
 	(setq end (+ end (- (length replacement) (length (match-string 0)))))
 	(setq end (+ end (- (length replacement) (length (match-string 0)))))
 	(replace-match replacement t t)))))
 	(replace-match replacement t t)))))
 
 
 (defun org-babel-exp-do-export (info type)
 (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"))
   (case (intern (or (cdr (assoc :exports (third info))) "code"))
     ('none "")
     ('none "")
     ('code (org-babel-exp-code info type))
     ('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)))))
                    (org-babel-exp-results info type)))))
 
 
 (defun org-babel-exp-code (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))
   (let ((lang (first info))
         (body (second info))
         (body (second info))
         (switches (fourth info))
         (switches (fourth info))
         (name (fifth 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
     (case type
       ('inline (format "=%s=" body))
       ('inline (format "=%s=" body))
       ('block
       ('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
       ('lob
        (let ((call-line (and (string-match "results=" (car args))
        (let ((call-line (and (string-match "results=" (car args))
                              (substring (car args) (match-end 0)))))
                              (substring (car args) (match-end 0)))))
          (cond
          (cond
           ((eq backend 'html)
           ((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)))))))))
           ((t (format ": %s\n" call-line)))))))))
 
 
 (defun org-babel-exp-results (info type)
 (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))
   (let ((lang (first info))
 	(body (second info))
 	(body (second info))
 	(params
 	(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
     (case type
       ('inline
       ('inline
         (let ((raw (org-babel-execute-src-block
         (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"))))
            nil nil (org-babel-merge-params params '((:results . "replace"))))
         "")
         "")
       ('lob
       ('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)
 (provide 'org-babel-exp)
 ;;; org-babel-exp.el ends here
 ;;; 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)
 (defun org-babel-ref-literal (ref)
   "Determine if the right side of a header argument variable
   "Determine if the right side of a header argument variable
 assignment is a literal value or is a reference to some external
 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."
 return nil."
   (let ((out (org-babel-read ref)))
   (let ((out (org-babel-read ref)))
     (if (equal out 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))
     (let* ((base-name (file-name-sans-extension file))
            (exported-file (concat base-name ".el")))
            (exported-file (concat base-name ".el")))
       ;; tangle if the org-mode file is newer than the elisp file
       ;; 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"))
         (org-babel-tangle-file file exported-file "emacs-lisp"))
       (load-file exported-file)
       (load-file exported-file)
       (message "loaded %s" 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
 argument LANG can be used to limit the exported source code
 blocks by language."
 blocks by language."
   (interactive "fFile to tangle: \nP")
   (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)
 (defun org-babel-tangle-publish (_ filename pub-dir)
   "Tangle FILENAME and place the results in PUB-DIR."
   "Tangle FILENAME and place the results in PUB-DIR."
@@ -91,12 +99,13 @@ exported source code blocks by language."
        (lambda (by-lang)
        (lambda (by-lang)
          (let* ((lang (car by-lang))
          (let* ((lang (car by-lang))
                 (specs (cdr 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)))
                 (lang-specs (cdr (assoc lang org-babel-tangle-langs)))
                 (ext (first lang-specs))
                 (ext (first lang-specs))
                 (she-bang (second lang-specs))
                 (she-bang (second lang-specs))
@@ -112,7 +121,8 @@ exported source code blocks by language."
                                    she-bang))
                                    she-bang))
                        (base-name (or (cond
                        (base-name (or (cond
                                        ((string= "yes" tangle)
                                        ((string= "yes" tangle)
-                                        (file-name-sans-extension (buffer-file-name)))
+                                        (file-name-sans-extension
+					 (buffer-file-name)))
                                        ((string= "no" tangle) nil)
                                        ((string= "no" tangle) nil)
                                        ((> (length tangle) 0) tangle))
                                        ((> (length tangle) 0) tangle))
                                       target-file))
                                       target-file))
@@ -120,10 +130,6 @@ exported source code blocks by language."
                                     ;; decide if we want to add ext to base-name
                                     ;; decide if we want to add ext to base-name
                                     (if (and ext (string= "yes" tangle))
                                     (if (and ext (string= "yes" tangle))
                                         (concat base-name "." ext) 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
                   (when file-name
                     ;; delete any old versions of file
                     ;; delete any old versions of file
                     (when (and (file-exists-p file-name)
                     (when (and (file-exists-p file-name)
@@ -178,7 +184,8 @@ code blocks by language."
     (org-babel-map-source-blocks (buffer-file-name)
     (org-babel-map-source-blocks (buffer-file-name)
       (setq block-counter (+ 1 block-counter))
       (setq block-counter (+ 1 block-counter))
       (let* ((link (progn (call-interactively 'org-store-link)
       (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))
              (info (org-babel-get-src-block-info))
              (source-name (intern (or (fifth info)
              (source-name (intern (or (fifth info)
                                       (format "block-%d" block-counter))))
                                       (format "block-%d" block-counter))))
@@ -186,8 +193,8 @@ code blocks by language."
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
              (params (third info))
              (params (third info))
              by-lang)
              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
             ;; 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))
@@ -199,18 +206,27 @@ code blocks by language."
                                         (if (assoc :no-expand params)
                                         (if (assoc :no-expand params)
                                             body
                                             body
                                           (funcall
                                           (funcall
-					   (if (fboundp expand-cmd) expand-cmd 'org-babel-expand-body:generic)
+					   (if (fboundp expand-cmd)
+					       expand-cmd
+					     'org-babel-expand-body:generic)
                                            body
                                            body
                                            params)))
                                            params)))
                                       (if (and (cdr (assoc :noweb 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))))))
                                by-lang)) blocks))))))
     ;; ensure blocks in the correct order
     ;; ensure blocks in the correct order
     (setq blocks
     (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
     ;; blocks should contain all source-blocks organized by language
     ;; (message "blocks=%S" blocks) ;; debugging
     ;; (message "blocks=%S" blocks) ;; debugging
     blocks))
     blocks))
@@ -226,14 +242,17 @@ form
                          (when (and commentable
                          (when (and commentable
 				    org-babel-tangle-w-comments)
 				    org-babel-tangle-w-comments)
                            (insert "\n")
                            (insert "\n")
-                           (comment-region (point) (progn (insert text) (point)))
+                           (comment-region (point)
+					   (progn (insert text) (point)))
                            (end-of-line nil)
                            (end-of-line nil)
                            (insert "\n"))))
                            (insert "\n"))))
     (let ((link (first spec))
     (let ((link (first spec))
           (source-name (second spec))
           (source-name (second spec))
           (body (fourth 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)))))
                               (fifth spec)))))
       (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
       (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
       (insert (format "%s" (org-babel-chomp body)))
       (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)
 (defmacro org-babel-map-source-blocks (file &rest body)
   "Evaluate BODY forms on each source-block in FILE."
   "Evaluate BODY forms on each source-block in FILE."
   (declare (indent 1))
   (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
      (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)
        (while (re-search-forward org-babel-src-block-regexp nil t)
          (goto-char (match-beginning 0))
          (goto-char (match-beginning 0))
          (save-match-data ,@body)
          (save-match-data ,@body)
          (goto-char (match-end 0))))
          (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)
 (defun org-babel-params-from-properties (&optional lang)
   "Return an association list of any source block params which
   "Return an association list of any source block params which