;;; Commentary:
-;; Tramp's main Emacs version for development is GNU Emacs 23. This
-;; package provides compatibility functions for GNU Emacs 21, GNU
-;; Emacs 22 and XEmacs 21.4+.
+;; Tramp's main Emacs version for development is GNU Emacs 24. This
+;; package provides compatibility functions for GNU Emacs 22, GNU
+;; Emacs 23 and XEmacs 21.4+.
;;; Code:
(unless (boundp 'byte-compile-not-obsolete-var)
(defvar byte-compile-not-obsolete-var nil))
(setq byte-compile-not-obsolete-var 'directory-sep-char)
- (if (boundp 'byte-compile-not-obsolete-vars) ; Emacs 23.2
- (setq byte-compile-not-obsolete-vars '(directory-sep-char)))
+ ;; Emacs 23.2.
+ (unless (boundp 'byte-compile-not-obsolete-vars)
+ (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.
+ (defmacro tramp-compat-funcall (function &rest arguments)
+ (if (featurep 'xemacs)
+ `(funcall (symbol-function ,function) ,@arguments)
+ `(when (or (subrp ,function) (functionp ,function))
+ (with-no-warnings (funcall ,function ,@arguments)))))
+
;; `set-buffer-multibyte' comes from Emacs Leim.
(unless (fboundp 'set-buffer-multibyte)
(defalias 'set-buffer-multibyte 'ignore))
(tramp-file-name-handler
'file-remote-p file identification connected)))))
- ;; `process-file' exists since Emacs 22.
+ ;; `process-file' does not exist in XEmacs.
(unless (fboundp 'process-file)
(defalias 'process-file
(lambda (program &optional infile buffer display &rest args)
;; return the original filename if it can't expand anything. Let's
;; just hope that this doesn't break anything else.
;; It is not needed anymore since GNU Emacs 23.2.
- (unless (or (featurep 'xemacs) (featurep 'files 'remote-wildcards))
+ (unless (or (featurep 'xemacs)
+ ;; `featurep' has only one argument in XEmacs.
+ (funcall 'featurep 'files 'remote-wildcards))
(defadvice file-expand-wildcards
(around tramp-advice-file-expand-wildcards activate)
(let ((name (ad-get-arg 0)))
own implementation."
(cond
((fboundp 'line-beginning-position)
- (funcall (symbol-function 'line-beginning-position)))
- ((fboundp 'point-at-bol) (funcall (symbol-function 'point-at-bol)))
+ (tramp-compat-funcall 'line-beginning-position))
+ ((fboundp 'point-at-bol) (tramp-compat-funcall 'point-at-bol))
(t (save-excursion (beginning-of-line) (point)))))
(defsubst tramp-compat-line-end-position ()
Calls `line-end-position' or `point-at-eol' if defined, else
own implementation."
(cond
- ((fboundp 'line-end-position) (funcall (symbol-function 'line-end-position)))
- ((fboundp 'point-at-eol) (funcall (symbol-function 'point-at-eol)))
+ ((fboundp 'line-end-position) (tramp-compat-funcall 'line-end-position))
+ ((fboundp 'point-at-eol) (tramp-compat-funcall 'point-at-eol))
(t (save-excursion (end-of-line) (point)))))
(defsubst tramp-compat-temporary-file-directory ()
this is the function `temp-directory'."
(cond
((boundp 'temporary-file-directory) (symbol-value 'temporary-file-directory))
- ((fboundp 'temp-directory) (funcall (symbol-function 'temp-directory)))
+ ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
(file-name-as-directory (getenv "TEMP")))
((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp"))))
-;; `make-temp-file' exists in Emacs only. The third parameter SUFFIX
-;; has been introduced with Emacs 22. We try it, if it fails, we fall
-;; back to `make-temp-name', creating the temporary file immediately
-;; in order to avoid a security hole.
-(defsubst tramp-compat-make-temp-file (filename)
+;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
+;; implementation with `make-temp-name', creating the temporary file
+;; immediately in order to avoid a security hole.
+(defsubst tramp-compat-make-temp-file (filename &optional dir-flag)
"Create a temporary file (compat function).
Add the extension of FILENAME, if existing."
(let* (file-name-handler-alist
(tramp-compat-temporary-file-directory)))
(extension (file-name-extension filename t))
result)
- (condition-case nil
+ (if (fboundp 'make-temp-file)
(setq result
- (funcall (symbol-function 'make-temp-file) prefix nil extension))
- (error
- ;; We use our own implementation, taken from files.el.
- (while
- (condition-case ()
- (progn
- (setq result (concat (make-temp-name prefix) extension))
- (write-region
- "" nil result nil 'silent nil
- ;; 7th parameter is MUSTBENEW in Emacs, and
- ;; CODING-SYSTEM in XEmacs. It is not a security
- ;; hole in XEmacs if we cannot use this parameter,
- ;; because XEmacs uses a user-specific subdirectory
- ;; with 0700 permissions.
- (when (not (featurep 'xemacs)) 'excl))
- nil)
- (file-already-exists t))
- ;; The file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)))
+ (tramp-compat-funcall 'make-temp-file prefix dir-flag extension))
+ ;; We use our own implementation, taken from files.el.
+ (while
+ (condition-case ()
+ (progn
+ (setq result (concat (make-temp-name prefix) extension))
+ (if dir-flag
+ (make-directory result)
+ (write-region "" nil result nil 'silent))
+ nil)
+ (file-already-exists t))
+ ;; The file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil))
result))
-;; `most-positive-fixnum' arrived in Emacs 22. Before, and in XEmacs,
-;; it is a fixed value.
+;; `most-positive-fixnum' does not exist in XEmacs.
(defsubst tramp-compat-most-positive-fixnum ()
"Return largest positive integer value (compat function)."
(cond
((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum))
- ;; Default value in XEmacs and Emacs 21.
+ ;; Default value in XEmacs.
(t 134217727)))
-;; ID-FORMAT exists since Emacs 22.
+;; ID-FORMAT does not exists in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
(cond
((tramp-tramp-file-p filename)
(tramp-file-name-handler 'file-attributes filename id-format))
(t (condition-case nil
- (funcall (symbol-function 'file-attributes) filename id-format)
- (error (file-attributes filename))))))
+ (tramp-compat-funcall 'file-attributes filename id-format)
+ (wrong-number-of-arguments (file-attributes filename))))))
;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
;; hurt to ignore it for other (X)Emacs versions.
+;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.
(defun tramp-compat-copy-file
- (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files (compat function)."
- (if preserve-uid-gid
- (funcall
- (symbol-function 'copy-file)
- filename newname ok-if-already-exists keep-date preserve-uid-gid)
- (copy-file filename newname ok-if-already-exists keep-date)))
+ (cond
+ (preserve-selinux-context
+ (tramp-compat-funcall
+ 'copy-file filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-selinux-context))
+ (preserve-uid-gid
+ (tramp-compat-funcall
+ 'copy-file filename newname ok-if-already-exists keep-date
+ preserve-uid-gid))
+ (t
+ (copy-file filename newname ok-if-already-exists keep-date))))
;; `copy-directory' is a new function in Emacs 23.2. Implementation
;; is taken from there.
(directory newname &optional keep-time parents)
"Make a copy of DIRECTORY (compat function)."
(if (fboundp 'copy-directory)
- (funcall
- (symbol-function 'copy-directory) directory newname keep-time parents)
+ (tramp-compat-funcall 'copy-directory directory newname keep-time parents)
- ;; If default-directory is a remote directory, make sure we find
- ;; its copy-directory handler.
+ ;; If `default-directory' is a remote directory, make sure we find
+ ;; its `copy-directory' handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory))))
(if handler
(if keep-time
(set-file-times newname (nth 5 (file-attributes directory))))))))
-;; `copy-tree' is a built-in function in XEmacs. In Emacs 21, it is
-;; an autoloaded function in cl-extra.el. Since Emacs 22, it is part
-;; of subr.el. There are problems when autoloading, therefore we test
-;; for `subrp' and `symbol-file'. Implementation is taken from Emacs 23.
-(defun tramp-compat-copy-tree (tree)
- "Make a copy of TREE (compat function)."
- (if (or (subrp 'copy-tree) (symbol-file 'copy-tree))
- (funcall (symbol-function 'copy-tree) tree)
- (let (result)
- (while (consp tree)
- (let ((newcar (car tree)))
- (if (consp (car tree))
- (setq newcar (tramp-compat-copy-tree (car tree))))
- (push newcar result))
- (setq tree (cdr tree)))
- (nconc (nreverse result) tree))))
+;; TRASH has been introduced with Emacs 24.1.
+(defun tramp-compat-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files (compat function)."
+ (condition-case nil
+ (tramp-compat-funcall 'delete-file filename trash)
+ ;; This Emacs version does not support the TRASH flag.
+ (wrong-number-of-arguments
+ (let ((delete-by-moving-to-trash
+ (and (boundp 'delete-by-moving-to-trash)
+ delete-by-moving-to-trash
+ trash)))
+ (delete-file filename)))))
;; RECURSIVE has been introduced with Emacs 23.2.
(defun tramp-compat-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files (compat function)."
- (if recursive
- (funcall (symbol-function 'delete-directory) directory recursive)
- (delete-directory directory)))
-
-;; `number-sequence' has been introduced in Emacs 22. Implementation
-;; is taken from Emacs 23.
+ (if (null recursive)
+ (delete-directory directory)
+ (condition-case nil
+ (tramp-compat-funcall 'delete-directory directory recursive)
+ ;; This Emacs version does not support the RECURSIVE flag. We
+ ;; use the implementation from Emacs 23.2.
+ (wrong-number-of-arguments
+ (setq directory (directory-file-name (expand-file-name directory)))
+ (if (not (file-symlink-p directory))
+ (mapc (lambda (file)
+ (if (eq t (car (file-attributes file)))
+ (tramp-compat-delete-directory file recursive)
+ (delete-file file)))
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+ (delete-directory directory)))))
+
+;; `number-sequence' does not exist in XEmacs. Implementation is
+;; taken from Emacs 23.
(defun tramp-compat-number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO as a list (compat function)."
(if (or (subrp 'number-sequence) (symbol-file 'number-sequence))
- (funcall (symbol-function 'number-sequence) from to inc)
+ (tramp-compat-funcall 'number-sequence from to inc)
(if (or (not to) (= from to))
(list from)
(or inc (setq inc 1))
(cond
;; GNU Emacs 22 on w32.
((fboundp 'w32-window-exists-p)
- (funcall (symbol-function 'w32-window-exists-p)
- process-name process-name))
+ (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
;; GNU Emacs 23.
((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
(let (result)
- (dolist (pid (funcall (symbol-function 'list-system-processes)) result)
- (let ((attributes
- (funcall (symbol-function 'process-attributes) pid)))
+ (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
+ (let ((attributes (tramp-compat-funcall 'process-attributes pid)))
(when (and (string-equal
(cdr (assoc 'user attributes)) (user-login-name))
(let ((comm (cdr (assoc 'comm attributes))))
HCoop / bpt / emacs.git / blobdiff