ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Dan Davison 2010-02-21 00:34:23 -05:00
parent b3d5a1eb39
commit 2056d7d419
1 changed files with 35 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
contrib/babel/lisp/org-babel.el
View File

@ -217,8 +217,11 @@ 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
(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))
@ -235,7 +238,7 @@ block."
(list (list result))
result)))
(org-babel-insert-result result result-params info new-hash)
result)))
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