| 1 | ;;; tramp-compat.el --- Tramp compatibility functions |
| 2 | |
| 3 | ;; Copyright (C) 2007-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 6 | ;; Keywords: comm, processes |
| 7 | ;; Package: tramp |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; Tramp's main Emacs version for development is Emacs 24. This |
| 27 | ;; package provides compatibility functions for Emacs 22, Emacs 23, |
| 28 | ;; XEmacs 21.4+ and SXEmacs 22. |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | (eval-when-compile |
| 33 | |
| 34 | ;; Pacify byte-compiler. |
| 35 | (require 'cl)) |
| 36 | |
| 37 | (eval-and-compile |
| 38 | |
| 39 | ;; Some packages must be required for XEmacs, because we compile |
| 40 | ;; with -no-autoloads. |
| 41 | (when (featurep 'xemacs) |
| 42 | (require 'cus-edit) |
| 43 | (require 'env) |
| 44 | (require 'executable) |
| 45 | (require 'outline) |
| 46 | (require 'passwd) |
| 47 | (require 'pp) |
| 48 | (require 'regexp-opt)) |
| 49 | |
| 50 | (require 'advice) |
| 51 | (require 'custom) |
| 52 | (require 'format-spec) |
| 53 | (require 'shell) |
| 54 | |
| 55 | (require 'trampver) |
| 56 | (require 'tramp-loaddefs) |
| 57 | |
| 58 | ;; As long as password.el is not part of (X)Emacs, it shouldn't be |
| 59 | ;; mandatory. |
| 60 | (if (featurep 'xemacs) |
| 61 | (load "password" 'noerror) |
| 62 | (or (require 'password-cache nil 'noerror) |
| 63 | (require 'password nil 'noerror))) ; Part of contrib. |
| 64 | |
| 65 | ;; auth-source is relatively new. |
| 66 | (if (featurep 'xemacs) |
| 67 | (load "auth-source" 'noerror) |
| 68 | (require 'auth-source nil 'noerror)) |
| 69 | |
| 70 | ;; Load the appropriate timer package. |
| 71 | (if (featurep 'xemacs) |
| 72 | (require 'timer-funcs) |
| 73 | (require 'timer)) |
| 74 | |
| 75 | ;; Avoid byte-compiler warnings if the byte-compiler supports this. |
| 76 | ;; Currently, XEmacs supports this. |
| 77 | (when (featurep 'xemacs) |
| 78 | (unless (boundp 'byte-compile-default-warnings) |
| 79 | (defvar byte-compile-default-warnings nil)) |
| 80 | (delq 'unused-vars byte-compile-default-warnings)) |
| 81 | |
| 82 | ;; `last-coding-system-used' is unknown in XEmacs. |
| 83 | (unless (boundp 'last-coding-system-used) |
| 84 | (defvar last-coding-system-used nil)) |
| 85 | |
| 86 | ;; `directory-sep-char' is an obsolete variable in Emacs. But it is |
| 87 | ;; used in XEmacs, so we set it here and there. The following is |
| 88 | ;; needed to pacify Emacs byte-compiler. |
| 89 | ;; Note that it was removed altogether in Emacs 24.1. |
| 90 | (when (boundp 'directory-sep-char) |
| 91 | (defvar byte-compile-not-obsolete-var nil) |
| 92 | (setq byte-compile-not-obsolete-var 'directory-sep-char) |
| 93 | ;; Emacs 23.2. |
| 94 | (defvar byte-compile-not-obsolete-vars nil) |
| 95 | (setq byte-compile-not-obsolete-vars '(directory-sep-char))) |
| 96 | |
| 97 | ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1. |
| 98 | ;; Besides `t', `nil', and integer, we use also timestamps (as |
| 99 | ;; returned by `current-time') internally. |
| 100 | (unless (boundp 'remote-file-name-inhibit-cache) |
| 101 | (defvar remote-file-name-inhibit-cache nil)) |
| 102 | |
| 103 | ;; For not existing functions, or functions with a changed argument |
| 104 | ;; list, there are compiler warnings. We want to avoid them in |
| 105 | ;; cases we know what we do. |
| 106 | (defmacro tramp-compat-funcall (function &rest arguments) |
| 107 | (if (featurep 'xemacs) |
| 108 | `(funcall (symbol-function ,function) ,@arguments) |
| 109 | `(when (or (subrp ,function) (functionp ,function)) |
| 110 | (with-no-warnings (funcall ,function ,@arguments))))) |
| 111 | |
| 112 | ;; `set-buffer-multibyte' comes from Emacs Leim. |
| 113 | (unless (fboundp 'set-buffer-multibyte) |
| 114 | (defalias 'set-buffer-multibyte 'ignore)) |
| 115 | |
| 116 | ;; The following functions cannot be aliases of the corresponding |
| 117 | ;; `tramp-handle-*' functions, because this would bypass the locking |
| 118 | ;; mechanism. |
| 119 | |
| 120 | ;; `file-remote-p' has been introduced with Emacs 22. The version |
| 121 | ;; of XEmacs is not a magic file name function (yet). |
| 122 | (unless (fboundp 'file-remote-p) |
| 123 | (defalias 'file-remote-p |
| 124 | (lambda (file &optional identification connected) |
| 125 | (when (tramp-tramp-file-p file) |
| 126 | (tramp-compat-funcall |
| 127 | 'tramp-file-name-handler |
| 128 | 'file-remote-p file identification connected))))) |
| 129 | |
| 130 | ;; `process-file' does not exist in XEmacs. |
| 131 | (unless (fboundp 'process-file) |
| 132 | (defalias 'process-file |
| 133 | (lambda (program &optional infile buffer display &rest args) |
| 134 | (when (tramp-tramp-file-p default-directory) |
| 135 | (apply |
| 136 | 'tramp-file-name-handler |
| 137 | 'process-file program infile buffer display args))))) |
| 138 | |
| 139 | ;; `start-file-process' is new in Emacs 23. |
| 140 | (unless (fboundp 'start-file-process) |
| 141 | (defalias 'start-file-process |
| 142 | (lambda (name buffer program &rest program-args) |
| 143 | (when (tramp-tramp-file-p default-directory) |
| 144 | (apply |
| 145 | 'tramp-file-name-handler |
| 146 | 'start-file-process name buffer program program-args))))) |
| 147 | |
| 148 | ;; `set-file-times' is also new in Emacs 23. |
| 149 | (unless (fboundp 'set-file-times) |
| 150 | (defalias 'set-file-times |
| 151 | (lambda (filename &optional time) |
| 152 | (when (tramp-tramp-file-p filename) |
| 153 | (tramp-compat-funcall |
| 154 | 'tramp-file-name-handler 'set-file-times filename time))))) |
| 155 | |
| 156 | ;; We currently use "[" and "]" in the filename format for IPv6 |
| 157 | ;; hosts of GNU Emacs. This means that Emacs wants to expand |
| 158 | ;; wildcards if `find-file-wildcards' is non-nil, and then barfs |
| 159 | ;; because no expansion could be found. We detect this situation |
| 160 | ;; and do something really awful: we have `file-expand-wildcards' |
| 161 | ;; return the original filename if it can't expand anything. Let's |
| 162 | ;; just hope that this doesn't break anything else. |
| 163 | ;; It is not needed anymore since GNU Emacs 23.2. |
| 164 | (unless (or (featurep 'xemacs) |
| 165 | ;; `featurep' has only one argument in XEmacs. |
| 166 | (funcall 'featurep 'files 'remote-wildcards)) |
| 167 | (defadvice file-expand-wildcards |
| 168 | (around tramp-advice-file-expand-wildcards activate) |
| 169 | (let ((name (ad-get-arg 0))) |
| 170 | ;; If it's a Tramp file, look if wildcards need to be expanded |
| 171 | ;; at all. |
| 172 | (if (and |
| 173 | (tramp-tramp-file-p name) |
| 174 | (not (string-match |
| 175 | "[[*?]" (tramp-compat-funcall |
| 176 | 'file-remote-p name 'localname)))) |
| 177 | (setq ad-return-value (list name)) |
| 178 | ;; Otherwise, just run the original function. |
| 179 | ad-do-it))) |
| 180 | (add-hook |
| 181 | 'tramp-unload-hook |
| 182 | (lambda () |
| 183 | (ad-remove-advice |
| 184 | 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) |
| 185 | (ad-activate 'file-expand-wildcards))))) |
| 186 | |
| 187 | ;; `with-temp-message' does not exists in XEmacs. |
| 188 | (if (fboundp 'with-temp-message) |
| 189 | (defalias 'tramp-compat-with-temp-message 'with-temp-message) |
| 190 | (defmacro tramp-compat-with-temp-message (message &rest body) |
| 191 | "Display MESSAGE temporarily if non-nil while BODY is evaluated." |
| 192 | `(progn ,@body))) |
| 193 | |
| 194 | ;; `condition-case-unless-debug' is introduced with Emacs 24. |
| 195 | (if (fboundp 'condition-case-unless-debug) |
| 196 | (defalias 'tramp-compat-condition-case-unless-debug |
| 197 | 'condition-case-unless-debug) |
| 198 | (defmacro tramp-compat-condition-case-unless-debug |
| 199 | (var bodyform &rest handlers) |
| 200 | "Like `condition-case' except that it does not catch anything when debugging." |
| 201 | (declare (debug condition-case) (indent 2)) |
| 202 | (let ((bodysym (make-symbol "body"))) |
| 203 | `(let ((,bodysym (lambda () ,bodyform))) |
| 204 | (if debug-on-error |
| 205 | (funcall ,bodysym) |
| 206 | (condition-case ,var |
| 207 | (funcall ,bodysym) |
| 208 | ,@handlers)))))) |
| 209 | |
| 210 | ;; `font-lock-add-keywords' does not exist in XEmacs. |
| 211 | (defun tramp-compat-font-lock-add-keywords (mode keywords &optional how) |
| 212 | "Add highlighting KEYWORDS for MODE." |
| 213 | (ignore-errors |
| 214 | (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) |
| 215 | |
| 216 | (defsubst tramp-compat-temporary-file-directory () |
| 217 | "Return name of directory for temporary files (compat function). |
| 218 | For Emacs, this is the variable `temporary-file-directory', for XEmacs |
| 219 | this is the function `temp-directory'." |
| 220 | (let (file-name-handler-alist) |
| 221 | ;; We must return a local directory. If it is remote, we could |
| 222 | ;; run into an infloop. |
| 223 | (cond |
| 224 | ((and (boundp 'temporary-file-directory) |
| 225 | (eval (car (get 'temporary-file-directory 'standard-value))))) |
| 226 | ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) |
| 227 | ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) |
| 228 | (file-name-as-directory (getenv "TEMP"))) |
| 229 | ((let ((d (getenv "TMP"))) (and d (file-directory-p d))) |
| 230 | (file-name-as-directory (getenv "TMP"))) |
| 231 | ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d))) |
| 232 | (file-name-as-directory (getenv "TMPDIR"))) |
| 233 | ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp")) |
| 234 | (t (message (concat "Neither `temporary-file-directory' nor " |
| 235 | "`temp-directory' is defined -- using /tmp.")) |
| 236 | (file-name-as-directory "/tmp"))))) |
| 237 | |
| 238 | ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own |
| 239 | ;; implementation with `make-temp-name', creating the temporary file |
| 240 | ;; immediately in order to avoid a security hole. |
| 241 | (defsubst tramp-compat-make-temp-file (filename &optional dir-flag) |
| 242 | "Create a temporary file (compat function). |
| 243 | Add the extension of FILENAME, if existing." |
| 244 | (let* (file-name-handler-alist |
| 245 | (prefix (expand-file-name |
| 246 | (symbol-value 'tramp-temp-name-prefix) |
| 247 | (tramp-compat-temporary-file-directory))) |
| 248 | (extension (file-name-extension filename t)) |
| 249 | result) |
| 250 | (condition-case nil |
| 251 | (setq result |
| 252 | (tramp-compat-funcall 'make-temp-file prefix dir-flag extension)) |
| 253 | (error |
| 254 | ;; We use our own implementation, taken from files.el. |
| 255 | (while |
| 256 | (condition-case () |
| 257 | (progn |
| 258 | (setq result (concat (make-temp-name prefix) extension)) |
| 259 | (if dir-flag |
| 260 | (make-directory result) |
| 261 | (write-region "" nil result nil 'silent)) |
| 262 | nil) |
| 263 | (file-already-exists t)) |
| 264 | ;; The file was somehow created by someone else between |
| 265 | ;; `make-temp-name' and `write-region', let's try again. |
| 266 | nil))) |
| 267 | result)) |
| 268 | |
| 269 | ;; `most-positive-fixnum' does not exist in XEmacs. |
| 270 | (defsubst tramp-compat-most-positive-fixnum () |
| 271 | "Return largest positive integer value (compat function)." |
| 272 | (cond |
| 273 | ((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum)) |
| 274 | ;; Default value in XEmacs. |
| 275 | (t 134217727))) |
| 276 | |
| 277 | (defun tramp-compat-decimal-to-octal (i) |
| 278 | "Return a string consisting of the octal digits of I. |
| 279 | Not actually used. Use `(format \"%o\" i)' instead?" |
| 280 | (cond ((< i 0) (error "Cannot convert negative number to octal")) |
| 281 | ((not (integerp i)) (error "Cannot convert non-integer to octal")) |
| 282 | ((zerop i) "0") |
| 283 | (t (concat (tramp-compat-decimal-to-octal (/ i 8)) |
| 284 | (number-to-string (% i 8)))))) |
| 285 | |
| 286 | ;; Kudos to Gerd Moellmann for this suggestion. |
| 287 | (defun tramp-compat-octal-to-decimal (ostr) |
| 288 | "Given a string of octal digits, return a decimal number." |
| 289 | (let ((x (or ostr ""))) |
| 290 | ;; `save-match' is in `tramp-mode-string-to-int' which calls this. |
| 291 | (unless (string-match "\\`[0-7]*\\'" x) |
| 292 | (error "Non-octal junk in string `%s'" x)) |
| 293 | (string-to-number ostr 8))) |
| 294 | |
| 295 | ;; ID-FORMAT does not exists in XEmacs. |
| 296 | (defun tramp-compat-file-attributes (filename &optional id-format) |
| 297 | "Like `file-attributes' for Tramp files (compat function)." |
| 298 | (cond |
| 299 | ((or (null id-format) (eq id-format 'integer)) |
| 300 | (file-attributes filename)) |
| 301 | ((tramp-tramp-file-p filename) |
| 302 | (tramp-compat-funcall |
| 303 | 'tramp-file-name-handler 'file-attributes filename id-format)) |
| 304 | (t (condition-case nil |
| 305 | (tramp-compat-funcall 'file-attributes filename id-format) |
| 306 | (wrong-number-of-arguments (file-attributes filename)))))) |
| 307 | |
| 308 | ;; PRESERVE-UID-GID does not exist in XEmacs. |
| 309 | ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1 |
| 310 | ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3. |
| 311 | (defun tramp-compat-copy-file |
| 312 | (filename newname &optional ok-if-already-exists keep-date |
| 313 | preserve-uid-gid preserve-extended-attributes) |
| 314 | "Like `copy-file' for Tramp files (compat function)." |
| 315 | (cond |
| 316 | (preserve-extended-attributes |
| 317 | (tramp-compat-funcall |
| 318 | 'copy-file filename newname ok-if-already-exists keep-date |
| 319 | preserve-uid-gid preserve-extended-attributes)) |
| 320 | (preserve-uid-gid |
| 321 | (tramp-compat-funcall |
| 322 | 'copy-file filename newname ok-if-already-exists keep-date |
| 323 | preserve-uid-gid)) |
| 324 | (t |
| 325 | (copy-file filename newname ok-if-already-exists keep-date)))) |
| 326 | |
| 327 | ;; `copy-directory' is a new function in Emacs 23.2. Implementation |
| 328 | ;; is taken from there. |
| 329 | (defun tramp-compat-copy-directory |
| 330 | (directory newname &optional keep-time parents copy-contents) |
| 331 | "Make a copy of DIRECTORY (compat function)." |
| 332 | (condition-case nil |
| 333 | (tramp-compat-funcall |
| 334 | 'copy-directory directory newname keep-time parents copy-contents) |
| 335 | |
| 336 | ;; `copy-directory' is either not implemented, or it does not |
| 337 | ;; support the the COPY-CONTENTS flag. For the time being, we |
| 338 | ;; ignore COPY-CONTENTS as well. |
| 339 | |
| 340 | (error |
| 341 | ;; If `default-directory' is a remote directory, make sure we |
| 342 | ;; find its `copy-directory' handler. |
| 343 | (let ((handler (or (find-file-name-handler directory 'copy-directory) |
| 344 | (find-file-name-handler newname 'copy-directory)))) |
| 345 | (if handler |
| 346 | (funcall handler 'copy-directory directory newname keep-time parents) |
| 347 | |
| 348 | ;; Compute target name. |
| 349 | (setq directory (directory-file-name (expand-file-name directory)) |
| 350 | newname (directory-file-name (expand-file-name newname))) |
| 351 | (if (and (file-directory-p newname) |
| 352 | (not (string-equal (file-name-nondirectory directory) |
| 353 | (file-name-nondirectory newname)))) |
| 354 | (setq newname |
| 355 | (expand-file-name |
| 356 | (file-name-nondirectory directory) newname))) |
| 357 | (if (not (file-directory-p newname)) (make-directory newname parents)) |
| 358 | |
| 359 | ;; Copy recursively. |
| 360 | (mapc |
| 361 | (lambda (file) |
| 362 | (if (file-directory-p file) |
| 363 | (tramp-compat-copy-directory file newname keep-time parents) |
| 364 | (copy-file file newname t keep-time))) |
| 365 | ;; We do not want to delete "." and "..". |
| 366 | (directory-files |
| 367 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) |
| 368 | |
| 369 | ;; Set directory attributes. |
| 370 | (set-file-modes newname (file-modes directory)) |
| 371 | (if keep-time |
| 372 | (set-file-times newname (nth 5 (file-attributes directory))))))))) |
| 373 | |
| 374 | ;; TRASH has been introduced with Emacs 24.1. |
| 375 | (defun tramp-compat-delete-file (filename &optional trash) |
| 376 | "Like `delete-file' for Tramp files (compat function)." |
| 377 | (condition-case nil |
| 378 | (tramp-compat-funcall 'delete-file filename trash) |
| 379 | ;; This Emacs version does not support the TRASH flag. |
| 380 | (wrong-number-of-arguments |
| 381 | (let ((delete-by-moving-to-trash |
| 382 | (and (boundp 'delete-by-moving-to-trash) |
| 383 | (symbol-value 'delete-by-moving-to-trash) |
| 384 | trash))) |
| 385 | (delete-file filename))))) |
| 386 | |
| 387 | ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been |
| 388 | ;; introduced with Emacs 24.1. |
| 389 | (defun tramp-compat-delete-directory (directory &optional recursive trash) |
| 390 | "Like `delete-directory' for Tramp files (compat function)." |
| 391 | (condition-case nil |
| 392 | (cond |
| 393 | (trash |
| 394 | (tramp-compat-funcall 'delete-directory directory recursive trash)) |
| 395 | (recursive |
| 396 | (tramp-compat-funcall 'delete-directory directory recursive)) |
| 397 | (t |
| 398 | (delete-directory directory))) |
| 399 | ;; This Emacs version does not support the RECURSIVE or TRASH flag. We |
| 400 | ;; use the implementation from Emacs 23.2. |
| 401 | (wrong-number-of-arguments |
| 402 | (setq directory (directory-file-name (expand-file-name directory))) |
| 403 | (if (not (file-symlink-p directory)) |
| 404 | (mapc (lambda (file) |
| 405 | (if (eq t (car (file-attributes file))) |
| 406 | (tramp-compat-delete-directory file recursive trash) |
| 407 | (tramp-compat-delete-file file trash))) |
| 408 | (directory-files |
| 409 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) |
| 410 | (delete-directory directory)))) |
| 411 | |
| 412 | ;; `number-sequence' does not exist in XEmacs. Implementation is |
| 413 | ;; taken from Emacs 23. |
| 414 | (defun tramp-compat-number-sequence (from &optional to inc) |
| 415 | "Return a sequence of numbers from FROM to TO as a list (compat function)." |
| 416 | (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) |
| 417 | (tramp-compat-funcall 'number-sequence from to inc) |
| 418 | (if (or (not to) (= from to)) |
| 419 | (list from) |
| 420 | (or inc (setq inc 1)) |
| 421 | (when (zerop inc) (error "The increment can not be zero")) |
| 422 | (let (seq (n 0) (next from)) |
| 423 | (if (> inc 0) |
| 424 | (while (<= next to) |
| 425 | (setq seq (cons next seq) |
| 426 | n (1+ n) |
| 427 | next (+ from (* n inc)))) |
| 428 | (while (>= next to) |
| 429 | (setq seq (cons next seq) |
| 430 | n (1+ n) |
| 431 | next (+ from (* n inc))))) |
| 432 | (nreverse seq))))) |
| 433 | |
| 434 | (defun tramp-compat-split-string (string pattern) |
| 435 | "Like `split-string' but omit empty strings. |
| 436 | In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). |
| 437 | This is, the first, empty, element is omitted. In XEmacs, the first |
| 438 | element is not omitted." |
| 439 | (delete "" (split-string string pattern))) |
| 440 | |
| 441 | (defun tramp-compat-process-running-p (process-name) |
| 442 | "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." |
| 443 | (when (stringp process-name) |
| 444 | (cond |
| 445 | ;; GNU Emacs 22 on w32. |
| 446 | ((fboundp 'w32-window-exists-p) |
| 447 | (tramp-compat-funcall 'w32-window-exists-p process-name process-name)) |
| 448 | |
| 449 | ;; GNU Emacs 23. |
| 450 | ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) |
| 451 | (let (result) |
| 452 | (dolist (pid (tramp-compat-funcall 'list-system-processes) result) |
| 453 | (let ((attributes (tramp-compat-funcall 'process-attributes pid))) |
| 454 | (when (and (string-equal |
| 455 | (cdr (assoc 'user attributes)) (user-login-name)) |
| 456 | (let ((comm (cdr (assoc 'comm attributes)))) |
| 457 | ;; The returned command name could be truncated |
| 458 | ;; to 15 characters. Therefore, we cannot check |
| 459 | ;; for `string-equal'. |
| 460 | (and comm (string-match |
| 461 | (concat "^" (regexp-quote comm)) |
| 462 | process-name)))) |
| 463 | (setq result t)))))) |
| 464 | |
| 465 | ;; Fallback, if there is no Lisp support yet. |
| 466 | (t (let ((default-directory |
| 467 | (if (file-remote-p default-directory) |
| 468 | (tramp-compat-temporary-file-directory) |
| 469 | default-directory)) |
| 470 | (unix95 (getenv "UNIX95")) |
| 471 | result) |
| 472 | (setenv "UNIX95" "1") |
| 473 | (when (member |
| 474 | (user-login-name) |
| 475 | (tramp-compat-split-string |
| 476 | (shell-command-to-string |
| 477 | (format "ps -C %s -o user=" process-name)) |
| 478 | "[ \f\t\n\r\v]+")) |
| 479 | (setq result t)) |
| 480 | (setenv "UNIX95" unix95) |
| 481 | result))))) |
| 482 | |
| 483 | ;; The following functions do not exist in XEmacs. We ignore this; |
| 484 | ;; they are used for checking a remote tty. |
| 485 | (defun tramp-compat-process-get (process propname) |
| 486 | "Return the value of PROCESS' PROPNAME property. |
| 487 | This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." |
| 488 | (ignore-errors (tramp-compat-funcall 'process-get process propname))) |
| 489 | |
| 490 | (defun tramp-compat-process-put (process propname value) |
| 491 | "Change PROCESS' PROPNAME property to VALUE. |
| 492 | It can be retrieved with `(process-get PROCESS PROPNAME)'." |
| 493 | (ignore-errors (tramp-compat-funcall 'process-put process propname value))) |
| 494 | |
| 495 | (defun tramp-compat-set-process-query-on-exit-flag (process flag) |
| 496 | "Specify if query is needed for process when Emacs is exited. |
| 497 | If the second argument flag is non-nil, Emacs will query the user before |
| 498 | exiting if process is running." |
| 499 | (if (fboundp 'set-process-query-on-exit-flag) |
| 500 | (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) |
| 501 | (tramp-compat-funcall 'process-kill-without-query process flag))) |
| 502 | |
| 503 | ;; There exist different implementations for this function. |
| 504 | (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) |
| 505 | "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. |
| 506 | EOL-TYPE can be one of `dos', `unix', or `mac'." |
| 507 | (cond ((fboundp 'coding-system-change-eol-conversion) |
| 508 | (tramp-compat-funcall |
| 509 | 'coding-system-change-eol-conversion coding-system eol-type)) |
| 510 | ((fboundp 'subsidiary-coding-system) |
| 511 | (tramp-compat-funcall |
| 512 | 'subsidiary-coding-system coding-system |
| 513 | (cond ((eq eol-type 'dos) 'crlf) |
| 514 | ((eq eol-type 'unix) 'lf) |
| 515 | ((eq eol-type 'mac) 'cr) |
| 516 | (t |
| 517 | (error "Unknown EOL-TYPE `%s', must be %s" |
| 518 | eol-type |
| 519 | "`dos', `unix', or `mac'"))))) |
| 520 | (t (error "Can't change EOL conversion -- is MULE missing?")))) |
| 521 | |
| 522 | ;; `user-error' has been added to Emacs 24.3. |
| 523 | (defun tramp-compat-user-error (format &rest args) |
| 524 | "Signal a pilot error." |
| 525 | (apply (if (fboundp 'user-error) 'user-error 'error) format args)) |
| 526 | |
| 527 | (add-hook 'tramp-unload-hook |
| 528 | (lambda () |
| 529 | (unload-feature 'tramp-compat 'force))) |
| 530 | |
| 531 | (provide 'tramp-compat) |
| 532 | |
| 533 | ;;; TODO: |
| 534 | |
| 535 | ;;; tramp-compat.el ends here |