From 2056d7d419aabfc9a5fd59674f66e58862f14e32 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Sun, 21 Feb 2010 00:34:23 -0500 Subject: [PATCH] babel: Allow shell-command-on-region to execute remotely These changes solve two problems: both are discussed in the following thread http://lists.gnu.org/archive/html/tramp-devel/2010-02/msg00025.html of which a summary follows. Firstly, shell-command-on-region does not work with tramp in the same way that shell-command does. I.e. whereas (let ((default-directory "/user@remote-host:")) (shell-command "hostname" t)) gives the remote hostname, (let ((default-directory "/user@remote-host:")) (shell-command-on-region (point) (mark) "hostname" t)) does not. The reason is that shell-command-on-region calls call-process-region, which does not use a tramp handler for remote files. However, such a file handler does exist (unused) in the tramp sources: tramp-handle-call-process-region. There is a slight problem in that there is a bug in that function definition in current tramp (which has persisted because the function is not normally used). Therefore, we define an org-babel version of tramp-handle-call-process-region which fixes the bug, and we bind call-process-region to org-babel-tramp-handle-call-process-region for the duration of org-babel-execute-src-block. --- contrib/babel/lisp/org-babel.el | 52 ++++++++++++++++++++++----------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/contrib/babel/lisp/org-babel.el b/contrib/babel/lisp/org-babel.el index cb96aad96..9dbed233a 100644 --- a/contrib/babel/lisp/org-babel.el +++ b/contrib/babel/lisp/org-babel.el @@ -217,25 +217,28 @@ block." (dir (cdr (assoc :dir params))) (default-directory (or (and dir (if (string-match "/$" dir) dir (concat dir "/"))) default-directory)) + (call-process-region-original (symbol-function 'call-process-region)) result) ;; (message "params=%S" params) ;; debugging - (unless (member lang org-babel-interpreters) - (error "Language is not in `org-babel-interpreters': %s" lang)) - (if (and (not arg) new-hash (equal new-hash old-hash)) - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (move-end-of-line 1) (forward-char 1) - (setq result (org-babel-read-result)) - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) - (setq result (funcall cmd body params)) - (if (eq result-type 'value) - (setq result (if (and (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) - result))) - (org-babel-insert-result result result-params info new-hash) - result))) + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (member lang org-babel-interpreters) + (error "Language is not in `org-babel-interpreters': %s" lang)) + (if (and (not arg) new-hash (equal new-hash old-hash)) + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (move-end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) + (setq result (funcall cmd body params)) + (if (eq result-type 'value) + (setq result (if (and (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) + result))) + (org-babel-insert-result result result-params info new-hash) + result)))) (defun org-babel-load-in-session (&optional arg info) "Load the body of the current source-code block. Evaluate the @@ -1084,5 +1087,20 @@ overwritten by specifying a regexp as a second argument." (org-babel-chomp (org-babel-reverse-string (org-babel-chomp (org-babel-reverse-string string) regexp)) regexp)) +(defun org-babel-tramp-handle-call-process-region + (start end program &optional delete buffer display &rest args) + "Use tramp to handle call-process-region. +Fixes a bug in `tramp-handle-call-process-region'." + (if (and (featurep 'tramp) (file-remote-p default-directory)) + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + ;; (apply 'call-process program tmpfile buffer display args) ;; bug in tramp + (apply 'process-file program tmpfile buffer display args) + (delete-file tmpfile))) + ;; call-process-region-original is the original emacs definition. It + ;; is in scope from the let binding in org-babel-execute-src-block + (apply call-process-region-original start end program delete buffer display args))) (provide 'org-babel) ;;; org-babel.el ends here