tramp-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH 1/1] tramp-handle-process-file optimizations


From: Julian Scheid
Subject: [PATCH 1/1] tramp-handle-process-file optimizations
Date: Sun, 16 Aug 2009 22:24:16 +1200

---
 lisp/ChangeLog      |    8 ++++++++
 lisp/tramp-cache.el |   36 ++++++++++++++++++++++++++++++++++++
 lisp/tramp.el       |   28 ++++++++++++++++++++--------
 3 files changed, 64 insertions(+), 8 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1f0ad8d..196b46a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2009-08-16  Julian Scheid  <address@hidden>
+
+       * tramp-cache.el (tramp-get-modified-by-process): New defun.
+       (tramp-process-modification-list): New defvar.
+
+       * tramp.el (tramp-handle-process-file): Use them.  Also, merge
+       three remote ops into one.
+
 2009-08-15  Michael Albinus  <address@hidden>
 
        * tramp.el (tramp-handle-vc-registered): Embed the code in
diff --git a/lisp/tramp-cache.el b/lisp/tramp-cache.el
index 9437816..3aba7a7 100644
--- a/lisp/tramp-cache.el
+++ b/lisp/tramp-cache.el
@@ -352,6 +352,42 @@ for all methods.  Resulting data are derived from 
connection history."
              tramp-persistency-file-name (error-message-string err))
      (clrhash tramp-cache-data))))
 
+;; Optimizations
+
+(defvar tramp-process-modification-list
+  '((("git" "ls-tree") nil)
+    (("git" "ls-files") nil))
+  "List of known process invocations and the files and
+directories they modify.  Each entry is a list with two items:
+the first item a list of strings to match against the command
+line, the second item a cons cell with a list of directory names
+in the car and a list of files in the cdr.")
+
+(defun tramp-get-modified-by-process (program infile args)
+  "Return which files or directories are written by a process.
+Return a cons cell with a list of directory names in the car and
+a list of files in the cdr.  This implementation looks up
+`tramp-process-modification-list'."
+  (let (result
+        (command-line (append (list program) args)))
+    (dolist (item tramp-process-modification-list result)
+      (when (and (null result)
+                 (let ((item-iter (car item))
+                       (cline-iter command-line)
+                       (match t))
+                   (while (and match item-iter)
+                     (if (equal (car item-iter)
+                                (car cline-iter))
+                         (progn
+                           (setq item-iter (cdr item-iter))
+                           (setq cline-iter (cdr cline-iter)))
+                       (setq match nil)))
+                   match))
+        (setq result item)))
+    (if result
+        (nth 1 result)
+      '(("")))))
+
 (provide 'tramp-cache)
 
 ;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
diff --git a/lisp/tramp.el b/lisp/tramp.el
index 45cdcae..1a822d5 100644
--- a/lisp/tramp.el
+++ b/lisp/tramp.el
@@ -4143,18 +4143,26 @@ beginning of local filename are not substituted."
        (setq outbuf (current-buffer))))
       (when stderr (setq command (format "%s 2>%s" command stderr)))
 
-      ;; Goto working directory.
-      (tramp-send-command
-       v (format "cd %s" (tramp-shell-quote-argument localname)))
       ;; Send the command.  It might not return in time, so we protect it.
       (condition-case nil
          (unwind-protect
-             (tramp-send-command v command)
+             (tramp-send-command
+               v (format
+                  "\\cd %s; %s; \\echo tramp_exit_status $?"
+                  (tramp-shell-quote-argument localname) command))
            ;; We should show the output anyway.
            (when outbuf
              (let ((output-string
                     (with-current-buffer (tramp-get-connection-buffer v)
-                      (buffer-substring (point-min) (point-max)))))
+                       (if (re-search-backward
+                            "tramp_exit_status \\([0-9]+\\)" nil t)
+                           (progn
+                             (setq ret (string-to-int (match-string 1)))
+                             (buffer-substring (point-min) (match-beginning 
0)))
+                         (tramp-error
+                          v 'file-error
+                          "tramp-handle-process-file: internal error: `%s'"
+                          (buffer-string))))))
                (with-current-buffer outbuf
                  (insert output-string)))
              (when display (display-buffer outbuf))))
@@ -4168,14 +4176,18 @@ beginning of local filename are not substituted."
         (kill-buffer (tramp-get-connection-buffer v))
         (setq ret 1)))
 
-      ;; Check return code.
-      (unless ret (setq ret (tramp-send-command-and-check v nil)))
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
       ;; Cleanup.  We remove all file cache values for the connection,
       ;; because the remote process could have changed them.
       (when tmpinput (delete-file tmpinput))
-      (tramp-flush-directory-property v "")
+
+      (let ((flush-list (tramp-get-modified-by-process program infile args)))
+        (dolist (directory (car flush-list))
+          (tramp-flush-directory-property v directory))
+        (dolist (file (cdr flush-list))
+          (tramp-flush-file-property v file)))
+
       ;; Return exit status.
       (if (equal ret -1)
          (keyboard-quit)
-- 
1.6.4





reply via email to

[Prev in Thread] Current Thread [Next in Thread]