Browse Source

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

Carsten Dominik 14 years ago
parent
commit
70bc7786de

+ 6 - 2
doc/org.texi

@@ -11966,16 +11966,20 @@ interpreted language.
 
 
 The @code{:noweb} header argument controls expansion of ``noweb'' style (see
 The @code{:noweb} header argument controls expansion of ``noweb'' style (see
 @ref{Noweb reference syntax}) references in a code block.  This header
 @ref{Noweb reference syntax}) references in a code block.  This header
-argument can have one of two values: @code{yes} or @code{no}.
+argument can have one of three values: @code{yes} @code{no} or @code{tangle}.
 
 
 @itemize @bullet
 @itemize @bullet
+@item @code{yes}
+All ``noweb'' syntax references in the body of the code block will be
+expanded before the block is evaluated, tangled or exported.
 @item @code{no}
 @item @code{no}
 The default.  No ``noweb'' syntax specific action is taken on evaluating
 The default.  No ``noweb'' syntax specific action is taken on evaluating
 code blocks, However, noweb references will still be expanded during
 code blocks, However, noweb references will still be expanded during
 tangling.
 tangling.
 @item @code{yes}
 @item @code{yes}
 All ``noweb'' syntax references in the body of the code block will be
 All ``noweb'' syntax references in the body of the code block will be
-expanded before the block is evaluated.
+expanded before the block is tangled, however ``noweb'' references will not
+be expanded when the block is evaluated or exported.
 @end itemize
 @end itemize
 
 
 @subsubheading Noweb prefix lines
 @subsubheading Noweb prefix lines

+ 4 - 1
lisp/ob-tangle.el

@@ -294,7 +294,10 @@ code blocks by language."
 				   'org-babel-expand-body:generic)
 				   'org-babel-expand-body:generic)
 				 body params)))
 				 body params)))
 		    (if (and (cdr (assoc :noweb params))
 		    (if (and (cdr (assoc :noweb params))
-			     (string= "yes" (cdr (assoc :noweb params))))
+			     (let ((nowebs (split-string
+					    (cdr (assoc :noweb params)))))
+			       (or (member "yes" nowebs)
+				   (member "tangle" nowebs))))
 			(org-babel-expand-noweb-references info)
 			(org-babel-expand-noweb-references info)
 		      (nth 1 info))))
 		      (nth 1 info))))
 	     (comment (when (or (string= "both" (cdr (assoc :comments params)))
 	     (comment (when (or (string= "both" (cdr (assoc :comments params)))

+ 1 - 1
lisp/ob.el

@@ -1671,7 +1671,7 @@ This is taken almost directly from `org-read-prop'."
     cell))
     cell))
 
 
 (defun org-babel-number-p (string)
 (defun org-babel-number-p (string)
-  "Return t if STRING represents a number."
+  "If STRING represents a number return it's value."
   (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
   (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
            (= (length (substring string (match-beginning 0)
            (= (length (substring string (match-beginning 0)
 				 (match-end 0)))
 				 (match-end 0)))

+ 1 - 1
testing/README.org

@@ -21,7 +21,7 @@ Org-mode test framework.
 
 
 3) The =org-test-jump= command is now bound to =M-C-j= in all
 3) The =org-test-jump= command is now bound to =M-C-j= in all
    emacs-lisp files.  Call this command from any file in the =lisp/=
    emacs-lisp files.  Call this command from any file in the =lisp/=
-   directory of the org-mode repository to just to the related test
+   directory of the org-mode repository to jump to the related test
    file in the =testing/= directory.  Call this functions with a
    file in the =testing/= directory.  Call this functions with a
    prefix argument, and the corresponding test file will be stubbed
    prefix argument, and the corresponding test file will be stubbed
    out if it doesn't already exist.
    out if it doesn't already exist.

+ 1 - 0
testing/contrib/lisp/.gitignore

@@ -0,0 +1 @@
+# this file ensures that the testing/contrib/lisp directory is created by git

+ 29 - 0
testing/examples/babel.org

@@ -0,0 +1,29 @@
+#+Title: a collection of examples for Babel tests
+
+* =:noweb= header argument expansion
+  :PROPERTIES:
+  :ID:       eb1f6498-5bd9-45e0-9c56-50717053e7b7
+  :END:
+
+#+source: noweb-example
+#+begin_src emacs-lisp
+  (message "expanded")
+#+end_src
+
+#+begin_src emacs-lisp :noweb yes
+  ;; noweb-yes-start
+  <<noweb-example>>
+  ;; noweb-yes-end
+#+end_src
+
+#+begin_src emacs-lisp :noweb no
+  ;; noweb-no-start
+  <<noweb-example>>
+  ;; noweb-no-end
+#+end_src
+
+#+begin_src emacs-lisp :noweb tangle
+  ;; noweb-tangle-start
+  <<noweb-example>>
+  ;; noweb-tangle-end
+#+end_src

+ 25 - 2
testing/lisp/test-ob-exp.el

@@ -12,8 +12,12 @@
 
 
 
 
 ;;; Code:
 ;;; Code:
-(require 'org-test)
-(require 'org-test-ob-consts)
+(let ((load-path (cons (expand-file-name
+			".." (file-name-directory
+			      (or load-file-name buffer-file-name)))
+		       load-path)))
+  (require 'org-test)
+  (require 'org-test-ob-consts))
 
 
 
 
 ;;; Tests
 ;;; Tests
@@ -61,6 +65,25 @@
     (should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
     (should-not (file-exists-p (concat org-test-link-in-heading-file "::")))
     (when (file-exists-p html-file) (delete-file html-file))))
     (when (file-exists-p html-file) (delete-file html-file))))
 
 
+(ert-deftest ob-exp/noweb-on-export ()
+  "Noweb header arguments export correctly.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (let (html)
+    (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
+      (org-narrow-to-subtree)
+      (setq html (org-export-as-html nil nil nil 'string)))
+    (flet ((exp-p (arg)
+		  (and
+		   (string-match
+		    (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+		    html)
+		   (string-match "expanded" (match-string 1 html)))))
+      (should (exp-p "yes"))
+      (should-not (exp-p "no"))
+      (should-not (exp-p "tangle")))))
+
 (provide 'test-ob-exp)
 (provide 'test-ob-exp)
 
 
 ;;; test-ob-exp.el ends here
 ;;; test-ob-exp.el ends here

+ 48 - 0
testing/lisp/test-ob-tangle.el

@@ -0,0 +1,48 @@
+;;; test-ob-tangle.el
+
+;; Copyright (c) 2010 Eric Schulte
+;; Authors: Eric Schulte
+
+;; Released under the GNU General Public License version 3
+;; see: http://www.gnu.org/licenses/gpl-3.0.html
+
+;;;; Comments:
+
+;; Template test file for Org-mode tests
+
+
+;;; Code:
+(let ((load-path (cons (expand-file-name
+			".." (file-name-directory
+			      (or load-file-name buffer-file-name)))
+		       load-path)))
+  (require 'org-test)
+  (require 'org-test-ob-consts))
+
+
+;;; Tests
+(ert-deftest ob-tangle/noweb-on-tangle ()
+  "Noweb header arguments tangle correctly.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (let ((target-file (make-temp-file "ob-tangle-test-")))
+    (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
+      (org-narrow-to-subtree)
+      (org-babel-tangle target-file))
+    (let ((tang (with-temp-buffer
+		  (insert-file-contents target-file)
+		  (buffer-string))))
+      (flet ((exp-p (arg)
+		    (and
+		     (string-match
+		      (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+		      tang)
+		     (string-match "expanded" (match-string 1 tang)))))
+	(should (exp-p "yes"))
+	(should-not (exp-p "no"))
+	(should (exp-p "tangle"))))))
+
+(provide 'test-ob-tangle)
+
+;;; test-ob-tangle.el ends here

+ 6 - 2
testing/lisp/test-ob.el

@@ -12,8 +12,12 @@
 
 
 
 
 ;;; Code:
 ;;; Code:
-(require 'org-test)
-(require 'org-test-ob-consts)
+(let ((load-path (cons (expand-file-name
+			".." (file-name-directory
+			      (or load-file-name buffer-file-name)))
+		       load-path)))
+  (require 'org-test)
+  (require 'org-test-ob-consts))
 
 
 (ert-deftest test-org-babel-get-src-block-info-language ()
 (ert-deftest test-org-babel-get-src-block-info-language ()
   (org-test-at-marker nil org-test-file-ob-anchor
   (org-test-at-marker nil org-test-file-ob-anchor

+ 29 - 4
testing/org-test.el

@@ -79,6 +79,26 @@ If file is non-nil insert it's contents in there.")
 If file is not given, search for a file named after the test
 If file is not given, search for a file named after the test
 currently executed.")
 currently executed.")
 
 
+(defmacro org-test-at-id (id &rest body)
+  "Run body after placing the point in the headline identified by ID."
+  (declare (indent 1))
+  `(let* ((id-location (org-id-find ,id))
+	  (id-file (car id-location))
+	  (visited-p (get-file-buffer id-file))
+	  to-be-removed)
+     (save-window-excursion
+       (save-match-data
+	 (org-id-goto ,id)
+	 (setq to-be-removed (current-buffer))
+	 (condition-case nil
+	     (progn
+	       (org-show-subtree)
+	       (org-show-block-all))
+	   (error nil))
+	 (save-restriction ,@body)))
+     (unless visited-p
+       (kill-buffer to-be-removed))))
+
 (defmacro org-test-in-example-file (file &rest body)
 (defmacro org-test-in-example-file (file &rest body)
   "Execute body in the Org-mode example file."
   "Execute body in the Org-mode example file."
   (declare (indent 1))
   (declare (indent 1))
@@ -96,7 +116,7 @@ currently executed.")
 	       (org-show-subtree)
 	       (org-show-subtree)
 	       (org-show-block-all))
 	       (org-show-block-all))
 	   (error nil))
 	   (error nil))
-	 ,@body))
+	 (save-restriction ,@body)))
      (unless visited-p
      (unless visited-p
        (kill-buffer to-be-removed))))
        (kill-buffer to-be-removed))))
 
 
@@ -139,7 +159,12 @@ files."
        ";; Template test file for Org-mode tests\n\n"
        ";; Template test file for Org-mode tests\n\n"
        "\n"
        "\n"
        ";;; Code:\n"
        ";;; Code:\n"
-       "(require 'org-test)\n\n"
+       "(let ((load-path (cons (expand-file-name\n"
+       "			\"..\" (file-name-directory\n"
+       "			      (or load-file-name buffer-file-name)))\n"
+       "		       load-path)))\n"
+       "  (require 'org-test)\n"
+       "  (require 'org-test-ob-consts))\n\n"
        "\n"
        "\n"
        ";;; Tests\n"
        ";;; Tests\n"
        "(ert-deftest " name "/example-test ()\n"
        "(ert-deftest " name "/example-test ()\n"
@@ -174,11 +199,11 @@ files."
   (ert (car (which-function))))
   (ert (car (which-function))))
 
 
 (defun org-test-run-all-tests ()
 (defun org-test-run-all-tests ()
-  "Run all defined tests matching \"^org\".
+  "Run all defined tests matching \"\\(org\\|ob\\)\".
 Load all test files first."
 Load all test files first."
   (interactive)
   (interactive)
   (org-test-load)
   (org-test-load)
-  (ert "org"))
+  (ert "\\(org\\|ob\\)"))
 
 
 (provide 'org-test)
 (provide 'org-test)