Commit 9e6ab520 authored by Michael Albinus's avatar Michael Albinus
Browse files

* net/tramp-compat.el: New file.

* net/tramp.el:
* net/tramp-fish.el:
* net/tramp-smb.el:
* net/tramp-uu.el:
* net/trampver.el: Move compatibility code to tramp-compat.el.
Apply `mapc' instead of `mapcar' when the code needs side effects
only.  Move utf-8 coding cookie to the second line.
parent 2e55c986
2007-09-30 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-compat.el: New file.
* net/tramp.el:
* net/tramp-fish.el:
* net/tramp-smb.el:
* net/tramp-uu.el:
* net/trampver.el: Move compatibility code to tramp-compat.el.
Apply `mapc' instead of `mapcar' when the code needs side effects
only. Move utf-8 coding cookie to the second line.
2007-09-30 Reiner Steib <Reiner.Steib@gmx.de>
* term/x-win.el (x-gtk-stock-map): Add Gnus and MH-E icons.
......
;;; tramp-gw.el --- Tramp compatibility functions
;; Copyright (C) 2007 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
;;; 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+.
;;; Code:
;; Pacify byte-compiler
(eval-when-compile
(require 'cl)
(require 'custom))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
;(eval-when-compile
; (when (featurep 'xemacs)
; (byte-compiler-options (warnings (- unused-vars)))))
;; `last-coding-system-used' is unknown in XEmacs.
(eval-when-compile
(unless (boundp 'last-coding-system-used)
(defvar last-coding-system-used nil)))
;; `directory-sep-char' is an obsolete variable in Emacs. But it is
;; used in XEmacs, so we set it here and there. The following is needed
;; to pacify Emacs byte-compiler.
(eval-when-compile
(unless (boundp 'byte-compile-not-obsolete-var)
(defvar byte-compile-not-obsolete-var nil))
(setq byte-compile-not-obsolete-var 'directory-sep-char))
;; `with-temp-message' does not exists in XEmacs.
(eval-and-compile
(condition-case nil
(with-temp-message (current-message) nil)
(error (defmacro with-temp-message (message &rest body) `(progn ,@body)))))
;; `set-buffer-multibyte' comes from Emacs Leim.
(eval-and-compile
(unless (fboundp 'set-buffer-multibyte)
(defalias 'set-buffer-multibyte 'ignore)))
;; `font-lock-add-keywords' does not exist in XEmacs.
(eval-and-compile
(unless (fboundp 'font-lock-add-keywords)
(defalias 'font-lock-add-keywords 'ignore)))
(defsubst tramp-compat-line-end-position ()
"Return point at end of line (compat function).
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)))
(t (save-excursion (end-of-line) (point)))))
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files (compat function).
For Emacs, this is the variable `temporary-file-directory', for XEmacs
this is the function `temp-directory'."
(cond
((boundp 'temporary-file-directory)
(symbol-value 'temporary-file-directory))
((fboundp 'temp-directory)
(funcall (symbol-function 'temp-directory))) ;pacify byte-compiler
((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)))
(file-name-as-directory (getenv "TMP")))
((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
(file-name-as-directory (getenv "TMPDIR")))
((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
(t (message (concat "Neither `temporary-file-directory' nor "
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp"))))
;; `most-positive-fixnum' arrived in Emacs 22.
(defsubst tramp-compat-most-positive-fixnum ()
"Return largest positive integer value (compat function)."
(cond ((boundp 'most-positive-fixnum)
(symbol-value 'most-positive-fixnum))
(t 134217727)))
;; ID-FORMAT exists since Emacs 22.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
(cond
((or (null id-format) (eq id-format 'integer))
(file-attributes filename))
((file-remote-p filename)
(funcall (symbol-function 'tramp-handle-file-attributes)
filename id-format))
(t (condition-case nil
(funcall (symbol-function 'file-attributes) filename id-format)
(error (file-attributes filename))))))
;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
;; hurt to ignore it for other (X)Emacs versions.
(defun tramp-compat-copy-file
(filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"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)))
;; `copy-tree' is introduced with Emacs 22. We've adapted the
;; implementation from Emacs 23.
(defun tramp-compat-copy-tree (tree)
"Make a copy of TREE (compat function)."
(if (functionp '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))))
(eval-and-compile
(unless (fboundp 'file-remote-p)
(defalias 'file-remote-p 'tramp-handle-file-remote-p))
(unless (fboundp 'process-file)
(defalias 'process-file 'tramp-handle-process-file))
(unless (fboundp 'start-file-process)
(defalias 'start-file-process 'tramp-handle-start-file-process))
(unless (fboundp 'set-file-times)
(defalias 'set-file-times 'tramp-handle-set-file-times)))
(provide 'tramp-compat)
;;; TODO:
;;; tramp-compat.el ends here
......@@ -155,26 +155,19 @@
(require 'tramp)
(require 'tramp-cache)
;; Pacify byte-compiler
(eval-when-compile
(require 'cl)
(require 'custom))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
(when (featurep 'xemacs)
(byte-compiler-options (warnings (- unused-vars)))))
(require 'tramp-compat)
;; `directory-sep-char' is an obsolete variable in Emacs. But it is
;; used in XEmacs, so we set it here and there. The following is needed
;; to pacify Emacs byte-compiler.
(eval-when-compile
(unless (boundp 'byte-compile-not-obsolete-var)
(defvar byte-compile-not-obsolete-var nil))
(setq byte-compile-not-obsolete-var 'directory-sep-char))
;; Pacify byte-compiler
(eval-when-compile
(require 'cl)
(require 'custom))
;; Define FISH method ...
(defcustom tramp-fish-method "fish"
"*Method to connect via FISH protocol."
......@@ -386,7 +379,7 @@ pass to the OPERATION."
(tramp-fish-send-command-and-check v "#PWD")
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-min))
(buffer-substring (point) (tramp-line-end-position)))))
(buffer-substring (point) (tramp-compat-line-end-position)))))
(setq localname (concat uname fname))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
......@@ -399,7 +392,7 @@ pass to the OPERATION."
;; bound, because on Windows there would be problems with UNC
;; shares or Cygwin mounts.
(tramp-let-maybe directory-sep-char ?/
(let ((default-directory (tramp-temporary-file-directory)))
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
method user host
(tramp-drop-volume-letter
......@@ -701,11 +694,10 @@ target of the symlink differ."
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(let ((time (if (or (null time) (equal time '(0 0))) (current-time) time)))
(zerop (apply
'process-file
(list "touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument localname)))))))
(zerop (process-file
"touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument localname))))))
(defun tramp-fish-handle-write-region
(start end filename &optional append visit lockname confirm)
......@@ -740,10 +732,10 @@ target of the symlink differ."
(defun tramp-fish-handle-executable-find (command)
"Like `executable-find' for Tramp files."
(with-temp-buffer
(if (zerop (apply 'process-file (list "which" nil t nil command)))
(if (zerop (process-file "which" nil t nil command))
(progn
(goto-char (point-min))
(buffer-substring (point-min) (tramp-line-end-position))))))
(buffer-substring (point-min) (tramp-compat-line-end-position))))))
(defun tramp-fish-handle-process-file
(program &optional infile destination display &rest args)
......@@ -936,7 +928,7 @@ KEEP-DATE is non-nil, preserve the time stamp when copying."
(tramp-shell-quote-argument v2-localname)))))
;; KEEP-DATE handling.
(when (and keep-date (functionp 'set-file-times))
(apply 'set-file-times (list newname (nth 5 (file-attributes filename)))))
(set-file-times newname (nth 5 (file-attributes filename))))
;; Set the mode.
(set-file-modes newname (file-modes filename)))
......@@ -1133,7 +1125,8 @@ connection if a previous connection has died for some reason."
(coding-system-for-read 'binary)
(coding-system-for-write 'binary)
;; This must be done in order to avoid our file name handler.
(p (let ((default-directory (tramp-temporary-file-directory)))
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(start-process
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec))
......
......@@ -30,15 +30,12 @@
(require 'tramp)
(require 'tramp-cache)
(require 'tramp-compat)
;; Pacify byte-compiler
(eval-when-compile (require 'custom))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
(when (featurep 'xemacs)
(byte-compiler-options (warnings (- unused-vars)))))
(require 'cl)
(require 'custom))
;; Define SMB method ...
(defcustom tramp-smb-method "smb"
......@@ -763,7 +760,7 @@ If SHARE is result, entries are of type dir. Otherwise, shares are listed.
Result is the list (LOCALNAME MODE SIZE MTIME)."
;; We are called from `tramp-smb-get-file-entries', which sets the
;; current buffer.
(let ((line (buffer-substring (point) (tramp-line-end-position)))
(let ((line (buffer-substring (point) (tramp-compat-line-end-position)))
localname mode size month day hour min sec year mtime)
(if (not share)
......@@ -891,7 +888,7 @@ connection if a previous connection has died for some reason."
(when (and p (processp p)) (delete-process p))
(unless (let ((default-directory
(tramp-temporary-file-directory)))
(tramp-compat-temporary-file-directory)))
(executable-find tramp-smb-program))
(error "Cannot find command %s in %s" tramp-smb-program exec-path))
......@@ -930,7 +927,8 @@ connection if a previous connection has died for some reason."
(let* ((coding-system-for-read nil)
(process-connection-type tramp-process-connection-type)
(p (let ((default-directory (tramp-temporary-file-directory)))
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(apply #'start-process
(tramp-buffer-name vec) (tramp-get-buffer vec)
tramp-smb-program args))))
......
;;; -*- coding: utf-8; -*-
;;; tramp-uu.el --- uuencode in Lisp
;;; -*- coding: utf-8; -*-
;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
;; 2007 Free Software Foundation, Inc.
......
This diff is collapsed.
;;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
;;; trampver.el --- Transparent Remote Access, Multiple Protocol
;;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
;;; lisp/trampver.el. Generated from trampver.el.in by configure.
;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment