[Emacs-diffs] /srv/bzr/emacs/trunk r101444: * net/tramp-compat.el (tramp-compat-with-temp-message)

[Michael Albinus]

------------------------------------------------------------
revno: 101444
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Wed 2010-09-15 22:27:11 +0200
message:
  * net/tramp-compat.el (tramp-compat-with-temp-message)
  (tramp-compat-font-lock-add-keywords, tramp-compat-process-get)
  (tramp-compat-process-put): New defuns.
  
  * net/tramp.el (top):
  * net/tramp-gvfs.el (top):
  * net/tramp-cache.el (top): Use `tramp-compat-font-lock-add-keywords'.
  
  * net/tramp.el (tramp-progress-reporter-update): Use
  `tramp-compat-funcall.
  
  * net/tramp.el (tramp-process-actions):
  * net/tramp-gvfs.el (tramp-handle-vc-registered):
  * net/tramp-sh.el (tramp-gvfs-handler-askquestion)
  (tramp-get-remote-stat, tramp-get-remote-readlink): Use
  `tramp-compat-with-temp-message'.
  
  * net/tramp-sh.el (top): Require 'cl.
  (tramp-handle-start-file-process): Use `tramp-compat-process-get'.
  (tramp-open-connection-setup-interactive-shell): Use
  `tramp-compat-process-put'.
modified:
  lisp/ChangeLog
  lisp/net/tramp-cache.el
  lisp/net/tramp-compat.el
  lisp/net/tramp-gvfs.el
  lisp/net/tramp-sh.el
  lisp/net/tramp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-09-15 18:03:25 +0000
+++ b/lisp/ChangeLog    2010-09-15 20:27:11 +0000
@@ -1,3 +1,27 @@
+2010-09-15  Michael Albinus  <address@hidden>
+
+       * net/tramp-compat.el (tramp-compat-with-temp-message)
+       (tramp-compat-font-lock-add-keywords, tramp-compat-process-get)
+       (tramp-compat-process-put): New defuns.
+
+       * net/tramp.el (top):
+       * net/tramp-gvfs.el (top):
+       * net/tramp-cache.el (top): Use `tramp-compat-font-lock-add-keywords'.
+
+       * net/tramp.el (tramp-progress-reporter-update): Use
+       `tramp-compat-funcall.
+
+       * net/tramp.el (tramp-process-actions):
+       * net/tramp-gvfs.el (tramp-handle-vc-registered):
+       * net/tramp-sh.el (tramp-gvfs-handler-askquestion)
+       (tramp-get-remote-stat, tramp-get-remote-readlink): Use
+       `tramp-compat-with-temp-message'.
+
+       * net/tramp-sh.el (top): Require 'cl.
+       (tramp-handle-start-file-process): Use `tramp-compat-process-get'.
+       (tramp-open-connection-setup-interactive-shell): Use
+       `tramp-compat-process-put'.
+
 2010-09-15  Alan Mackenzie  <address@hidden>
 
        * progmodes/cc-engine.el (c-forward-<>-arglist-recur): Correct the
@@ -238,7 +262,7 @@
 
        * net/tramp-sh.el: New file, derived from tramp.el.
        (top): Initialize `tramp-methods', `tramp-default-method-alist',
-       `tramp-default-user-alist', tramp-foreign-file-name-handler-alist.
+       `tramp-default-user-alist', `tramp-foreign-file-name-handler-alist'.
        Remove "scp1_old", "scp2_old", "ssh1_old", "ssh2_old".  Use
        `ignore-errors' where appropriate.
        (tramp-sh-file-name-handler-alist): Renamed from

=== modified file 'lisp/net/tramp-cache.el'
--- a/lisp/net/tramp-cache.el   2010-09-13 15:17:01 +0000
+++ b/lisp/net/tramp-cache.el   2010-09-15 20:27:11 +0000
@@ -152,8 +152,8 @@
 ;;;###tramp-autoload
 (put 'with-file-property 'lisp-indent-function 3)
 (put 'with-file-property 'edebug-form-spec t)
-;;;###tramp-autoload
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-file-property\\>"))
 
 ;;;###tramp-autoload
 (defun tramp-flush-file-property (vec file)
@@ -255,8 +255,8 @@
 ;;;###tramp-autoload
 (put 'with-connection-property 'lisp-indent-function 2)
 (put 'with-connection-property 'edebug-form-spec t)
-;;;###tramp-autoload
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-connection-property\\>"))
 
 ;;;###tramp-autoload
 (defun tramp-flush-connection-property (key)

=== modified file 'lisp/net/tramp-compat.el'
--- a/lisp/net/tramp-compat.el  2010-09-13 15:17:01 +0000
+++ b/lisp/net/tramp-compat.el  2010-09-15 20:27:11 +0000
@@ -96,11 +96,6 @@
     (defvar byte-compile-not-obsolete-vars nil))
   (setq byte-compile-not-obsolete-vars '(directory-sep-char))
 
-  ;; `with-temp-message' does not exists in XEmacs.
-  (condition-case nil
-      (with-temp-message (current-message) nil)
-    (error (defmacro with-temp-message (message &rest body) `(progn ,@body))))
-
   ;; For not existing functions, or functions with a changed argument
   ;; list, there are compiler warnings.  We want to avoid them in
   ;; cases we know what we do.
@@ -114,10 +109,6 @@
   (unless (fboundp 'set-buffer-multibyte)
     (defalias 'set-buffer-multibyte 'ignore))
 
-  ;; `font-lock-add-keywords' does not exist in XEmacs.
-  (unless (fboundp 'font-lock-add-keywords)
-    (defalias 'font-lock-add-keywords 'ignore))
-
   ;; The following functions cannot be aliases of the corresponding
   ;; `tramp-handle-*' functions, because this would bypass the locking
   ;; mechanism.
@@ -190,6 +181,19 @@
        'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
        (ad-activate 'file-expand-wildcards)))))
 
+;; `with-temp-message' does not exists in XEmacs.
+(if (fboundp 'with-temp-message)
+    (defalias 'tramp-compat-with-temp-message 'with-temp-message)
+  (defun tramp-compat-with-temp-message (message &rest body)
+    "Display MESSAGE temporarily if non-nil while BODY is evaluated."
+    `(progn ,@body)))
+
+;; `font-lock-add-keywords' does not exist in XEmacs.
+(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
+  "Add highlighting KEYWORDS for MODE."
+  (ignore-errors
+    (tramp-compat-funcall 'font-lock-add-keywords mode keywords how)))
+
 (defsubst tramp-compat-line-beginning-position ()
   "Return point at beginning of line (compat function).
 Calls `line-beginning-position' or `point-at-bol' if defined, else
@@ -474,6 +478,18 @@
          (setenv "UNIX95" unix95)
          result)))))
 
+;; The following functions do not exist in XEmacs.  We ignore this;
+;; they are used for checking a remote tty.
+(defun tramp-compat-process-get (process propname)
+  "Return the value of PROCESS' PROPNAME property.
+This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
+  (ignore-errors (tramp-compat-funcall 'process-get process propname)))
+
+(defun tramp-compat-process-put (process propname value)
+  "Change PROCESS' PROPNAME property to VALUE.
+It can be retrieved with `(process-get PROCESS PROPNAME)'."
+  (ignore-errors (tramp-compat-funcall 'process-put process propname value)))
+
 (add-hook 'tramp-unload-hook
          (lambda ()
            (unload-feature 'tramp-compat 'force)))

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2010-09-13 15:17:01 +0000
+++ b/lisp/net/tramp-gvfs.el    2010-09-15 20:27:11 +0000
@@ -498,7 +498,8 @@
 
 (put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
 (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode 
'("\\<with-tramp-dbus-call-method\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
 
 (defmacro with-tramp-gvfs-error-message (filename handler &rest args)
   "Apply a Tramp GVFS `handler'.
@@ -519,7 +520,8 @@
 
 (put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
 (put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode 
'("\\<with-tramp-gvfs-error-message\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
 
 (defvar tramp-gvfs-dbus-event-vector nil
   "Current Tramp file name to be used, as vector.
@@ -973,7 +975,7 @@
            ;; host signature.
            (with-temp-buffer
              ;; Preserve message for `progress-reporter'.
-             (with-temp-message ""
+             (tramp-compat-with-temp-message ""
                (insert message)
                (pop-to-buffer (current-buffer))
                (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2010-09-13 15:17:01 +0000
+++ b/lisp/net/tramp-sh.el      2010-09-15 20:27:11 +0000
@@ -27,6 +27,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))      ; ignore-errors
 (require 'tramp)
 (require 'shell)
 
@@ -2855,7 +2856,8 @@
              (tramp-send-command v command nil t) ; nooutput
            ;; Check, whether a pty is associated.
            (tramp-maybe-open-connection v)
-           (unless (process-get (tramp-get-connection-process v) 'remote-tty)
+           (unless (tramp-compat-process-get
+                    (tramp-get-connection-process v) 'remote-tty)
              (tramp-error
               v 'file-error "pty association is not supported for `%s'" name)))
          (let ((p (tramp-get-connection-process v)))
@@ -3659,7 +3661,7 @@
 ;; any other remote command.
 (defun tramp-handle-vc-registered (file)
   "Like `vc-registered' for Tramp files."
-  (with-temp-message ""
+  (tramp-compat-with-temp-message ""
     (with-parsed-tramp-file-name file nil
       (with-progress-reporter
          v 3 (format "Checking `vc-registered' for %s" file)
@@ -4139,7 +4141,8 @@
   ;; Set `remote-tty' process property.
   (ignore-errors
     (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
-      (unless (zerop (length tty)) (process-put proc 'remote-tty tty))))
+      (unless (zerop (length tty))
+       (tramp-compat-process-put proc 'remote-tty tty))))
 
   ;; Set the environment.
   (tramp-message vec 5 "Setting default environment")
@@ -5268,7 +5271,7 @@
       (when result
        (setq tmp
              ;; We don't want to display an error message.
-             (with-temp-message (or (current-message) "")
+             (tramp-compat-with-temp-message (or (current-message) "")
                (ignore-errors
                  (tramp-send-command-and-read
                   vec (format "%s -c '(\"%%N\" %%s)' /" result)))))
@@ -5285,7 +5288,7 @@
                   vec "readlink" (tramp-get-remote-path vec))))
       (when (and result
                 ;; We don't want to display an error message.
-                (with-temp-message (or (current-message) "")
+                (tramp-compat-with-temp-message (or (current-message) "")
                   (ignore-errors
                     (tramp-send-command-and-check
                      vec (format "%s --canonicalize-missing /" result)))))

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2010-09-13 15:17:01 +0000
+++ b/lisp/net/tramp.el 2010-09-15 20:27:11 +0000
@@ -1413,13 +1413,14 @@
 
 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
 (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode 
'("\\<with-parsed-tramp-file-name\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
 
 (defun tramp-progress-reporter-update (reporter &optional value)
   (let* ((parameters (cdr reporter))
         (message (aref parameters 3)))
     (when (string-match message (or (current-message) ""))
-      (funcall 'progress-reporter-update reporter value))))
+      (tramp-compat-funcall 'progress-reporter-update reporter value))))
 
 (defmacro with-progress-reporter (vec level message &rest body)
   "Executes BODY, spinning a progress reporter with MESSAGE.
@@ -1450,7 +1451,8 @@
 
 (put 'with-progress-reporter 'lisp-indent-function 3)
 (put 'with-progress-reporter 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
 
 (eval-and-compile                      ;; Silence compiler.
   (if (memq system-type '(cygwin windows-nt))
@@ -2688,7 +2690,7 @@
 (defun tramp-process-actions (proc vec actions &optional timeout)
   "Perform actions until success or TIMEOUT."
   ;; Preserve message for `progress-reporter'.
-  (with-temp-message ""
+  (tramp-compat-with-temp-message ""
     ;; Enable auth-source and password-cache.
     (tramp-set-connection-property vec "first-password-request" t)
     (let (exit)