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

contrib/babel/lisp/org-babel-exp.el

@@ -1,8 +1,8 @@
 ;;; org-babel-exp.el --- Exportation of org-babel source blocks
 
-;; Copyright (C) 2009 Eric Schulte
+;; Copyright (C) 2009 Eric Schulte, Dan Davison
 
-;; Author: Eric Schulte
+;; Author: Eric Schulte, Dan Davison
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -35,6 +35,27 @@
 (add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
 (add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners))
 
+(defvar org-babel-function-def-export-keyword "function"
+  "When exporting a source block function, this keyword will
+appear in the exported version in the place of #+srcname:. A
+source block is considered to be a source block function if the
+srcname is present and is followed by a parenthesised argument
+list. The parentheses may be empty or contain whitespace. An
+example is the following which generates n random
+(uniform) numbers.
+
+#+srcname: rand(n)
+#+begin_src R
+  runif(n)
+#+end_src
+")
+
+(defvar org-babel-function-def-export-indent 4
+  "When exporting a source block function, the block contents
+will be indented by this many characters. See
+`org-babel-function-def-export-name' for the definition of a
+source block function.")
+
 (defun org-babel-exp-src-blocks (body &rest headers)
   "Process src block for export.  Depending on the 'export'
 headers argument in replace the source code block with...
@@ -49,17 +70,12 @@ results - just like none only the block is run on export ensuring
 
 none ----- do not display either code or results upon export"
   (interactive)
-  (unless headers (error "org-babel can't process a source block without knowing the source code"))
   (message "org-babel-exp processing...")
-  (let* ((lang (car headers))
+  (let ((info (save-excursion
-         (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
+		(if (re-search-backward org-babel-src-block-regexp nil t)
-         (params (org-babel-merge-params
+		    (org-babel-get-src-block-info)
-                  org-babel-default-header-args
+		  (error "Failed to find src block.")))))
-                  (if (boundp lang-headers) (eval lang-headers) nil)
+    (org-babel-exp-do-export info 'block)))
-                  (org-babel-params-from-properties)
-                  (org-babel-parse-header-arguments
-                   (mapconcat #'identity (cdr headers) " ")))))
-    (org-babel-exp-do-export lang body params 'block)))
 
 (defun org-babel-exp-inline-src-blocks (start end)
   "Process inline src blocks between START and END for export.
@@ -72,8 +88,7 @@ options and are taken from `org-babel-defualt-inline-header-args'."
                 (re-search-forward org-babel-inline-src-block-regexp end t))
       (let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
              (replacement (save-match-data
-                            (org-babel-exp-do-export
+                            (org-babel-exp-do-export info 'inline))))
-                             (first info) (second info) (third info) 'inline))))
         (setq end (+ end (- (length replacement) (length (match-string 1)))))
         (replace-match replacement t t nil 1)))))
 
@@ -90,38 +105,61 @@ options are taken from `org-babel-default-header-args'."
 	(setq replacement
 	      (save-match-data
 		(org-babel-exp-do-export
-		 "emacs-lisp" "results"
+		 (list "emacs-lisp" "results"
 		       (org-babel-merge-params
 			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 (lang body params type)
+(defun org-babel-exp-do-export (info type)
-  (case (intern (or (cdr (assoc :exports params)) "code"))
+  (case (intern (or (cdr (assoc :exports (third info))) "code"))
     ('none "")
-    ('code (org-babel-exp-code lang body params type))
+    ('code (org-babel-exp-code info type))
-    ('results (org-babel-exp-results lang body params type))
+    ('results (org-babel-exp-results info type))
-    ('both (concat (org-babel-exp-code lang body params type)
+    ('both (concat (org-babel-exp-code info type)
                    "\n\n"
-                   (org-babel-exp-results lang body params type)))))
+                   (org-babel-exp-results info type)))))
 
-(defun org-babel-exp-code (lang body params type)
+(defun org-babel-exp-code (info type)
+  (let ((lang (first info))
+	(body (second info))
+	(switches (fourth info))
+	(name (fifth info))
+	(args (sixth info))
+	(function-def-line ""))
     (case type
-      ('inline (format "=%s=" body))
+      ('inline (format "=%s=" (second info)))
-      ('block (format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
+      ('block
-		      (if (string-match "\n$" body) "" "\n")))
+	  (when args
+	    (unless (string-match "-i\\>" switches)
+	      (setq switches (concat switches " -i")))
+	    (setq body (with-temp-buffer
+			 (insert body)
+			 (indent-code-rigidly (point-min) (point-max) org-babel-function-def-export-indent)
+			 (buffer-string)))
+	    (setq args (mapconcat #'identity
+				  (delq nil (mapcar (lambda (el) (and (length (cdr el)) (cdr el))) args))
+				  ", "))
+	    (setq function-def-line
+		  (format "#+BEGIN_SRC org-babel-lob\n%s %s(%s):\n#+END_SRC\n"
+			  org-babel-function-def-export-keyword name args)))
+        (concat function-def-line
+                (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC" lang switches body
+                        (if (string-match "\n$" body) "" "\n"))))
       ('lob (save-excursion
 	      (re-search-backward org-babel-lob-one-liner-regexp)
 	      (format "#+BEGIN_SRC org-babel-lob\n%s\n#+END_SRC"
-                      (first (org-babel-lob-get-info)))))))
+                      (first (org-babel-lob-get-info))))))))
 
-(defun org-babel-exp-results (lang body params type)
+(defun org-babel-exp-results (info type)
-  (let ((params
+  (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
@@ -130,11 +168,12 @@ options are taken from `org-babel-default-header-args'."
                        `(:var . ,(concat (match-string 1 (cdr pair))
                                          "=" org-current-export-file
                                          ":" (match-string 2 (cdr pair))))
-                     pair)) params)))
+                     pair))
+		 (third info))))
     (case type
       ('inline
         (let ((raw (org-babel-execute-src-block
-                    nil (list lang body params) '((:results . "silent"))))
+                    nil info '((:results . "silent"))))
               (result-params (split-string (cdr (assoc :results params)))))
           (cond ;; respect the value of the :results header argument
            ((member "file" result-params)

contrib/babel/lisp/org-babel-lob.el

@@ -1,8 +1,8 @@
 ;;; org-babel-lob.el --- The Library of Babel: off-the-shelf functions for data analysis and plotting using org-babel
 
-;; Copyright (C) 2009 Dan Davison, Eric Schulte
+;; Copyright (C) 2009 Eric Schulte, Dan Davison
 
-;; Author: Dan Davison, Eric Schulte
+;; Author: Eric Schulte, Dan Davison
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -31,6 +31,7 @@
 ;;; Code:
 (require 'org-babel)
 (require 'org-babel-table)
+(require 'org-babel-exp)
 
 (defvar org-babel-library-of-babel nil
   "Library of source-code blocks.  This is an association list.
@@ -46,8 +47,8 @@ add files to this list use the `org-babel-lob-ingest' command."
   "Add all source-blocks defined in FILE to `org-babel-library-of-babel'."
   (interactive "f")
   (org-babel-map-source-blocks file
-    (let ((source-name (intern (org-babel-get-src-block-name)))
+    (let* ((info (org-babel-get-src-block-info))
-          (info (org-babel-get-src-block-info)))
+	   (source-name (intern (fifth info))))
       (when source-name
         (setq org-babel-library-of-babel
               (cons (cons source-name info)
@@ -94,7 +95,7 @@ the word 'call'."
     (org-babel-execute-src-block nil (list "emacs-lisp" "results" params))))
 
 (define-generic-mode org-babel-lob-mode
-  '("#") nil nil nil nil
+  '("#") (list org-babel-function-def-export-keyword) nil nil nil
   "Major mode for fontification of library of babel lines on export")
 
 (provide 'org-babel-lob)

contrib/babel/lisp/org-babel-tangle.el

@@ -1,8 +1,8 @@
 ;;; org-babel-tangle.el --- Extract source code from org-mode files
 
-;; Copyright (C) 2009 Dan Davison, Eric Schulte
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Dan Davison, Eric Schulte
+;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
@@ -153,9 +153,9 @@ code blocks by language."
       (setq block-counter (+ 1 block-counter))
       (let* ((link (progn (call-interactively 'org-store-link)
                           (org-babel-clean-text-properties (car (pop org-stored-links)))))
-             (source-name (intern (or (org-babel-get-src-block-name)
-                                      (format "block-%d" block-counter))))
              (info (org-babel-get-src-block-info))
+             (source-name (intern (or (fifth info)
+                                      (format "block-%d" block-counter))))
              (src-lang (first info))
              (body (org-babel-expand-noweb-references info))
              (params (third info))

contrib/babel/lisp/org-babel.el

@@ -109,11 +109,12 @@ then run `org-babel-pop-to-session'."
 (defun org-babel-set-interpreters (var value)
   (set-default var value)
   (setq org-babel-src-block-regexp
-	(concat "^[ \t]*#\\+begin_src[ \t]+\\("
+	(concat "^[ \t]*#\\+begin_src[ \t]+\\("       ;; (1)   lang
 		(mapconcat 'regexp-quote value "\\|")
 		"\\)[ \t]*"
-                "\\([ \t]+\\([^\n]+\\)\\)?\n" ;; match header arguments
+		"\\([^:\n]*\\)"                       ;; (2)   switches
-                "\\([^\000]+?\\)#\\+end_src"))
+		"\\([^\n]*\\)\n"                      ;; (3)   header arguments
+                "\\([^\000]+?\\)#\\+end_src"))        ;; (4)   body
   (setq org-babel-inline-src-block-regexp
 	(concat "[ \f\t\n\r\v]\\(src_"                ;; (1)   replacement target
 		"\\("                                 ;; (2)   lang
@@ -174,8 +175,7 @@ the header arguments specified at the source code block."
   ;; (message "supplied params=%S" params) ;; debugging
   (let* ((info (or info (org-babel-get-src-block-info)))
          (lang (first info))
-         (params (org-babel-merge-params
+         (params (org-babel-merge-params (third info) params))
-                  (third info) (org-babel-get-src-block-function-args) params))
          (body (if (assoc :noweb params)
                    (org-babel-expand-noweb-references info) (second info)))
          (processed-params (org-babel-process-params params))
@@ -299,51 +299,41 @@ concerned with creating elisp versions of results. "
     (org-babel-execute-buffer)
     (widen)))
 
-(defun org-babel-get-src-block-name ()
+(defun org-babel-get-src-block-info (&optional header-vars-only)
-  "Return the name of the current source block if one exists.
+  "Get information of the current source block.
-
+Returns a list
-This function is analogous to org-babel-lob-get-info. For both
+ (language body header-arguments-alist switches name function-args).
-functions, after they are called, (match-string 1) matches the
+Unless HEADER-VARS-ONLY is non-nil, any variable
-function name, and (match-string 3) matches the function
+references provided in 'function call style' (i.e. in a
-arguments inside the parentheses. I think perhaps these functions
+parenthesised argument list following the src block name) are
-should be renamed to bring out this similarity, perhaps involving
+added to the header-arguments-alist."
-the word 'call'.
+  (let ((case-fold-search t) head info args)
-
+    (if (setq head (org-babel-where-is-src-block-head))
-Currently the function `org-babel-get-src-block-function-args'
-relies on the match-data from a match in this function.  I think
-splitting a match and the use of it's data is bad form, and we
-should re-work these two functions, perhaps combining them into
-one function which returns more data than just the name. [Eric]"
-  (let ((case-fold-search t)
-	(head (org-babel-where-is-src-block-head)))
-    (if head
         (save-excursion
 	  (goto-char head)
-	  (if (save-excursion
+	  (setq info (org-babel-parse-src-block-match))
 	  (forward-line -1)
-                ;; the second match of this regexp is used later to
+	  (when (looking-at "#\\+srcname:[ \t]*\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
-                ;; find arguments in the "functional" style, where
+	    (setq info (append info (list (org-babel-clean-text-properties (match-string 1)))))
-                ;; they are passed as part of the source name line
+	    ;; Note that e.g. "name()" and "name( )" result in ((:var . "")).
-		(looking-at "#\\+srcname:[ \t]*\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
+	    ;; We maintain that behaviour, and the resulting non-nil sixth
-	      (org-babel-clean-text-properties (match-string 1)))))))
+	    ;; element is relied upon in org-babel-exp-code to detect a functional-style
-
+	    ;; block in those cases. However, "name" without any
-(defun org-babel-get-src-block-info ()
+	    ;; parentheses would result in the same thing, so we
-  "Return the information of the current source block as a list
+	    ;; explicitly avoid that.
-of the following form.  (language body header-arguments-alist)"
+	    (if (setq args (match-string 3))
-  (let ((case-fold-search t) head)
+		(setq info (append info (list (mapcar (lambda (ref) (cons :var ref))
-    (if (setq head (org-babel-where-is-src-block-head))
+						      (org-babel-ref-split-args args))))))
-        (save-excursion (goto-char head) (org-babel-parse-src-block-match))
+	    (unless header-vars-only
+	      (setf (third info)
+		    (org-babel-merge-params (sixth info) (third info)))))
+	  info)
       (if (save-excursion ;; inline source block
             (re-search-backward "[ \f\t\n\r\v]" nil t)
             (looking-at org-babel-inline-src-block-regexp))
           (org-babel-parse-inline-src-block-match)
         nil)))) ;; indicate that no source block was found
 
-(defun org-babel-get-src-block-function-args ()
-  (when (org-babel-get-src-block-name)
-    (mapcar (lambda (ref) (cons :var ref))
-	    (org-babel-ref-split-args (match-string 3)))))
-
 (defmacro org-babel-map-source-blocks (file &rest body)
   "Evaluate BODY forms on each source-block in FILE."
   (declare (indent 1))
@@ -373,8 +363,10 @@ may be specified in the properties of the current outline entry."
 (defun org-babel-parse-src-block-match ()
   (let* ((lang (org-babel-clean-text-properties (match-string 1)))
          (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
+	 (switches (match-string 2))
          (body (org-babel-clean-text-properties (match-string 4)))
-	 (preserve-indentation org-src-preserve-indentation))
+	 (preserve-indentation (or org-src-preserve-indentation
+				   (string-match "-i\\>" switches))))
     (list lang
           ;; get src block body removing properties, protective commas, and indentation
           (with-temp-buffer
@@ -386,7 +378,8 @@ may be specified in the properties of the current outline entry."
 	   org-babel-default-header-args
            (org-babel-params-from-properties)
 	   (if (boundp lang-headers) (eval lang-headers) nil)
-	   (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) "")))))))
+	   (org-babel-parse-header-arguments (org-babel-clean-text-properties (or (match-string 3) ""))))
+	  switches)))
 
 (defun org-babel-parse-inline-src-block-match ()
   (let* ((lang (org-babel-clean-text-properties (match-string 2)))
@@ -488,7 +481,8 @@ line.  If no result exists for this block then create a
   (save-excursion
     (let* ((on-lob-line (progn (beginning-of-line 1)
 			       (looking-at org-babel-lob-one-liner-regexp)))
-	   (name (if on-lob-line (first (org-babel-lob-get-info)) (org-babel-get-src-block-name)))
+	   (name (if on-lob-line (first (org-babel-lob-get-info))
+		   (fifth (org-babel-get-src-block-info))))
 	   (head (unless on-lob-line (org-babel-where-is-src-block-head))) end)
       (when head (goto-char head))
       (or (and name (org-babel-find-named-result name))