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

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

@@ -58,7 +58,7 @@ none ----- do not display either code or results upon export"
                   (org-babel-params-from-properties)
                   (org-babel-parse-header-arguments
                    (mapconcat #'identity (cdr headers) " ")))))
-    (org-babel-exp-do-export lang body params)))
+    (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.
@@ -67,34 +67,62 @@ options and are taken from `org-babel-defualt-inline-header-args'."
   (interactive)
   (save-excursion
     (goto-char start)
-    (while (and (< (point) end) (re-search-forward org-babel-inline-src-block-regexp end t))
+    (while (and (< (point) end)
+                (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 (first info) (second info) (third info) t))))
+                            (org-babel-exp-do-export
+                             (first info) (second info) (third info) 'inline))))
+        ;; (message "%s -> %s" (second info) replacement) ;; debugging
         (setf end (+ end (- (length replacement)
                             (+ 6 (length (first info)) (length (second info))))))
         (replace-match replacement t t)))))
 
-(defun org-babel-exp-do-export (lang body params &optional inline)
+(defun org-babel-exp-do-export (lang body params type)
   (case (intern (or (cdr (assoc :exports params)) "code"))
     ('none "")
-    ('code (org-babel-exp-code body lang params inline))
-    ('results (org-babel-exp-results))
-    ('both (concat (org-babel-exp-code body lang params inline)
+    ('code (org-babel-exp-code body lang params type))
+    ('results (org-babel-exp-results body lang params type))
+    ('both (concat (org-babel-exp-code body lang params type)
                    "\n\n"
-                   (org-babel-exp-results)))))
-
-(defun org-babel-exp-code (body lang params &optional inline)
-  (if inline
-      (format "=%s=" body)
-    (format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
-            (if (string-match "\n$" body) "" "\n"))))
-
-(defun org-babel-exp-results ()
-  (save-excursion
-    ;; org-exp-blocks places us at the end of the block
-    (re-search-backward org-babel-src-block-regexp nil t)
-    (org-babel-execute-src-block) ""))
+                   (org-babel-exp-results body lang params type)))))
+
+(defun org-babel-exp-code (body lang params type)
+  (case type
+    ('inline (format "=%s=" body))
+    ('block (format "#+BEGIN_SRC %s\n%s%s\n#+END_SRC" lang body
+                    (if (string-match "\n$" body) "" "\n")))))
+
+(defun org-babel-exp-results (body lang params type)
+  (let ((params
+         ;; lets ensure that we lookup references in the original file
+         (mapcar (lambda (pair)
+                   (if (and (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)) params)))
+    (case type
+      ('inline
+        (let ((raw (org-babel-execute-src-block
+                    nil (list lang body params) '((:results . "silent"))))
+              (result-params (split-string (cdr (assoc :results params)))))
+          (cond ;; respect the value of the :results header argument
+           ((member "file" result-params)
+            (org-babel-result-to-file raw))
+           ((or (member "raw" result-params) (member "org" result-params))
+            raw)
+           ((member "code" result-params)
+            (format "src_%s{%s}" lang raw))
+           (t
+            (if (and (stringp raw) (= 0 (length raw)))
+                "=(no results)=" (format "=%S=" raw))))))
+      ('block
+          (save-excursion ;; org-exp-blocks places us at the end of the block
+            (re-search-backward org-babel-src-block-regexp nil t)
+            (org-babel-execute-src-block
+             nil nil (org-babel-merge-params params '((:results . "replace")))) "")))))
 
 (provide 'org-babel-exp)
 ;;; org-babel-exp.el ends here

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

@@ -62,6 +62,9 @@ names, and the emacs-lisp representation of the related value."
 	(other-params (assq-delete-all :var params)))
     (mapcar (lambda (assignment) (org-babel-ref-parse assignment other-params)) assignments)))
 
+(defvar org-babel-ref-split-regexp
+  "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
+
 (defun org-babel-ref-parse (assignment params)
   "Parse a variable ASSIGNMENT in a header argument.  If the
 right hand side of the assignment has a literal value return that
@@ -70,8 +73,7 @@ and find it's value using `org-babel-ref-resolve-reference'.
 Return a list with two elements.  The first element of the list
 will be the name of the variable, and the second will be an
 emacs-lisp representation of the value of the variable."
-  (if (string-match
-       "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*" assignment)
+  (if (string-match org-babel-ref-split-regexp assignment)
       (let ((var (match-string 1 assignment))
             (ref (match-string 2 assignment)))
         (cons (intern var)
@@ -93,7 +95,7 @@ return nil."
   "Resolve the reference and return its value"
   (save-excursion
     (let ((case-fold-search t)
-          type args new-refere new-referent result lob-info)
+          type args new-refere new-referent result lob-info split-file split-ref)
       ;; assign any arguments to pass to source block
       (when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref)
         (setq new-refere (match-string 1 ref))
@@ -105,9 +107,10 @@ return nil."
                                  (org-babel-ref-split-args new-referent))))
           ;; (message "args=%S" args) ;; debugging
           (setq ref new-refere)))
-      (when (string-match "\\(.+\\):\\(.+\\)" ref)
-        (find-file (match-string 1 ref))
-        (setf ref (match-string 2 ref)))
+      (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
+        (setq split-file (match-string 1 ref))
+        (setq split-ref (match-string 2 ref))
+        (find-file split-file) (setq ref split-ref))
       (goto-char (point-min))
       (if (let ((result_regexp (concat "^#\\+\\(TBL\\|RES\\)NAME:[ \t]*"
                                        (regexp-quote ref) "[ \t]*$"))

contrib/babel/lisp/org-babel.el

@@ -83,7 +83,7 @@ then run `org-babel-pop-to-session'."
   '((:session . "none") (:results . "replace") (:exports . "code"))
   "Default arguments to use when evaluating a source block.")
 
-(defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "code"))
+(defvar org-babel-default-inline-header-args '((:results . "silent") (:exports . "results"))
   "Default arguments to use when evaluating an inline source block.")
 
 (defvar org-babel-src-block-regexp nil
@@ -181,6 +181,7 @@ the header arguments specified at the source code block."
          (cmd (intern (concat "org-babel-execute:" lang)))
          result)
     ;; (message "params=%S" params) ;; debugging statement
+    ;; (message "vars=%S" (second processed-params)) ;; debugging statement
     (unless (member lang org-babel-interpreters)
       (error "Language is not in `org-babel-interpreters': %s" lang))
     (when arg (setq result-params (cons "silent" result-params)))

lisp/org-exp-blocks.el

@@ -133,8 +133,7 @@ blocks is as follows...
     (org-export-blocks-set 'org-export-blocks org-export-blocks)))
 
 (defcustom org-export-interblocks
-  '((r org-export-interblocks-format-R)
-    (R org-export-interblocks-format-R))
+  '()
   "Use this a-list to associate block types with block exporting
 functions.  The type of a block is determined by the text
 immediately following the '#+BEGIN_' portion of the block header.
@@ -183,10 +182,10 @@ specified in BLOCKS which default to the value of
 	  (case-fold-search t)
 	  (types '())
 	  indentation type func start end)
-      (flet ((interblock (start end type)
+      (flet ((interblock (start end)
 			 (save-match-data
-			   (when (setf func (cadr (assoc type org-export-interblocks)))
-			     (funcall func start end)))))
+                           (mapcar (lambda (pair) (funcall (second pair) start end))
+                                   org-export-interblocks))))
 	(goto-char (point-min))
 	(setf start (point))
 	(while (re-search-forward
@@ -195,7 +194,7 @@ specified in BLOCKS which default to the value of
 	  (save-match-data (setf type (intern (match-string 2))))
 	  (unless (memq type types) (setf types (cons type types)))
 	  (setf end (save-match-data (match-beginning 0)))
-	  (interblock start end type)
+	  (interblock start end)
 	  (if (setf func (cadr (assoc type org-export-blocks)))
 	      (progn
                 (replace-match (save-match-data
@@ -206,9 +205,7 @@ specified in BLOCKS which default to the value of
                 ;; indent block
                 (indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
 	  (setf start (save-match-data (match-end 0))))
-	(mapcar (lambda (type)
-		  (interblock start (point-max) type))
-		types)))))
+	(interblock start (point-max))))))
 
 (add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess)
 
@@ -321,119 +318,6 @@ other backends, it converts the comment into an EXAMPLE segment."
 	      (if (string-match "\n\\'" body) "" "\n")
 	      "#+END_EXAMPLE\n")))))
 
-;;--------------------------------------------------------------------------------
-;; R: Sweave-type functionality
-(defvar interblock-R-buffer nil
-  "Holds the buffer for the current R process")
-
-(defvar count) ; dynamicaly scoped from `org-export-blocks-preprocess'?
-(defun org-export-blocks-format-R (body &rest headers)
-  "Process R blocks and replace \R{} forms outside the blocks
-with their values as determined by R."
-  (interactive)
-  (message "R processing...")
-  (let ((image-path (or (and (car headers)
-			     (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers))
-			     (match-string 1 (car headers)))
-			(and (> (length (car headers)) 0)
-			     (car headers))
-			;; create the default filename
-			(format "Rplot-%03d" count)))
-	(plot (string-match "plot" body))
-	R-proc)
-    (setf count (+ count 1))
-    (interblock-initiate-R-buffer)
-    (setf R-proc (get-buffer-process interblock-R-buffer))
-    ;; send strings to the ESS process using `comint-send-string'
-    (setf body (mapconcat (lambda (line)
-			    (interblock-R-input-command line) (concat "> " line))
-			  (butlast (split-string body "[\r\n]"))
-			  "\n"))
-    ;; if there is a plot command, then create the images
-    (when plot
-      (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path)))
-    (concat (cond
-	     (htmlp (org-export-blocks-html-quote body
-						  (format "<div id=\"R-%d\">\n<pre>\n" count)
-						  "</pre>\n</div>\n"))
-	     (latexp (org-export-blocks-latex-quote body
-						    "\\begin{Schunk}\n\\begin{Sinput}\n"
-						    "\\end{Sinput}\n\\end{Schunk}\n"))
-	     (t (insert ;; default export
-		 "#+begin_R " (mapconcat 'identity headers " ") "\n"
-		 body (if (string-match "\n$" body) "" "\n")
-		 "#+end_R\n")))
-	    (if plot
-		(format "[[file:%s.eps]]\n" image-path)
-	      ""))))
-
-(defun org-export-interblocks-format-R (start end)
-  "This is run over parts of the org-file which are between R
-blocks.  Its main use is to expand the \R{stuff} chunks for
-export."
-  (save-excursion
-    (goto-char start)
-    (interblock-initiate-R-buffer)
-    (let (code replacement)
-      (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t))
-	(save-match-data (setf code (match-string 1)))
-	(setf replacement (interblock-R-command-to-string code))
-	(setf replacement (cond
-			   (htmlp replacement)
-			   (latexp replacement)
-			   (t replacement)))
-	(setf end (+ end (- (length replacement) (length code))))
-	(replace-match replacement t t)))))
-
-(defun interblock-initiate-R-buffer ()
-  "If there is not a current R process then create one."
-  (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer))
-    (save-excursion
-      (R)
-      (setf interblock-R-buffer (current-buffer))
-      (interblock-R-wait-for-output)
-      (interblock-R-input-command ""))))
-
-(defun interblock-R-command-to-string (command)
-  "Send a command to R, and return the results as a string."
-  (interblock-R-input-command command)
-  (interblock-R-last-output))
-
-(defun interblock-R-input-command (command)
-  "Pass COMMAND to the R process running in `interblock-R-buffer'."
-  (save-excursion
-    (save-match-data
-      (set-buffer interblock-R-buffer)
-      (goto-char (process-mark (get-buffer-process (current-buffer))))
-      (insert command)
-      (comint-send-input)
-      (interblock-R-wait-for-output))))
-
-(defun interblock-R-wait-for-output ()
-  "Wait until output arrives"
-  (save-excursion
-    (save-match-data
-      (set-buffer interblock-R-buffer)
-      (while (progn
-	       (goto-char comint-last-input-end)
-	       (not (re-search-forward comint-prompt-regexp nil t)))
-	(accept-process-output (get-buffer-process (current-buffer)))))))
-
-(defun interblock-R-last-output ()
-  "Return the last R output as a string"
-  (save-excursion
-    (save-match-data
-      (set-buffer interblock-R-buffer)
-      (goto-char (process-mark (get-buffer-process (current-buffer))))
-      (forward-line 0)
-      (let ((raw (buffer-substring comint-last-input-end (- (point) 1))))
-	(if (string-match "\n" raw)
-	    raw
-	  (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw)
-	       (message raw)
-	       (message (match-string 1 raw))
-	       (match-string 1 raw)))))))
-
 (provide 'org-exp-blocks)
 
 ;; arch-tag: 1c365fe9-8808-4f72-bb15-0b00f36d8024