]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp-compat.el
* lisp/net/eww.el (eww-add-bookmark): Fix prompt
[gnu-emacs] / lisp / net / tramp-compat.el
index 8f9d9d8fee588a414790ec94ff816d9b364dfcc4..3ec90ca556f1616ede0373072441029782706a2a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; tramp-compat.el --- Tramp compatibility functions
 
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes
 
 (eval-and-compile
 
+  ;; GNU Emacs 22.
+  (unless (fboundp 'ignore-errors)
+    (load "cl" 'noerror)
+    (load "cl-macs" 'noerror))
+
   ;; Some packages must be required for XEmacs, because we compile
   ;; with -no-autoloads.
   (when (featurep 'xemacs)
@@ -44,7 +49,8 @@
     (require 'outline)
     (require 'passwd)
     (require 'pp)
-    (require 'regexp-opt))
+    (require 'regexp-opt)
+    (require 'time-date))
 
   (require 'advice)
   (require 'custom)
@@ -313,13 +319,21 @@ Not actually used.  Use `(format \"%o\" i)' instead?"
   "Like `copy-file' for Tramp files (compat function)."
   (cond
    (preserve-extended-attributes
-    (tramp-compat-funcall
-     'copy-file filename newname ok-if-already-exists keep-date
-     preserve-uid-gid preserve-extended-attributes))
+    (condition-case nil
+       (tramp-compat-funcall
+        'copy-file filename newname ok-if-already-exists keep-date
+        preserve-uid-gid preserve-extended-attributes)
+      (wrong-number-of-arguments
+       (tramp-compat-copy-file
+       filename newname ok-if-already-exists keep-date preserve-uid-gid))))
    (preserve-uid-gid
-    (tramp-compat-funcall
-     'copy-file filename newname ok-if-already-exists keep-date
-     preserve-uid-gid))
+    (condition-case nil
+       (tramp-compat-funcall
+        'copy-file filename newname ok-if-already-exists keep-date
+        preserve-uid-gid)
+      (wrong-number-of-arguments
+       (tramp-compat-copy-file
+       filename newname ok-if-already-exists keep-date))))
    (t
     (copy-file filename newname ok-if-already-exists keep-date))))
 
@@ -408,6 +422,13 @@ Not actually used.  Use `(format \"%o\" i)' instead?"
                directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
      (delete-directory directory))))
 
+;; MUST-SUFFIX doesn't exist on XEmacs.
+(defun tramp-compat-load (file &optional noerror nomessage nosuffix must-suffix)
+  "Like `load' for Tramp files (compat function)."
+  (if must-suffix
+      (tramp-compat-funcall 'load file noerror nomessage nosuffix must-suffix)
+    (load file noerror nomessage nosuffix)))
+
 ;; `number-sequence' does not exist in XEmacs.  Implementation is
 ;; taken from Emacs 23.
 (defun tramp-compat-number-sequence (from &optional to inc)
@@ -463,7 +484,7 @@ element is not omitted."
 
      ;; Fallback, if there is no Lisp support yet.
      (t (let ((default-directory
-               (if (file-remote-p default-directory)
+               (if (tramp-tramp-file-p default-directory)
                    (tramp-compat-temporary-file-directory)
                  default-directory))
              (unix95 (getenv "UNIX95"))
@@ -518,8 +539,65 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
                        "`dos', `unix', or `mac'")))))
         (t (error "Can't change EOL conversion -- is MULE missing?"))))
 
+;; `replace-regexp-in-string' does not exist in XEmacs.
+;; Implementation is taken from Emacs 24.
+(if (fboundp 'replace-regexp-in-string)
+    (defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string)
+  (defun tramp-compat-replace-regexp-in-string
+    (regexp rep string &optional fixedcase literal subexp start)
+    "Replace all matches for REGEXP with REP in STRING.
+
+Return a new string containing the replacements.
+
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'.  If START
+is non-nil, start replacements at that index in STRING.
+
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function.  If it is a function, it is called with the actual text of each
+match, and its value is used as the replacement text.  When REP is called,
+the match data are the result of matching REGEXP against a substring
+of STRING.
+
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+  (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
+    => \" bar foo\""
+
+    (let ((l (length string))
+         (start (or start 0))
+         matches str mb me)
+      (save-match-data
+       (while (and (< start l) (string-match regexp string start))
+         (setq mb (match-beginning 0)
+               me (match-end 0))
+         ;; If we matched the empty string, make sure we advance by one char
+         (when (= me mb) (setq me (min l (1+ mb))))
+         ;; Generate a replacement for the matched substring.
+         ;; Operate only on the substring to minimize string consing.
+         ;; Set up match data for the substring for replacement;
+         ;; presumably this is likely to be faster than munging the
+         ;; match data directly in Lisp.
+         (string-match regexp (setq str (substring string mb me)))
+         (setq matches
+               (cons (replace-match (if (stringp rep)
+                                        rep
+                                      (funcall rep (match-string 0 str)))
+                                    fixedcase literal str subexp)
+                     (cons (substring string start mb) ; unmatched prefix
+                           matches)))
+         (setq start me))
+       ;; Reconstruct a string from the pieces.
+       (setq matches (cons (substring string start l) matches)) ; leftover
+       (apply #'concat (nreverse matches))))))
+
+;; `default-toplevel-value' has been declared in Emacs 24.
+(unless (fboundp 'default-toplevel-value)
+  (defalias 'default-toplevel-value 'symbol-value))
+
 (add-hook 'tramp-unload-hook
          (lambda ()
+           (unload-feature 'tramp-loaddefs 'force)
            (unload-feature 'tramp-compat 'force)))
 
 (provide 'tramp-compat)