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

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

@ -217,25 +217,28 @@ block."
(dir (cdr (assoc :dir params))) (dir (cdr (assoc :dir params)))
(default-directory (default-directory
(or (and dir (if (string-match "/$" dir) dir (concat dir "/"))) default-directory)) (or (and dir (if (string-match "/$" dir) dir (concat dir "/"))) default-directory))
(call-process-region-original (symbol-function 'call-process-region))
result) result)
;; (message "params=%S" params) ;; debugging ;; (message "params=%S" params) ;; debugging
(unless (member lang org-babel-interpreters) (flet ((call-process-region (&rest args)
(error "Language is not in `org-babel-interpreters': %s" lang)) (apply 'org-babel-tramp-handle-call-process-region args)))
(if (and (not arg) new-hash (equal new-hash old-hash)) (unless (member lang org-babel-interpreters)
(save-excursion ;; return cached result (error "Language is not in `org-babel-interpreters': %s" lang))
(goto-char (org-babel-where-is-src-block-result nil info)) (if (and (not arg) new-hash (equal new-hash old-hash))
(move-end-of-line 1) (forward-char 1) (save-excursion ;; return cached result
(setq result (org-babel-read-result)) (goto-char (org-babel-where-is-src-block-result nil info))
(message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) (move-end-of-line 1) (forward-char 1)
(setq result (funcall cmd body params)) (setq result (org-babel-read-result))
(if (eq result-type 'value) (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result)
(setq result (if (and (or (member "vector" result-params) (setq result (funcall cmd body params))
(member "table" result-params)) (if (eq result-type 'value)
(not (listp result))) (setq result (if (and (or (member "vector" result-params)
(list (list result)) (member "table" result-params))
result))) (not (listp result)))
(org-babel-insert-result result result-params info new-hash) (list (list result))
result))) result)))
(org-babel-insert-result result result-params info new-hash)
result))))
(defun org-babel-load-in-session (&optional arg info) (defun org-babel-load-in-session (&optional arg info)
"Load the body of the current source-code block. Evaluate the "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
(org-babel-chomp (org-babel-reverse-string string) regexp)) regexp)) (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) (provide 'org-babel)
;;; org-babel.el ends here ;;; org-babel.el ends here