diff options
Diffstat (limited to 'lisp/net')
66 files changed, 724 insertions, 1529 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 7fbf7f3650f..d5c03e3f4ae 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1,6 +1,6 @@ ;;; ange-ftp.el --- transparent FTP support for GNU Emacs -;; Copyright (C) 1989-1996, 1998, 2000-2015 Free Software Foundation, +;; Copyright (C) 1989-1996, 1998, 2000-2016 Free Software Foundation, ;; Inc. ;; Author: Andy Norman (ange@hplb.hpl.hp.com) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index d232c8add13..26fa0d94b88 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1,6 +1,6 @@ ;;; browse-url.el --- pass a URL to a WWW browser -;; Copyright (C) 1995-2015 Free Software Foundation, Inc. +;; Copyright (C) 1995-2016 Free Software Foundation, Inc. ;; Author: Denis Howe <dbh@doc.ic.ac.uk> ;; Maintainer: emacs-devel@gnu.org diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index e8e6bc0cb6a..7a4ef1f7bcf 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1,6 +1,6 @@ ;;; dbus.el --- Elisp bindings for D-Bus. -;; Copyright (C) 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, hardware diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 234139f94bd..02cb627cfd3 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -1,6 +1,6 @@ ;;; dig.el --- Domain Name System dig interface -;; Copyright (C) 2000-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000-2016 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: DNS BIND dig comm diff --git a/lisp/net/dns.el b/lisp/net/dns.el index ba6523f6f5f..487cfc9d080 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -1,6 +1,6 @@ ;;; dns.el --- Domain Name Service lookups -;; Copyright (C) 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 2002-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: network comm diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index e48af4dc205..fe0e3b81d57 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -1,6 +1,6 @@ ;;; eudc-bob.el --- Binary Objects Support for EUDC -;; Copyright (C) 1999-2015 Free Software Foundation, Inc. +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index a9fac516745..a50892d94d4 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -1,6 +1,6 @@ ;;; eudc-export.el --- functions to export EUDC query results -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index 55a2fd9a20a..558ecb6b388 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -1,6 +1,6 @@ ;;; eudc-hotlist.el --- hotlist management for EUDC -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index de7e25a66aa..19da7ec1539 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -1,6 +1,6 @@ ;;; eudc-vars.el --- Emacs Unified Directory Client -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 25a26bdf029..867bea98e77 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1,6 +1,6 @@ ;;; eudc.el --- Emacs Unified Directory Client -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 1972fc1939a..796391be2de 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -1,6 +1,6 @@ ;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index b50d29ddae8..ae0bb02de0a 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -1,6 +1,6 @@ ;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Pavel Janík <Pavel@Janik.cz> diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index a11cd95b05d..0f99ff0d027 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -1,6 +1,6 @@ ;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@newartisans.com> ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> diff --git a/lisp/net/eww.el b/lisp/net/eww.el index fabf36ba263..3c2e74799af 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1,6 +1,6 @@ ;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*- -;; Copyright (C) 2013-2015 Free Software Foundation, Inc. +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: html diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index a7321da854c..ce44c032231 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -1,6 +1,6 @@ ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> ;; Keywords: comm, tls, ssl, encryption diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 51d8ed11b0b..bc3c403e2f2 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -1,6 +1,6 @@ ;;; goto-addr.el --- click to browse URL or to send to e-mail address -;; Copyright (C) 1995, 2000-2015 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2000-2016 Free Software Foundation, Inc. ;; Author: Eric Ding <ericding@alum.mit.edu> ;; Maintainer: emacs-devel@gnu.org diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index 2855fa4d57e..c5df4fd7fa3 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -1,6 +1,6 @@ ;;; hmac-def.el --- A macro for defining HMAC functions. -;; Copyright (C) 1999, 2001, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2007-2016 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; Keywords: HMAC, RFC2104 diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el index 26f448fee6a..dfeeeaa61ec 100644 --- a/lisp/net/hmac-md5.el +++ b/lisp/net/hmac-md5.el @@ -1,6 +1,6 @@ ;;; hmac-md5.el --- Compute HMAC-MD5. -;; Copyright (C) 1999, 2001, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2007-2016 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; Keywords: HMAC, RFC2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 diff --git a/lisp/net/imap.el b/lisp/net/imap.el index cc89f475bba..5c5ed868172 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1,6 +1,6 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: mail diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 1c604e330b2..d08fdbee375 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,6 +1,6 @@ ;;; ldap.el --- client interface to LDAP for Emacs -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: emacs-devel@gnu.org diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 997e47b1ec2..c6e78235e2c 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -1,6 +1,6 @@ ;;; mairix.el --- Mairix interface for Emacs -;; Copyright (C) 2008-2015 Free Software Foundation, Inc. +;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; Author: David Engster <dengste@eml.cc> ;; Keywords: mail searching diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 643d312fc2b..8029e2ca70a 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -1,6 +1,6 @@ ;;; net-utils.el --- network functions -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Sun Mar 16 1997 diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 61da85c7c1c..274a038d251 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -1,5 +1,5 @@ ;;; netrc.el --- .netrc parsing functionality -;; Copyright (C) 1996-2015 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 8e1ad637b29..59ac2995c05 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -1,6 +1,6 @@ ;;; network-stream.el --- open network processes, possibly with encryption -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: network diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 2bec11ee3a3..2596e56aa47 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1,6 +1,6 @@ ;;; newst-backend.el --- Retrieval backend for newsticker. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-backend.el diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index b4e569078a9..17153f01c09 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -1,6 +1,6 @@ ;;; newst-plainview.el --- Single buffer frontend for newsticker. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-plainview.el diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index 105b36e14a3..1647ef85364 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -1,6 +1,6 @@ ;;; newst-reader.el --- Generic RSS reader functions. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-reader.el diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index 9426bb7a8e4..d7e7a4463f9 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -1,6 +1,6 @@ ;; newst-ticker.el --- mode line ticker for newsticker. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-ticker.el diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 4f81b864970..0e75236154b 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1,6 +1,6 @@ ;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*- -;; Copyright (C) 2008-2015 Free Software Foundation, Inc. +;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newst-treeview.el diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 9b16c1f0749..66b7a69aae8 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -1,6 +1,6 @@ ;;; newsticker.el --- A Newsticker for Emacs. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Filename: newsticker.el diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index c54553ae5ea..ebdeeccc2c8 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -1,6 +1,6 @@ ;;; nsm.el --- Network Security Manager -;; Copyright (C) 2014-2015 Free Software Foundation, Inc. +;; Copyright (C) 2014-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: encryption, security, network @@ -183,7 +183,9 @@ unencrypted." (defun nsm-check-protocol (process host port status settings) (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)) - (encryption (format "%s-%s-%s" + (signature-algorithm + (plist-get (plist-get status :certificate) :signature-algorithm)) + (encryption (format "%s-%s-%s" (plist-get status :key-exchange) (plist-get status :cipher) (plist-get status :mac))) @@ -209,6 +211,15 @@ unencrypted." host port encryption))) (delete-process process) nil) + ((and (string-match "\\bSHA1\\b" signature-algorithm) + (not (memq :signature-sha1 (plist-get settings :conditions))) + (not + (nsm-query + host port status :signature-sha1 + "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe." + host port signature-algorithm))) + (delete-process process) + nil) ((and protocol (string-match "SSL" protocol) (not (memq :ssl (plist-get settings :conditions))) diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index acfa00596b4..d96f3b1ebea 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -1,6 +1,6 @@ ;;; ntlm.el --- NTLM (NT LanManager) authentication support -;; Copyright (C) 2001, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2007-2016 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org> diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el index 0037006f40a..27374afe4bf 100644 --- a/lisp/net/pinentry.el +++ b/lisp/net/pinentry.el @@ -1,6 +1,6 @@ ;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*- -;; Copyright (C) 2015 Free Software Foundation, Inc. +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@gnu.org> ;; Version: 0.1 diff --git a/lisp/net/puny.el b/lisp/net/puny.el index b3a82a29328..50bde85287d 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -1,6 +1,6 @@ ;;; puny.el --- translate non-ASCII domain names to ASCII -;; Copyright (C) 2015 Free Software Foundation, Inc. +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: mail, net diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 2d571254d35..7a46485531a 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -1,6 +1,6 @@ ;;; quickurl.el --- insert a URL based on text at point in buffer -;; Copyright (C) 1999-2015 Free Software Foundation, Inc. +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Dave Pearson <davep@davep.org> ;; Maintainer: Dave Pearson <davep@davep.org> diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 3539dcf91f4..55b43f63963 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1,6 +1,6 @@ ;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*- -;; Copyright (C) 2005-2015 Free Software Foundation, Inc. +;; Copyright (C) 2005-2016 Free Software Foundation, Inc. ;; Author: Ryan Yeske <rcyeske@gmail.com> ;; Maintainers: Ryan Yeske <rcyeske@gmail.com>, diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el index f80e2287879..d579f8f6eba 100644 --- a/lisp/net/rfc2104.el +++ b/lisp/net/rfc2104.el @@ -1,6 +1,6 @@ ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas@pdc.kth.se> ;; Keywords: mail diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index fead60eb8ab..921ceff290f 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -1,6 +1,6 @@ ;;; rlogin.el --- remote login interface -;; Copyright (C) 1992-1995, 1997-1998, 2001-2015 Free Software +;; Copyright (C) 1992-1995, 1997-1998, 2001-2016 Free Software ;; Foundation, Inc. ;; Author: Noah Friedman diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el index 235159497ab..1ac72fe21c5 100644 --- a/lisp/net/sasl-cram.el +++ b/lisp/net/sasl-cram.el @@ -1,6 +1,6 @@ ;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007-2016 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el index aa3843bb386..0c77f00cfd9 100644 --- a/lisp/net/sasl-digest.el +++ b/lisp/net/sasl-digest.el @@ -1,6 +1,6 @@ ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007-2016 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el index cab899e8ff9..66b6ab50e56 100644 --- a/lisp/net/sasl-ntlm.el +++ b/lisp/net/sasl-ntlm.el @@ -1,6 +1,6 @@ ;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework -;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007-2016 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Keywords: SASL, NTLM diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index 34d6ddbd679..328c2d46f79 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -1,6 +1,6 @@ ;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*- -;; Copyright (C) 2014-2015 Free Software Foundation, Inc. +;; Copyright (C) 2014-2016 Free Software Foundation, Inc. ;; Author: Magnus Henoch <magnus.henoch@gmail.com> ;; Package: sasl diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 9321efdfda8..419fef0f3b7 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -1,6 +1,6 @@ ;;; sasl.el --- SASL client framework -;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007-2016 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: SASL diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 5e0274029f1..55d5f007ac5 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -1,6 +1,6 @@ ;;; secrets.el --- Client interface to gnome-keyring and kwallet. -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm password passphrase diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el index f8d358c27b3..67e3b90b9d4 100644 --- a/lisp/net/shr-color.el +++ b/lisp/net/shr-color.el @@ -1,6 +1,6 @@ ;;; shr-color.el --- Simple HTML Renderer color management -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Julien Danjou <julien@danjou.info> ;; Keywords: html diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 0effa93b197..2511d673e7e 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1,6 +1,6 @@ ;;; shr.el --- Simple HTML Renderer -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: html @@ -259,6 +259,11 @@ DOM should be a parse tree as generated by (* (frame-char-width) 2) 0))))) bidi-display-reordering) + ;; If the window was hscrolled for some reason, shr-fill-lines + ;; below will misbehave, because it silently assumes that it + ;; starts with a non-hscrolled window (vertical-motion will move + ;; to a wrong place otherwise). + (set-window-hscroll nil 0) (shr-descend dom) (shr-fill-lines start (point)) (shr-remove-trailing-whitespace start (point)) @@ -1373,7 +1378,7 @@ The preference is a float determined from `shr-prefer-media-type'." (start (point))) (unless url (setq url (car (shr--extract-best-source dom)))) - (if image + (if (> (length image) 0) (shr-tag-img nil image) (shr-insert " [video] ")) (shr-urlify start (shr-expand-url url)))) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index e5740ac560e..4afc460779f 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -1,6 +1,6 @@ ;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode -;; Copyright (C) 1995, 1998, 2001-2015 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1998, 2001-2016 Free Software Foundation, Inc. ;; Author: Paul D. Smith <psmith@BayNetworks.com> ;; Keywords: data diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 790084a4862..74024644966 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1,6 +1,6 @@ ;;; soap-client.el --- Access SOAP web services -*- lexical-binding: t -*- -;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> @@ -538,7 +538,7 @@ This is a specialization of `soap-encode-value' for (base64Binary (unless (stringp value) (error "Not a string value for base64Binary")) - (base64-encode-string value)) + (base64-encode-string (encode-coding-string value 'utf-8))) (otherwise (error "Don't know how to encode %s for type %s" @@ -682,7 +682,7 @@ This is a specialization of `soap-decode-type' for decimal byte float double duration) (string-to-number (car contents))) (boolean (string= (downcase (car contents)) "true")) - (base64Binary (base64-decode-string (car contents))) + (base64Binary (decode-coding-string (base64-decode-string (car contents)) 'utf-8)) (anyType (soap-decode-any-type node)) (Array (soap-decode-array node)))))) diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index a4430417ad0..9e7947a2eb5 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -1,6 +1,6 @@ ;;; soap-inspect.el --- Interactive WSDL inspector -*- lexical-binding: t -*- -;; Copyright (C) 2010-2015 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Created: October 2010 diff --git a/lisp/net/socks.el b/lisp/net/socks.el index db9579573f6..f2a8fc3223e 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -1,6 +1,6 @@ ;;; socks.el --- A Socks v5 Client for Emacs -;; Copyright (C) 1996-2000, 2002, 2007-2015 Free Software Foundation, +;; Copyright (C) 1996-2000, 2002, 2007-2016 Free Software Foundation, ;; Inc. ;; Author: William M. Perry <wmperry@gnu.org> diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el index 6d9f408d5ca..95c32a5b4fc 100644 --- a/lisp/net/telnet.el +++ b/lisp/net/telnet.el @@ -1,6 +1,6 @@ ;;; telnet.el --- run a telnet session from within an Emacs buffer -;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2015 Free Software +;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2016 Free Software ;; Foundation, Inc. ;; Author: William F. Schelter diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 72fb50ed923..30895d043c8 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -1,6 +1,6 @@ ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -;; Copyright (C) 1996-1999, 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2002-2016 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: comm, tls, gnutls, ssl diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 178b3a0fd11..d0a5c52f5ed 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1,6 +1,6 @@ ;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp -;; Copyright (C) 2011-2015 Free Software Foundation, Inc. +;; Copyright (C) 2011-2016 Free Software Foundation, Inc. ;; Author: Jürgen Hötzel <juergen@archlinux.org> ;; Keywords: comm, processes @@ -35,10 +35,6 @@ (require 'tramp) -;; Pacify byte-compiler. -(defvar directory-listing-before-filename-regexp) -(defvar directory-sep-char) - ;;;###tramp-autoload (defcustom tramp-adb-program "adb" "Name of the Android Debug Bridge program." @@ -109,7 +105,6 @@ It is used for TCP/IP devices." (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-adb-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-adb-handle-expand-file-name) @@ -162,7 +157,7 @@ It is used for TCP/IP devices." (shell-command . tramp-adb-handle-shell-command) (start-file-process . tramp-adb-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-adb-handle-write-region)) @@ -199,7 +194,7 @@ pass to the OPERATION." tramp-current-host nil nil)) result) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (while (eq 'run (process-status p)) (accept-process-output p 0.1)) (accept-process-output p 0.1) @@ -213,7 +208,7 @@ pass to the OPERATION." (lambda (elt) (setcar (cdr elt) - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string ":" tramp-prefix-port-format (car (cdr elt))))) result) result)))) @@ -233,12 +228,9 @@ pass to the OPERATION." (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do normal `expand-file-name' (this does "/./" and "/../"). - ;; We bind `directory-sep-char' here for XEmacs on Windows, - ;; which would otherwise use backslash. `default-directory' is - ;; bound, because on Windows there would be problems with UNC - ;; shares or Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter @@ -261,8 +253,7 @@ pass to the OPERATION." (with-tramp-file-property v localname "file-truename" (let ((result nil)) ; result steps in reverse order (tramp-message v 4 "Finding true name for `%s'" filename) - (let* ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) + (let* ((steps (split-string localname "/" 'omit)) (localnamedir (tramp-run-real-handler 'file-name-as-directory (list localname))) (is-dir (string= localname localnamedir)) @@ -312,8 +303,7 @@ pass to the OPERATION." "Symlink target `%s' on wrong host" symlink-target)) (setq symlink-target localname)) (setq steps - (append (tramp-compat-split-string - symlink-target "/") + (append (split-string symlink-target "/" 'omit) steps))) (t ;; It's a file. @@ -450,9 +440,8 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." (split-string (apply 'concat (mapcar (lambda (s) - (tramp-compat-replace-regexp-in-string - "\\(.\\)" " -\\1" - (tramp-compat-replace-regexp-in-string "^-" "" s))) + (replace-regexp-in-string + "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s))) ;; FIXME: Warning about removed switches (long and non-dash). (delq nil (mapcar @@ -585,8 +574,7 @@ Emacs dired can't find files." v 'file-error "Cannot make local copy of file `%s'" filename)) (set-file-modes tmpfile - (logior (or (file-modes filename) 0) - (tramp-compat-octal-to-decimal "0400")))) + (logior (or (file-modes filename) 0) (string-to-number "0400" 8)))) tmpfile))) (defun tramp-adb-handle-file-writable-p (filename) @@ -631,8 +619,7 @@ But handle the case, if the \"test\" command is not available." (copy-file filename tmpfile 'ok) (set-file-modes tmpfile - (logior (or (file-modes tmpfile) 0) - (tramp-compat-octal-to-decimal "0600")))) + (logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8)))) (tramp-run-real-handler 'write-region (list start end tmpfile append 'no-message lockname confirm)) @@ -657,8 +644,7 @@ But handle the case, if the \"test\" command is not available." (with-parsed-tramp-file-name filename nil (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-file-property v localname) - (tramp-adb-send-command-and-check - v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname)))) + (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname)))) (defun tramp-adb-handle-set-file-times (filename &optional time) "Like `set-file-times' for Tramp files." @@ -736,10 +722,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and t1 t2 (tramp-equal-remote filename newname) (not (file-directory-p filename))) - (let ((l1 (tramp-file-name-handler - 'file-remote-p filename 'localname)) - (l2 (tramp-file-name-handler - 'file-remote-p newname 'localname))) + (let ((l1 (file-remote-p filename 'localname)) + (l2 (file-remote-p newname 'localname))) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) @@ -755,7 +739,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Error renaming %s to %s" filename newname)) ;; Rename by copy. - (copy-file filename newname ok-if-already-exists t t) + (copy-file + filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (delete-file filename)))))) (defun tramp-adb-handle-process-file @@ -856,12 +841,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -941,9 +921,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (current-buffer)))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (tramp-compat-funcall 'display-message-or-buffer output-buffer) - (pop-to-buffer output-buffer)))))))) + (display-message-or-buffer output-buffer))))))) ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once @@ -1008,7 +986,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; process. We ignore errors, because the process ;; could have finished already. (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t) + (set-process-query-on-exit-flag p t) (set-marker (process-mark p) (point))) ;; Return process. p)))) @@ -1035,7 +1013,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (host (tramp-file-name-host vec)) (port (tramp-file-name-port vec)) (devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))) - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string tramp-prefix-port-format ":" (cond ((member host devices) host) ;; This is the case when the host is connected to the default port. @@ -1051,7 +1029,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (not (zerop (length host))) (not (tramp-adb-execute-adb-command vec "connect" - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string tramp-prefix-port-format ":" host)))) ;; When new device connected, running other adb command (e.g. ;; adb shell) immediately will fail. To get around this @@ -1205,7 +1183,7 @@ connection if a previous connection has died for some reason." (unless (eq 'run (process-status p)) (tramp-error vec 'file-error "Terminated!")) (tramp-set-connection-property p "vector" vec) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; Check whether the properties have been changed. If ;; yes, this is a strong indication that we must expire all @@ -1250,7 +1228,7 @@ connection if a previous connection has died for some reason." ;; Read the expression. (goto-char (point-min)) (read (current-buffer))) - ":" 'omit-nulls)))))))) + ":" 'omit)))))))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index bfcfe158281..92f66f414ae 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -1,6 +1,6 @@ ;;; tramp-cache.el --- file information caching for Tramp -;; Copyright (C) 2000, 2005-2015 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2005-2016 Free Software Foundation, Inc. ;; Author: Daniel Pittman <daniel@inanna.danann.net> ;; Michael Albinus <michael.albinus@gmx.de> @@ -75,25 +75,7 @@ details see the info pages." (choice :tag " Value" sexp)))) (defcustom tramp-persistency-file-name - (cond - ;; GNU Emacs. - ((and (fboundp 'locate-user-emacs-file)) - (expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp"))) - ((and (boundp 'user-emacs-directory) - (stringp (symbol-value 'user-emacs-directory)) - (file-directory-p (symbol-value 'user-emacs-directory))) - (expand-file-name "tramp" (symbol-value 'user-emacs-directory))) - ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/")) - "~/.emacs.d/tramp") - ;; XEmacs. - ((and (boundp 'user-init-directory) - (stringp (symbol-value 'user-init-directory)) - (file-directory-p (symbol-value 'user-init-directory))) - (expand-file-name "tramp" (symbol-value 'user-init-directory))) - ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/")) - "~/.xemacs/tramp") - ;; For users without `~/.emacs.d/' or `~/.xemacs/'. - (t "~/.tramp")) + (expand-file-name (locate-user-emacs-file "tramp")) "File which keeps connection history for Tramp connections." :group 'tramp :type 'file) @@ -307,19 +289,14 @@ KEY identifies the connection, it is either a process or a vector." (maphash (lambda (key value) ;; Remove text properties from KEY and VALUE. - ;; `substring-no-properties' does not exist in XEmacs. - (when (functionp 'substring-no-properties) - (when (vectorp key) - (dotimes (i (length key)) - (when (stringp (aref key i)) - (aset key i - (tramp-compat-funcall - 'substring-no-properties (aref key i)))))) - (when (stringp key) - (setq key (tramp-compat-funcall 'substring-no-properties key))) - (when (stringp value) - (setq value - (tramp-compat-funcall 'substring-no-properties value)))) + (when (vectorp key) + (dotimes (i (length key)) + (when (stringp (aref key i)) + (aset key i (substring-no-properties (aref key i)))))) + (when (stringp key) + (setq key (substring-no-properties key))) + (when (stringp value) + (setq value (substring-no-properties value))) ;; Dump. (let ((tmp (format "(%s %s)" @@ -418,8 +395,8 @@ for all methods. Resulting data are derived from connection history." ;; When "emacs -Q" has been called, both variables are nil. ;; We do not load the persistency file then, in order to ;; have a clean test environment. - (or (and (boundp 'init-file-user) (symbol-value 'init-file-user)) - (and (boundp 'site-run-file) (symbol-value 'site-run-file)))) + (or init-file-user + site-run-file)) (condition-case err (with-temp-buffer (insert-file-contents tramp-persistency-file-name) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 22c139859f9..f9b66d43074 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -1,6 +1,6 @@ ;;; tramp-cmds.el --- Interactive commands for Tramp -;; Copyright (C) 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -31,6 +31,9 @@ (require 'tramp) ;; Pacify byte-compiler. +(declare-function mml-mode "mml") +(declare-function mml-insert-empty-tag "mml") +(declare-function reporter-dump-variable "reporter") (defvar reporter-eval-buffer) (defvar reporter-prompt-for-summary-p) @@ -128,7 +131,7 @@ This includes password cache, file cache, connection cache, buffers." (setq tramp-locked nil) ;; Flush password cache. - (tramp-compat-funcall 'password-reset) + (password-reset) ;; Flush file and connection cache. (clrhash tramp-cache-data) @@ -166,7 +169,6 @@ This includes password cache, file cache, connection cache, buffers." (defun tramp-bug () "Submit a bug report to the Tramp developers." (interactive) - (require 'reporter) (catch 'dont-send (let ((reporter-prompt-for-summary-p t)) (reporter-submit-bug-report @@ -185,7 +187,6 @@ This includes password cache, file cache, connection cache, buffers." backup-by-copying-when-mismatch backup-by-copying-when-privileged-mismatch backup-directory-alist - bkup-backup-directory-info password-cache password-cache-expiry remote-file-name-inhibit-cache @@ -194,8 +195,7 @@ This includes password cache, file cache, connection cache, buffers." 'tramp-load-report-modules ; pre-hook 'tramp-append-tramp-buffers ; post-hook - (tramp-compat-funcall - (if (functionp 'propertize) 'propertize 'progn) + (propertize "\n" 'display "\ Enter your bug report in this message, including as much detail as you possibly can about the problem, what you did to cause it @@ -243,7 +243,7 @@ buffer in your bug report. (base64-encode-string (encode-coding-string val 'raw-text))))))) ;; Dump variable. - (tramp-compat-funcall 'reporter-dump-variable varsym mailbuf) + (reporter-dump-variable varsym mailbuf) (unless (hash-table-p val) ;; Remove string quotation. @@ -264,15 +264,8 @@ buffer in your bug report. (defun tramp-load-report-modules () "Load needed modules for reporting." - ;; We load message.el and mml.el from Gnus. - (if (featurep 'xemacs) - (progn - (load "message" 'noerror) - (load "mml" 'noerror)) - (require 'message nil 'noerror) - (require 'mml nil 'noerror)) - (tramp-compat-funcall 'message-mode) - (tramp-compat-funcall 'mml-mode t)) + (message-mode) + (mml-mode t)) (defun tramp-append-tramp-buffers () "Append Tramp buffers and buffer local variables into the bug report." @@ -303,7 +296,7 @@ buffer in your bug report. ;; Non-tramp variables of interest. '(default-directory)) 'string<)) - (tramp-compat-funcall 'reporter-dump-variable varsym elbuf)) + (reporter-dump-variable varsym elbuf)) (lisp-indent-line) (insert ")\n")) (insert-buffer-substring elbuf))) @@ -313,7 +306,7 @@ buffer in your bug report. (ignore-errors (mapc (lambda (x) (when (string-match "tramp" x) (insert x "\n"))) - (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n"))) + (split-string (list-load-path-shadows t) "\n"))) ;; Append buffers only when we are in message mode. (when (and @@ -322,7 +315,7 @@ buffer in your bug report. (symbol-value 'mml-mode)) (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") - (buffer-list (tramp-compat-funcall 'tramp-list-tramp-buffers)) + (buffer-list (tramp-list-tramp-buffers)) (curbuf (current-buffer))) ;; There is at least one Tramp buffer. @@ -364,13 +357,13 @@ the debug buffer(s).") (kill-buffer nil) (switch-to-buffer curbuf) (goto-char (point-max)) - (insert (tramp-compat-funcall 'propertize "\n" 'display "\n\ + (insert (propertize "\n" 'display "\n\ This is a special notion of the `gnus/message' package. If you use another mail agent (by copying the contents of this buffer) please ensure that the buffers are attached to your email.\n\n")) (dolist (buffer buffer-list) - (tramp-compat-funcall - 'mml-insert-empty-tag 'part 'type "text/plain" + (mml-insert-empty-tag + 'part 'type "text/plain" 'encoding "base64" 'disposition "attachment" 'buffer buffer 'description buffer)) (set-buffer-modified-p nil)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b6d6796255b..f1f31d0398e 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -1,6 +1,6 @@ ;;; tramp-compat.el --- Tramp compatibility functions -;; Copyright (C) 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -23,9 +23,8 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 24. This -;; package provides compatibility functions for Emacs 22, Emacs 23, -;; XEmacs 21.4+ and SXEmacs 22. +;; Tramp's main Emacs version for development is Emacs 25. This +;; package provides compatibility functions for Emacs 23 and Emacs 24. ;;; Code: @@ -33,162 +32,57 @@ (eval-when-compile (require 'cl)) -(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) - (require 'cus-edit) - (require 'env) - (require 'executable) - (require 'outline) - (require 'passwd) - (require 'pp) - (require 'regexp-opt) - (require 'time-date)) - - (require 'advice) - (require 'custom) - (require 'format-spec) - (require 'shell) - - (require 'trampver) - (require 'tramp-loaddefs) - - ;; As long as password.el is not part of (X)Emacs, it shouldn't be - ;; mandatory. - (if (featurep 'xemacs) - (load "password" 'noerror) - (or (require 'password-cache nil 'noerror) - (require 'password nil 'noerror))) ; Part of contrib. - - ;; auth-source is relatively new. - (if (featurep 'xemacs) - (load "auth-source" 'noerror) - (require 'auth-source nil 'noerror)) - - ;; Load the appropriate timer package. - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer)) - - ;; Avoid byte-compiler warnings if the byte-compiler supports this. - ;; Currently, XEmacs supports this. - (when (featurep 'xemacs) - (unless (boundp 'byte-compile-default-warnings) - (defvar byte-compile-default-warnings nil)) - (delq 'unused-vars byte-compile-default-warnings)) - - ;; `last-coding-system-used' is unknown in XEmacs. - (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. - ;; Note that it was removed altogether in Emacs 24.1. - (when (boundp 'directory-sep-char) - (defvar byte-compile-not-obsolete-var nil) - (setq byte-compile-not-obsolete-var 'directory-sep-char) - ;; Emacs 23.2. - (defvar byte-compile-not-obsolete-vars nil) - (setq byte-compile-not-obsolete-vars '(directory-sep-char))) - - ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1. - ;; Besides t, nil, and integer, we use also timestamps (as - ;; returned by `current-time') internally. - (unless (boundp 'remote-file-name-inhibit-cache) - (defvar remote-file-name-inhibit-cache nil)) - - ;; 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)) - - ;; The following functions cannot be aliases of the corresponding - ;; `tramp-handle-*' functions, because this would bypass the locking - ;; mechanism. - - ;; `process-file' does not exist in XEmacs. - (unless (fboundp 'process-file) - (defalias 'process-file - (lambda (program &optional infile buffer display &rest args) - (when (tramp-tramp-file-p default-directory) - (apply - 'tramp-file-name-handler - 'process-file program infile buffer display args))))) - - ;; `start-file-process' is new in Emacs 23. - (unless (fboundp 'start-file-process) - (defalias 'start-file-process - (lambda (name buffer program &rest program-args) - (when (tramp-tramp-file-p default-directory) - (apply - 'tramp-file-name-handler - 'start-file-process name buffer program program-args))))) - - ;; `set-file-times' is also new in Emacs 23. - (unless (fboundp 'set-file-times) - (defalias 'set-file-times - (lambda (filename &optional time) - (when (tramp-tramp-file-p filename) - (tramp-compat-funcall - 'tramp-file-name-handler 'set-file-times filename time))))) - - ;; We currently use "[" and "]" in the filename format for IPv6 - ;; hosts of GNU Emacs. This means that Emacs wants to expand - ;; wildcards if `find-file-wildcards' is non-nil, and then barfs - ;; because no expansion could be found. We detect this situation - ;; and do something really awful: we have `file-expand-wildcards' - ;; 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' has only one argument in XEmacs. - (funcall 'featurep 'files 'remote-wildcards)) - (defadvice file-expand-wildcards +(require 'auth-source) +(require 'advice) +(require 'custom) +(require 'format-spec) +(require 'password-cache) +(require 'shell) +(require 'timer) +(require 'ucs-normalize) + +(require 'trampver) +(require 'tramp-loaddefs) + +;; `remote-file-name-inhibit-cache' has been introduced with Emacs +;; 24.1. Besides t, nil, and integer, we use also timestamps (as +;; returned by `current-time') internally. +(unless (boundp 'remote-file-name-inhibit-cache) + (defvar remote-file-name-inhibit-cache nil)) + +;; 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) + `(when (or (subrp ,function) (functionp ,function)) + (with-no-warnings (funcall ,function ,@arguments)))) + +;; We currently use "[" and "]" in the filename format for IPv6 hosts +;; of GNU Emacs. This means that Emacs wants to expand wildcards if +;; `find-file-wildcards' is non-nil, and then barfs because no +;; expansion could be found. We detect this situation and do +;; something really awful: we have `file-expand-wildcards' 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 (featurep 'files 'remote-wildcards) + (defadvice file-expand-wildcards (around tramp-advice-file-expand-wildcards activate) - (let ((name (ad-get-arg 0))) - ;; If it's a Tramp file, look if wildcards need to be expanded - ;; at all. - (if (and - (tramp-tramp-file-p name) - (not (string-match - "[[*?]" (tramp-compat-funcall - 'file-remote-p name 'localname)))) - (setq ad-return-value (list name)) - ;; Otherwise, just run the original function. - ad-do-it))) - (add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice - 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) - (ad-activate 'file-expand-wildcards)))) - - ;; `redisplay' does not exist in XEmacs. - (unless (fboundp 'redisplay) - (defalias 'redisplay 'ignore))) - -;; `with-temp-message' does not exist in XEmacs. -(if (fboundp 'with-temp-message) - (defalias 'tramp-compat-with-temp-message 'with-temp-message) - (defmacro tramp-compat-with-temp-message (_message &rest body) - "Display MESSAGE temporarily if non-nil while BODY is evaluated." - `(progn ,@body))) + (let ((name (ad-get-arg 0))) + ;; If it's a Tramp file, look if wildcards need to be expanded + ;; at all. + (if (and + (tramp-tramp-file-p name) + (not (string-match "[[*?]" (file-remote-p name 'localname)))) + (setq ad-return-value (list name)) + ;; Otherwise, just run the original function. + ad-do-it))) + (add-hook + 'tramp-unload-hook + (lambda () + (ad-remove-advice + 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) + (ad-activate 'file-expand-wildcards)))) ;; `condition-case-unless-debug' is introduced with Emacs 24. (if (fboundp 'condition-case-unless-debug) @@ -206,105 +100,23 @@ (funcall ,bodysym) ,@handlers)))))) -;; `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-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'." - (let (file-name-handler-alist) - ;; We must return a local directory. If it is remote, we could - ;; run into an infloop. - (cond - ((and (boundp 'temporary-file-directory) - (eval (car (get 'temporary-file-directory 'standard-value))))) - ((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))) - (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"))))) - -;; `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. + "Return name of directory for temporary files. +It is the default value of `temporary-file-directory'." + ;; We must return a local directory. If it is remote, we could run + ;; into an infloop. + (eval (car (get 'temporary-file-directory 'standard-value)))) + (defsubst tramp-compat-make-temp-file (f &optional dir-flag) - "Create a temporary file (compat function). + "Create a local temporary file (compat function). Add the extension of F, if existing." (let* (file-name-handler-alist (prefix (expand-file-name (symbol-value 'tramp-temp-name-prefix) (tramp-compat-temporary-file-directory))) - (extension (file-name-extension f t)) - result) - (condition-case nil - (setq result - (tramp-compat-funcall 'make-temp-file prefix dir-flag extension)) - (error - ;; 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' 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. - (t 134217727))) - -(defun tramp-compat-decimal-to-octal (i) - "Return a string consisting of the octal digits of I. -Not actually used. Use `(format \"%o\" i)' instead?" - (cond ((< i 0) (error "Cannot convert negative number to octal")) - ((not (integerp i)) (error "Cannot convert non-integer to octal")) - ((zerop i) "0") - (t (concat (tramp-compat-decimal-to-octal (/ i 8)) - (number-to-string (% i 8)))))) - -;; Kudos to Gerd Moellmann for this suggestion. -(defun tramp-compat-octal-to-decimal (ostr) - "Given a string of octal digits, return a decimal number." - (let ((x (or ostr ""))) - ;; `save-match' is in `tramp-mode-string-to-int' which calls this. - (unless (string-match "\\`[0-7]*\\'" x) - (error "Non-octal junk in string `%s'" x)) - (string-to-number ostr 8))) - -;; ID-FORMAT does not exist in XEmacs. -(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)) - ((tramp-tramp-file-p filename) - (tramp-compat-funcall - 'tramp-file-name-handler 'file-attributes filename id-format)) - (t (condition-case nil - (tramp-compat-funcall 'file-attributes filename id-format) - (wrong-number-of-arguments (file-attributes filename)))))) - -;; PRESERVE-UID-GID does not exist in XEmacs. + (extension (file-name-extension f t))) + (make-temp-file prefix dir-flag extension))) + ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3. (defun tramp-compat-copy-file @@ -318,21 +130,13 @@ Not actually used. Use `(format \"%o\" i)' instead?" 'copy-file filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) (wrong-number-of-arguments - (tramp-compat-copy-file + (copy-file filename newname ok-if-already-exists keep-date preserve-uid-gid)))) - (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)))) + (copy-file + filename newname ok-if-already-exists keep-date preserve-uid-gid)))) -;; `copy-directory' is a new function in Emacs 23.2. Implementation -;; is taken from there. +;; COPY-CONTENTS has been introduced with Emacs 24.1. (defun tramp-compat-copy-directory (directory newname &optional keep-time parents copy-contents) "Make a copy of DIRECTORY (compat function)." @@ -399,12 +203,10 @@ Not actually used. Use `(format \"%o\" i)' instead?" (cond (trash (tramp-compat-funcall 'delete-directory directory recursive trash)) - (recursive - (tramp-compat-funcall 'delete-directory directory recursive)) (t - (delete-directory directory))) - ;; This Emacs version does not support the RECURSIVE or TRASH flag. We - ;; use the implementation from Emacs 23.2. + (delete-directory directory recursive))) + ;; This Emacs version does not support the TRASH 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)) @@ -416,42 +218,6 @@ 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) - "Return a sequence of numbers from FROM to TO as a list (compat function)." - (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) - (tramp-compat-funcall 'number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - -(defun tramp-compat-split-string (string pattern) - "Like `split-string' but omit empty strings. -In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). -This is, the first, empty, element is omitted. In XEmacs, the first -element is not omitted." - (delete "" (split-string string pattern))) - (defun tramp-compat-process-running-p (process-name) "Returns t if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) @@ -464,7 +230,7 @@ element is not omitted." ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) (let (result) (dolist (pid (tramp-compat-funcall 'list-system-processes) result) - (let ((attributes (tramp-compat-funcall 'process-attributes pid))) + (let ((attributes (process-attributes pid))) (when (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) (let ((comm (cdr (assoc 'comm attributes)))) @@ -474,135 +240,16 @@ element is not omitted." (and comm (string-match (concat "^" (regexp-quote comm)) process-name)))) - (setq result t)))))) - - ;; Fallback, if there is no Lisp support yet. - (t (let ((default-directory - (if (tramp-tramp-file-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory)) - (unix95 (getenv "UNIX95")) - result) - (setenv "UNIX95" "1") - (when (member - (user-login-name) - (tramp-compat-split-string - (shell-command-to-string - (format "ps -C %s -o user=" process-name)) - "[ \f\t\n\r\v]+")) - (setq result t)) - (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))) - -(defun tramp-compat-set-process-query-on-exit-flag (process flag) - "Specify if query is needed for process when Emacs is exited. -If the second argument flag is non-nil, Emacs will query the user before -exiting if process is running." - (if (fboundp 'set-process-query-on-exit-flag) - (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) - (tramp-compat-funcall 'process-kill-without-query process flag))) - -;; There exist different implementations for this function. -(defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) - "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. -EOL-TYPE can be one of `dos', `unix', or `mac'." - (cond ((fboundp 'coding-system-change-eol-conversion) - (tramp-compat-funcall - 'coding-system-change-eol-conversion coding-system eol-type)) - ((fboundp 'subsidiary-coding-system) - (tramp-compat-funcall - 'subsidiary-coding-system coding-system - (cond ((eq eol-type 'dos) 'crlf) - ((eq eol-type 'unix) 'lf) - ((eq eol-type 'mac) 'cr) - (t (error - "Unknown EOL-TYPE `%s', must be `dos', `unix', or `mac'" - eol-type))))) - (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)))))) + (setq result t))))))))) ;; `default-toplevel-value' has been declared in Emacs 24. (unless (fboundp 'default-toplevel-value) (defalias 'default-toplevel-value 'symbol-value)) -;; `format-message' is new in Emacs 25, and does not exist in XEmacs. +;; `format-message' is new in Emacs 25. (unless (fboundp 'format-message) (defalias 'format-message 'format)) -;; `delete-dups' does not exist in XEmacs 21.4. -(if (fboundp 'delete-dups) - (defalias 'tramp-compat-delete-dups 'delete-dups) - (defun tramp-compat-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept." - (tramp-compat-funcall - 'cl-delete-duplicates list '(:test equal :from-end) nil))) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 23646a05fdf..caca3c0cb4c 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -1,6 +1,6 @@ ;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -;; Copyright (C) 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 2002-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -39,15 +39,6 @@ (defvar ange-ftp-name-format) ;; Disable Ange-FTP from file-name-handler-alist. -;; To handle EFS, the following functions need to be dealt with: -;; -;; * dired-before-readin-hook contains efs-dired-before-readin -;; * file-name-handler-alist contains efs-file-handler-function -;; and efs-root-handler-function and efs-sifn-handler-function -;; * find-file-hooks contains efs-set-buffer-mode -;; -;; But it won't happen for EFS since the XEmacs maintainers -;; don't want to use a unified filename syntax. (defun tramp-disable-ange-ftp () "Turn Ange-FTP off. This is useful for unified remoting. See @@ -104,14 +95,15 @@ present for backward compatibility." ;; ... and add it to the method list. ;;;###tramp-autoload -(unless (featurep 'xemacs) - (add-to-list 'tramp-methods (cons tramp-ftp-method nil)) +(add-to-list 'tramp-methods (cons tramp-ftp-method nil)) - ;; Add some defaults for `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist - (list "\\`ftp\\." nil tramp-ftp-method)) - (add-to-list 'tramp-default-method-alist - (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))) +;; Add some defaults for `tramp-default-method-alist'. +;;;###tramp-autoload +(add-to-list 'tramp-default-method-alist + (list "\\`ftp\\." nil tramp-ftp-method)) +;;;###tramp-autoload +(add-to-list 'tramp-default-method-alist + (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) ;; Add completion function for FTP method. ;;;###tramp-autoload @@ -195,9 +187,8 @@ pass to the OPERATION." tramp-ftp-method)) ;;;###tramp-autoload -(unless (featurep 'xemacs) - (add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) +(add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 549d3b15abe..46bf3de098d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1,6 +1,6 @@ ;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon -;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -422,7 +422,6 @@ Every entry is a list (NAME ADDRESS).") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-gvfs-handle-expand-file-name) @@ -474,7 +473,7 @@ Every entry is a list (NAME ADDRESS).") (shell-command . ignore) (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-gvfs-handle-write-region)) @@ -562,8 +561,7 @@ will be traced by Tramp with trace level 6." (put 'with-tramp-dbus-call-method 'lisp-indent-function 2) (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. @@ -623,19 +621,19 @@ file names." (and t2 (not (tramp-gvfs-file-name-p newname)))) ;; We cannot copy or rename directly. + ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with + ;; Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and renamed + ;; in Emacs 24.3. (let ((tmpfile (tramp-compat-make-temp-file filename))) (cond (preserve-extended-attributes - (tramp-compat-funcall + (funcall file-operation filename tmpfile t keep-date preserve-uid-gid preserve-extended-attributes)) - (preserve-uid-gid - (tramp-compat-funcall - file-operation filename tmpfile t keep-date preserve-uid-gid)) (t - (tramp-compat-funcall - file-operation filename tmpfile t keep-date))) + (funcall + file-operation filename tmpfile t keep-date preserve-uid-gid))) (rename-file tmpfile newname ok-if-already-exists)) ;; Direct action. @@ -693,19 +691,18 @@ file names." (tramp-gvfs-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)) - ;; Compat section. + ;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been + ;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and + ;; renamed in Emacs 24.3. (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) (t (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))) (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." @@ -923,7 +920,7 @@ file names." (tramp-error v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) - (copy-file filename tmpfile t t) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) @@ -960,7 +957,7 @@ file names." (when cache-hit (list cache-hit)))) ;; We cannot use a length of 0, because file properties ;; for "foo" and "foo/" are identical. - (tramp-compat-number-sequence (length filename) 1 -1))))) + (number-sequence (length filename) 1 -1))))) ;; Cache expired or no matching cache entry found so we need ;; to perform a remote operation. @@ -1024,9 +1021,9 @@ file names." (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p) (tramp-set-connection-property p "vector" v) - (tramp-compat-process-put p 'events events) - (tramp-compat-process-put p 'watch-name localname) - (tramp-compat-set-process-query-on-exit-flag p nil) + (process-put p 'events events) + (process-put p 'watch-name localname) + (set-process-query-on-exit-flag p nil) (set-process-filter p 'tramp-gvfs-monitor-file-process-filter) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. @@ -1039,7 +1036,7 @@ file names." (defun tramp-gvfs-monitor-file-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ file-notify events." - (let* ((rest-string (tramp-compat-process-get proc 'rest-string)) + (let* ((rest-string (process-get proc 'rest-string)) (dd (with-current-buffer (process-buffer proc) default-directory)) (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) (when rest-string @@ -1047,7 +1044,7 @@ file-notify events." (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (tramp-compat-replace-regexp-in-string + string (replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (when (string-match "Monitoring not supported" string) (delete-process proc)) @@ -1060,7 +1057,7 @@ file-notify events." string) (let ((file (match-string 1 string)) (action (intern-soft - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "_" "-" (downcase (match-string 2 string)))))) (setq string (replace-match "" nil nil string)) ;; File names are returned as URL paths. We must convert them. @@ -1079,12 +1076,12 @@ file-notify events." ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (tramp-compat-process-put proc 'rest-string string))) + (process-put proc 'rest-string string))) (defun tramp-gvfs-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-executable-p" + (with-tramp-file-property v localname "file-readable-p" (tramp-check-cached-permissions v ?r)))) (defun tramp-gvfs-handle-file-writable-p (filename) @@ -1125,7 +1122,8 @@ file-notify events." (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) (tramp-gvfs-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) + 'rename filename newname ok-if-already-exists + 'keep-date 'preserve-uid-gid) (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) @@ -1133,8 +1131,7 @@ file-notify events." (start end filename &optional append visit lockname confirm) "Like `write-region' for Tramp files." (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) @@ -1203,8 +1200,7 @@ file-notify events." (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (tramp-compat-replace-regexp-in-string - "^.*/\\([^/]+\\)$" "\\1" object-path))) + (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) (defun tramp-bluez-address (device) "Return bluetooth device address from a given bluetooth DEVICE name." @@ -1293,7 +1289,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." ;; host signature. (with-temp-buffer ;; Preserve message for `progress-reporter'. - (tramp-compat-with-temp-message "" + (with-temp-message "" (insert message) (pop-to-buffer (current-buffer)) (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) @@ -1533,7 +1529,7 @@ connection if a previous connection has died for some reason." :name (tramp-buffer-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t))) - (tramp-compat-set-process-query-on-exit-flag p nil))) + (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) (let* ((method (tramp-file-name-method vec)) @@ -1751,7 +1747,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." 'split-string (shell-command-to-string (format "avahi-browse -trkp %s" service)) "[\n\r]+" 'omit "^\\+;.*$")))) - (tramp-compat-delete-dups + (delete-dups (mapcar (lambda (x) (let* ((list (split-string x ";")) diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index 5e22f6a3b59..a1ddceb4682 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -1,6 +1,6 @@ ;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways -;; Copyright (C) 2007-2015 Free Software Foundation, Inc. +;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -108,7 +108,7 @@ tramp-gw-vector 4 "Opening auxiliary process `%s', speaking with process `%s'" proc tramp-gw-gw-proc) - (tramp-compat-set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag proc nil) ;; We don't want debug messages, because the corresponding debug ;; buffer might be undecided. (let ((tramp-verbose 0)) @@ -158,7 +158,7 @@ instead of the host name declared in TARGET-VEC." :name (tramp-buffer-name aux-vec) :buffer nil :host 'local :server t :noquery t :service t :coding 'binary)) (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-aux-proc nil) + (set-process-query-on-exit-flag tramp-gw-aux-proc nil) (tramp-message vec 4 "Opening auxiliary process `%s', listening on port %d" tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service)))) @@ -204,7 +204,7 @@ instead of the host name declared in TARGET-VEC." (tramp-file-name-port target-vec))) (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel) (set-process-coding-system tramp-gw-gw-proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil) + (set-process-query-on-exit-flag tramp-gw-gw-proc nil) (tramp-message vec 4 "Opened %s process `%s'" (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS")) @@ -235,14 +235,14 @@ authentication is requested from proxy server, provide it." (setq proc (open-network-stream name buffer (nth 1 socks-server) (nth 2 socks-server))) (set-process-coding-system proc 'binary 'binary) - (tramp-compat-set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag proc nil) ;; Send CONNECT command. (process-send-string proc (format "%s%s\r\n" command authentication)) (tramp-message tramp-gw-vector 6 "\n%s" (format "%s%s\r\n" command - (tramp-compat-replace-regexp-in-string ;; no password in trace! + (replace-regexp-in-string ;; no password in trace! "Basic [^\r\n]+" "Basic xxxxx" authentication t))) (with-current-buffer buffer ;; Trap errors to be traced in the right trace buffer. Often, diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 0dd2440e5e0..baebb13dd22 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1,6 +1,6 @@ ;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; (copyright statements below in code to be updated with the above notice) @@ -32,7 +32,6 @@ (eval-when-compile (require 'cl) (require 'dired)) -(defvar directory-sep-char) (defvar tramp-gw-tunnel-method) (defvar tramp-gw-socks-method) (defvar vc-handled-backends) @@ -285,6 +284,15 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) ;;;###tramp-autoload +(add-to-list + 'tramp-methods + '("sg" + (tramp-login-program "sg") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) +;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" (tramp-login-program "sudo") @@ -380,9 +388,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t))) + ("-q"))) + (tramp-copy-keep-date t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("fcp" @@ -447,12 +454,17 @@ The string is used in `tramp-methods'.") "Default list of (FUNCTION FILE) pairs to be examined for su methods.") ;;;###tramp-autoload +(defconst tramp-completion-function-alist-sg + '((tramp-parse-etc-group "/etc/group")) + "Default list of (FUNCTION FILE) pairs to be examined for sg methods.") + +;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty ,(if (memq system-type '(windows-nt)) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) - "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") + "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") ;;;###tramp-autoload (eval-after-load 'tramp @@ -472,6 +484,7 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "su" tramp-completion-function-alist-su) (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) + (tramp-set-completion-function "sg" tramp-completion-function-alist-sg) (tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) @@ -790,7 +803,7 @@ on the remote host.") (defconst tramp-perl-encode "%s -e ' # This script contributed by Juanma Barranquero <lektu@terra.es>. -# Copyright (C) 2002-2015 Free Software Foundation, Inc. +# Copyright (C) 2002-2016 Free Software Foundation, Inc. use strict; my %%trans = do { @@ -828,7 +841,7 @@ This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-decode "%s -e ' # This script contributed by Juanma Barranquero <lektu@terra.es>. -# Copyright (C) 2002-2015 Free Software Foundation, Inc. +# Copyright (C) 2002-2016 Free Software Foundation, Inc. use strict; my %%trans = do { @@ -986,10 +999,7 @@ of command line.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-sh-handle-directory-files-and-attributes) - ;; `dired-call-process' performed by default handler. (dired-compress-file . tramp-sh-handle-dired-compress-file) - (dired-recursive-delete-directory - . tramp-sh-handle-dired-recursive-delete-directory) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-sh-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) @@ -1025,8 +1035,6 @@ of command line.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) - (insert-file-contents-literally - . tramp-sh-handle-insert-file-contents-literally) (load . tramp-handle-load) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) @@ -1041,7 +1049,7 @@ of command line.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-sh-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (unhandled-file-name-directory . ignore) (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (write-region . tramp-sh-handle-write-region)) @@ -1100,15 +1108,19 @@ target of the symlink differ." ;; Right, they are on the same host, regardless of user, method, ;; etc. We now make the link on the remote machine. This will ;; occur as the user that FILENAME belongs to. - (tramp-send-command-and-check - l - (format - "cd %s && %s -sf %s %s" - (tramp-shell-quote-argument cwd) - ln - (tramp-shell-quote-argument filename) - (tramp-shell-quote-argument l-localname)) - t)))) + (and (tramp-send-command-and-check + l (format "cd %s" (tramp-shell-quote-argument cwd))) + (tramp-send-command-and-check + l (format + "%s -sf %s %s" + ln + (tramp-shell-quote-argument filename) + ;; The command could exceed PATH_MAX, so we use + ;; relative file names. However, relative file names + ;; could start with "-". `tramp-shell-quote-argument' + ;; does not handle this, we must do it ourselves. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory l-localname))))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." @@ -1144,10 +1156,8 @@ target of the symlink differ." (format "tramp_perl_file_truename %s" (tramp-shell-quote-argument localname))))) - ;; Do it yourself. We bind `directory-sep-char' here for - ;; XEmacs on Windows, which would otherwise use backslash. - (t (let ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) + ;; Do it yourself. + (t (let ((steps (split-string localname "/" 'omit)) (thisstep nil) (numchase 0) ;; Don't make the following value larger than @@ -1196,9 +1206,8 @@ target of the symlink differ." symlink-target)) (setq symlink-target localname)) (setq steps - (append (tramp-compat-split-string - symlink-target "/") - steps))) + (append + (split-string symlink-target "/" 'omit) steps))) (t ;; It's a file. (setq result (cons thisstep result))))) @@ -1266,100 +1275,107 @@ target of the symlink differ." res-inode res-filemodes res-numlinks res-uid res-gid res-size res-symlink-target) (tramp-message vec 5 "file attributes with ls: %s" localname) - (tramp-send-command - vec - (format "(%s %s || %s -h %s) && %s %s %s %s" - (tramp-get-file-exists-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-test-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-ls-command vec) - (if (eq id-format 'integer) "-ildn" "-ild") - ;; On systems which have no quoting style, file names - ;; with special characters could fail. - (cond - ((tramp-get-ls-command-with-quoting-style vec) - "--quoting-style=c") - ((tramp-get-ls-command-with-w-option vec) - "-w") - (t "")) - (tramp-shell-quote-argument localname))) - ;; Parse `ls -l' output ... - (with-current-buffer (tramp-get-buffer vec) - (when (> (buffer-size) 0) - (goto-char (point-min)) - ;; ... inode - (setq res-inode - (condition-case err - (read (current-buffer)) - (invalid-read-syntax - (when (and (equal (cadr err) - "Integer constant overflow in reader") - (string-match - "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" - (car (cddr err)))) - (let* ((big (read (substring (car (cddr err)) 0 - (match-beginning 1)))) - (small (read (match-string 1 (car (cddr err))))) - (twiddle (/ small 65536))) - (cons (+ big twiddle) - (- small (* twiddle 65536)))))))) - ;; ... file mode flags - (setq res-filemodes (symbol-name (read (current-buffer)))) - ;; ... number links - (setq res-numlinks (read (current-buffer))) - ;; ... uid and gid - (setq res-uid (read (current-buffer))) - (setq res-gid (read (current-buffer))) - (if (eq id-format 'integer) + ;; We cannot send all three commands combined, it could exceed + ;; NAME_MAX or PATH_MAX. Happened on Mac OS X, for example. + (when (or (tramp-send-command-and-check + vec + (format "%s %s" + (tramp-get-file-exists-command vec) + (tramp-shell-quote-argument localname))) + (tramp-send-command-and-check + vec + (format "%s -h %s" + (tramp-get-test-command vec) + (tramp-shell-quote-argument localname)))) + (tramp-send-command + vec + (format "%s %s %s %s" + (tramp-get-ls-command vec) + (if (eq id-format 'integer) "-ildn" "-ild") + ;; On systems which have no quoting style, file names + ;; with special characters could fail. + (cond + ((tramp-get-ls-command-with-quoting-style vec) + "--quoting-style=c") + ((tramp-get-ls-command-with-w-option vec) + "-w") + (t "")) + (tramp-shell-quote-argument localname))) + ;; Parse `ls -l' output ... + (with-current-buffer (tramp-get-buffer vec) + (when (> (buffer-size) 0) + (goto-char (point-min)) + ;; ... inode + (setq res-inode + (condition-case err + (read (current-buffer)) + (invalid-read-syntax + (when (and (equal (cadr err) + "Integer constant overflow in reader") + (string-match + "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" + (car (cddr err)))) + (let* ((big (read (substring (car (cddr err)) 0 + (match-beginning 1)))) + (small (read (match-string 1 (car (cddr err))))) + (twiddle (/ small 65536))) + (cons (+ big twiddle) + (- small (* twiddle 65536)))))))) + ;; ... file mode flags + (setq res-filemodes (symbol-name (read (current-buffer)))) + ;; ... number links + (setq res-numlinks (read (current-buffer))) + ;; ... uid and gid + (setq res-uid (read (current-buffer))) + (setq res-gid (read (current-buffer))) + (if (eq id-format 'integer) + (progn + (unless (numberp res-uid) (setq res-uid -1)) + (unless (numberp res-gid) (setq res-gid -1))) (progn - (unless (numberp res-uid) (setq res-uid -1)) - (unless (numberp res-gid) (setq res-gid -1))) - (progn - (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) - (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) - ;; ... size - (setq res-size (read (current-buffer))) - ;; From the file modes, figure out other stuff. - (setq symlinkp (eq ?l (aref res-filemodes 0))) - (setq dirp (eq ?d (aref res-filemodes 0))) - ;; If symlink, find out file name pointed to. - (when symlinkp - (search-forward "-> ") - (setq res-symlink-target - (if (tramp-get-ls-command-with-quoting-style vec) - (read (current-buffer)) - (buffer-substring (point) (point-at-eol))))) - ;; Return data gathered. - (list - ;; 0. t for directory, string (name linked to) for symbolic - ;; link, or nil. - (or dirp res-symlink-target) - ;; 1. Number of links to file. - res-numlinks - ;; 2. File uid. - res-uid - ;; 3. File gid. - res-gid - ;; 4. Last access time, as a list of integers. Normally this - ;; would be in the same format as `current-time', but the - ;; subseconds part is not currently implemented, and (0 0) - ;; denotes an unknown time. - ;; 5. Last modification time, likewise. - ;; 6. Last status change time, likewise. - '(0 0) '(0 0) '(0 0) ;CCC how to find out? - ;; 7. Size in bytes (-1, if number is out of range). - res-size - ;; 8. File modes, as a string of ten letters or dashes as in ls -l. - res-filemodes - ;; 9. t if file's gid would change if file were deleted and - ;; recreated. Will be set in `tramp-convert-file-attributes'. - t - ;; 10. Inode number. - res-inode - ;; 11. Device number. Will be replaced by a virtual device number. - -1 - ))))) + (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) + (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) + ;; ... size + (setq res-size (read (current-buffer))) + ;; From the file modes, figure out other stuff. + (setq symlinkp (eq ?l (aref res-filemodes 0))) + (setq dirp (eq ?d (aref res-filemodes 0))) + ;; If symlink, find out file name pointed to. + (when symlinkp + (search-forward "-> ") + (setq res-symlink-target + (if (tramp-get-ls-command-with-quoting-style vec) + (read (current-buffer)) + (buffer-substring (point) (point-at-eol))))) + ;; Return data gathered. + (list + ;; 0. t for directory, string (name linked to) for symbolic + ;; link, or nil. + (or dirp res-symlink-target) + ;; 1. Number of links to file. + res-numlinks + ;; 2. File uid. + res-uid + ;; 3. File gid. + res-gid + ;; 4. Last access time, as a list of integers. Normally + ;; this would be in the same format as `current-time', but + ;; the subseconds part is not currently implemented, and + ;; (0 0) denotes an unknown time. + ;; 5. Last modification time, likewise. + ;; 6. Last status change time, likewise. + '(0 0) '(0 0) '(0 0) ;CCC how to find out? + ;; 7. Size in bytes (-1, if number is out of range). + res-size + ;; 8. File modes, as a string of ten letters or dashes as in ls -l. + res-filemodes + ;; 9. t if file's gid would change if file were deleted and + ;; recreated. Will be set in `tramp-convert-file-attributes'. + t + ;; 10. Inode number. + res-inode + ;; 11. Device number. Will be replaced by a virtual device number. + -1)))))) (defun tramp-do-file-attributes-with-perl (vec localname &optional id-format) @@ -1416,8 +1432,7 @@ target of the symlink differ." (attr (file-attributes f)) ;; '(-1 65535) means file doesn't exists yet. (modtime (or (nth 5 attr) '(-1 65535)))) - (when (boundp 'last-coding-system-used) - (setq coding-system-used (symbol-value 'last-coding-system-used))) + (setq coding-system-used last-coding-system-used) ;; We use '(0 0) as a don't-know value. See also ;; `tramp-do-file-attributes-with-ls'. (if (not (equal modtime '(0 0))) @@ -1431,8 +1446,7 @@ target of the symlink differ." (setq attr (buffer-substring (point) (point-at-eol)))) (tramp-set-file-property v localname "visited-file-modtime-ild" attr)) - (when (boundp 'last-coding-system-used) - (set 'last-coding-system-used coding-system-used)) + (setq last-coding-system-used coding-system-used) nil))))) ;; This function makes the same assumption as @@ -1451,7 +1465,7 @@ of." ;; connection. (if (or (not f) (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) @@ -1496,48 +1510,26 @@ of." ;; FIXME: extract the proper text from chmod's stderr. (tramp-barf-unless-okay v - (format "chmod %s %s" - (tramp-compat-decimal-to-octal mode) - (tramp-shell-quote-argument localname)) + (format "chmod %o %s" mode (tramp-shell-quote-argument localname)) "Error while changing file's mode %s" filename))) (defun tramp-sh-handle-set-file-times (filename &optional time) "Like `set-file-times' for Tramp files." - (if (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (when (tramp-get-remote-touch v) - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (let ((time (if (or (null time) (equal time '(0 0))) - (current-time) - time)) - ;; With GNU Emacs, `format-time-string' has an - ;; optional parameter UNIVERSAL. This is preferred, - ;; because we could handle the case when the remote - ;; host is located in a different time zone as the - ;; local host. - (utc (not (featurep 'xemacs)))) - (tramp-send-command-and-check - v (format - "%s %s %s %s" - (if utc "env TZ=UTC" "") - (tramp-get-remote-touch v) - (if (tramp-get-connection-property v "touch-t" nil) - (format "-t %s" - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time))) - "") - (tramp-shell-quote-argument localname)))))) - - ;; We handle also the local part, because in older Emacsen, - ;; without `set-file-times', this function is an alias for this. - ;; We are local, so we don't need the UTC settings. - (zerop - (tramp-call-process - nil "touch" nil nil nil "-t" - (format-time-string "%Y%m%d%H%M.%S" time) - (tramp-shell-quote-argument filename))))) + (with-parsed-tramp-file-name filename nil + (when (tramp-get-remote-touch v) + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time))) + (tramp-send-command-and-check + v (format + "env TZ=UTC %s %s %s" + (tramp-get-remote-touch v) + (if (tramp-get-connection-property v "touch-t" nil) + (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t)) + "") + (tramp-shell-quote-argument localname))))))) (defun tramp-set-file-uid-gid (filename &optional uid gid) "Set the ownership for FILENAME. @@ -1641,8 +1633,7 @@ be non-negative integers." (goto-char (point-max)) (delete-blank-lines) (when (> (point-max) (point-min)) - (tramp-compat-funcall - 'substring-no-properties (buffer-string)))))))) + (substring-no-properties (buffer-string)))))))) (defun tramp-sh-handle-set-file-acl (filename acl-string) "Like `set-file-acl' for Tramp files." @@ -1893,7 +1884,7 @@ be non-negative integers." (when cache-hit (list cache-hit)))) ;; We cannot use a length of 0, because file properties ;; for "foo" and "foo/" are identical. - (tramp-compat-number-sequence (length filename) 1 -1))))) + (number-sequence (length filename) 1 -1))))) ;; Cache expired or no matching cache entry found so we need ;; to perform a remote operation. @@ -1916,14 +1907,7 @@ be non-negative integers." (format "tramp_perl_file_name_all_completions %s %s %d" (tramp-shell-quote-argument localname) (tramp-shell-quote-argument filename) - (if (symbol-value - ;; `read-file-name-completion-ignore-case' - ;; is introduced with Emacs 22.1. - (if (boundp - 'read-file-name-completion-ignore-case) - 'read-file-name-completion-ignore-case - 'completion-ignore-case)) - 1 0))) + (if read-file-name-completion-ignore-case 1 0))) (format (concat "(cd %s 2>&1 && (%s -a %s 2>/dev/null" @@ -2046,19 +2030,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)) - ;; Compat section. + ;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been + ;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and + ;; renamed in Emacs 24.3. (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) (t (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))) (defun tramp-sh-handle-copy-directory (dirname newname &optional keep-date parents copy-contents) @@ -2113,7 +2096,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) (tramp-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) + 'rename filename newname ok-if-already-exists + 'keep-time 'preserve-uid-gid) (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) @@ -2279,11 +2263,11 @@ the uid and gid from FILENAME." op)))) (localname1 (if t1 - (tramp-file-name-handler 'file-remote-p filename 'localname) + (file-remote-p filename 'localname) filename)) (localname2 (if t2 - (tramp-file-name-handler 'file-remote-p newname 'localname) + (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -2321,12 +2305,12 @@ the uid and gid from FILENAME." (zerop (logand (file-modes (file-name-directory localname1)) - (tramp-compat-octal-to-decimal "1000")))) + (string-to-number "1000" 8)))) (file-writable-p (file-name-directory localname2)) (or (file-directory-p localname2) (file-writable-p localname2)))) (if (eq op 'copy) - (tramp-compat-copy-file + (copy-file localname1 localname2 ok-if-already-exists keep-date preserve-uid-gid) (tramp-run-real-handler @@ -2366,15 +2350,14 @@ the uid and gid from FILENAME." ;; Since this does not work reliable, we also ;; give read permissions. (set-file-modes - (concat prefix tmpfile) - (tramp-compat-octal-to-decimal "0777")) + (concat prefix tmpfile) (string-to-number "0777" 8)) (tramp-set-file-uid-gid (concat prefix tmpfile) (tramp-get-local-uid 'integer) (tramp-get-local-gid 'integer))) (t2 (if (eq op 'copy) - (tramp-compat-copy-file + (copy-file localname1 tmpfile t keep-date preserve-uid-gid) (tramp-run-real-handler @@ -2383,8 +2366,7 @@ the uid and gid from FILENAME." ;; We must change the ownership as local user. ;; Since this does not work reliable, we also ;; give read permissions. - (set-file-modes - tmpfile (tramp-compat-octal-to-decimal "0777")) + (set-file-modes tmpfile (string-to-number "0777" 8)) (tramp-set-file-uid-gid tmpfile (tramp-get-remote-uid v 'integer) @@ -2443,7 +2425,7 @@ The method used must be an out-of-band method." ;; Save exit. (ignore-errors (if dir-flag - (tramp-compat-delete-directory + (delete-directory (expand-file-name ".." tmpfile) 'recursive) (delete-file tmpfile))))) @@ -2616,7 +2598,7 @@ The method used must be an out-of-band method." orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" orig-vec) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; We must adapt `tramp-local-end-of-line' for ;; sending the password. @@ -2664,7 +2646,7 @@ The method used must be an out-of-band method." (unless (eq op 'copy) (if (file-regular-p filename) (delete-file filename) - (tramp-compat-delete-directory filename 'recursive)))))) + (delete-directory filename 'recursive)))))) (defun tramp-sh-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -2704,51 +2686,16 @@ The method used must be an out-of-band method." ;; Dired. -;; CCC: This does not seem to be enough. Something dies when -;; we try and delete two directories under Tramp :/ -(defun tramp-sh-handle-dired-recursive-delete-directory (filename) - "Recursively delete the directory given. -This is like `dired-recursive-delete-directory' for Tramp files." - (with-parsed-tramp-file-name filename nil - ;; Run a shell command 'rm -r <localname>'. - ;; Code shamelessly stolen from the dired implementation and, um, hacked :) - (unless (file-exists-p filename) - (tramp-error v 'file-error "No such directory: %s" filename)) - ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>). - (tramp-send-command - v - (format "rm -rf %s" (tramp-shell-quote-argument localname)) - ;; Don't read the output, do it explicitly. - nil t) - ;; Wait for the remote system to return to us... - ;; This might take a while, allow it plenty of time. - (tramp-wait-for-output (tramp-get-connection-process v) 120) - ;; Make sure that it worked... - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) - (and (file-exists-p filename) - (tramp-error - v 'file-error "Failed to recursively delete %s" filename)))) +(defvar dired-compress-file-suffixes) +(declare-function dired-remove-file "dired-aux") -(defun tramp-sh-handle-dired-compress-file (file &rest _ok-flag) +(defun tramp-sh-handle-dired-compress-file (file) "Like `dired-compress-file' for Tramp files." - ;; OK-FLAG is valid for XEmacs only, but not implemented. ;; Code stolen mainly from dired-aux.el. (with-parsed-tramp-file-name file nil (tramp-flush-file-property v localname) (save-excursion - (let ((suffixes - (if (not (featurep 'xemacs)) - ;; Emacs case - (symbol-value 'dired-compress-file-suffixes) - ;; XEmacs has `dired-compression-method-alist', which is - ;; transformed into `dired-compress-file-suffixes' structure. - (mapcar - (lambda (x) - (list (concat (regexp-quote (nth 1 x)) "\\'") - nil - (mapconcat 'identity (nth 3 x) " "))) - (symbol-value 'dired-compression-method-alist)))) + (let ((suffixes dired-compress-file-suffixes) suffix) ;; See if any suffix rule matches this file name. (while suffixes @@ -2766,8 +2713,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat (nth 2 suffix) " " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (string-match (car suffix) file) (concat (substring file 0 (match-beginning 0)))))) (t @@ -2777,8 +2723,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat "gzip -f " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (cond ((file-exists-p (concat file ".gz")) (concat file ".gz")) ((file-exists-p (concat file ".z")) @@ -2888,9 +2833,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; Decode the output, it could be multibyte. (decode-coding-region beg (point-max) - (or file-name-coding-system - (and (boundp 'default-file-name-coding-system) - (symbol-value 'default-file-name-coding-system)))) + (or file-name-coding-system default-file-name-coding-system)) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) @@ -2953,13 +2896,10 @@ the result will be a local, non-Tramp, file name." (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). We bind - ;; `directory-sep-char' here for XEmacs on Windows, which would - ;; otherwise use backslash. `default-directory' is bound, - ;; because on Windows there would be problems with UNC shares or - ;; Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter @@ -3081,7 +3021,7 @@ the result will be a local, non-Tramp, file name." ;; Send the command. (tramp-send-command v command nil t) ; nooutput ;; Check, whether a pty is associated. - (unless (tramp-compat-process-get + (unless (process-get (tramp-get-connection-process v) 'remote-tty) (tramp-error v 'file-error @@ -3091,7 +3031,7 @@ the result will be a local, non-Tramp, file name." ;; process. We ignore errors, because the process ;; could have finished already. (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t) + (set-process-query-on-exit-flag p t) (set-marker (process-mark p) (point))) ;; Return process. p)))) @@ -3215,12 +3155,7 @@ the result will be a local, non-Tramp, file name." ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -3246,7 +3181,7 @@ the result will be a local, non-Tramp, file name." ;; `copy-file' handles direct copy and out-of-band methods. ((or (tramp-local-host-p v) (tramp-method-out-of-band-p v size)) - (copy-file filename tmpfile t t)) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)) ;; Use inline encoding for file transfer. (rem-enc @@ -3307,30 +3242,6 @@ the result will be a local, non-Tramp, file name." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) -;; This is needed for XEmacs only. Code stolen from files.el. -(defun tramp-sh-handle-insert-file-contents-literally - (filename &optional visit beg end replace) - "Like `insert-file-contents-literally' for Tramp files." - (let ((format-alist nil) - (after-insert-file-functions nil) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil)) - (inhibit-file-name-handlers - '(epa-file-handler image-file-handler jka-compr-handler)) - (inhibit-file-name-operation 'insert-file-contents)) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (_filename) t)) - (insert-file-contents filename visit beg end replace)) - ;; Save exit. - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - ;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname confirm) @@ -3347,14 +3258,13 @@ the result will be a local, non-Tramp, file name." ;; (error ;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME")) - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) - (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer)) + (let ((uid (or (nth 2 (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) - (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer)) + (gid (or (nth 3 (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) (if (and (tramp-local-host-p v) @@ -3412,9 +3322,7 @@ the result will be a local, non-Tramp, file name." (signal (car err) (cdr err)))) ;; Now, `last-coding-system-used' has the right value. Remember it. - (when (boundp 'last-coding-system-used) - (setq coding-system-used - (symbol-value 'last-coding-system-used)))) + (setq coding-system-used last-coding-system-used)) ;; The permissions of the temporary file should be set. If ;; FILENAME does not exist (eq modes nil) it has been @@ -3424,7 +3332,7 @@ the result will be a local, non-Tramp, file name." (when modes (set-file-modes tmpfile - (logior (or modes 0) (tramp-compat-octal-to-decimal "0400")))) + (logior (or modes 0) (string-to-number "0400" 8)))) ;; This is a bit lengthy due to the different methods ;; possible for file transfer. First, we check whether the @@ -3564,7 +3472,7 @@ the result will be a local, non-Tramp, file name." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq visit t) (stringp visit)) - (let ((file-attr (tramp-compat-file-attributes filename 'integer))) + (let ((file-attr (file-attributes filename 'integer))) (set-visited-file-modtime ;; We must pass modtime explicitly, because FILENAME can ;; be different from (buffer-file-name), f.e. if @@ -3599,7 +3507,7 @@ the result will be a local, non-Tramp, file name." ;; any other remote command. (defun tramp-sh-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - (tramp-compat-with-temp-message "" + (with-temp-message "" (with-parsed-tramp-file-name file nil (with-tramp-progress-reporter v 3 (format-message "Checking `vc-registered' for %s" file) @@ -3778,9 +3686,9 @@ Fall back to normal file name handler if no Tramp handler exists." (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p) (tramp-set-connection-property p "vector" v) ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'. - (tramp-compat-process-put p 'events events) - (tramp-compat-process-put p 'watch-name localname) - (tramp-compat-set-process-query-on-exit-flag p nil) + (process-put p 'events events) + (process-put p 'watch-name localname) + (set-process-query-on-exit-flag p nil) (set-process-filter p filter) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. @@ -3796,13 +3704,13 @@ file-notify events." (let ((remote-prefix (with-current-buffer (process-buffer proc) (file-remote-p default-directory))) - (rest-string (tramp-compat-process-get proc 'rest-string))) + (rest-string (process-get proc 'rest-string))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (tramp-compat-replace-regexp-in-string + string (replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (when (string-match "Monitoring not supported" string) (delete-process proc)) @@ -3820,7 +3728,7 @@ file-notify events." (list proc (intern-soft - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "_" "-" (downcase (match-string 4 string)))) ;; File names are returned as absolute paths. We must ;; add the remote prefix. @@ -3829,24 +3737,23 @@ file-notify events." (setq string (replace-match "" nil nil string)) ;; Remove watch when file or directory to be watched is deleted. (when (and (member (cadr object) '(moved deleted)) - (string-equal - file (tramp-compat-process-get proc 'watch-name))) + (string-equal file (process-get proc 'watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at ;; once. Therefore, we apply the callback directly. - (when (member (cadr object) (tramp-compat-process-get proc 'events)) + (when (member (cadr object) (process-get proc 'events)) (tramp-compat-funcall 'file-notify-callback object)))) ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (tramp-compat-process-put proc 'rest-string string))) + (process-put proc 'rest-string string))) (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding file-notify events." (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit-nulls)) + (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. (unless (string-match @@ -3862,8 +3769,8 @@ file-notify events." (mapcar (lambda (x) (intern-soft - (tramp-compat-replace-regexp-in-string "_" "-" (downcase x)))) - (split-string (match-string 1 line) "," 'omit-nulls)) + (replace-regexp-in-string "_" "-" (downcase x)))) + (split-string (match-string 1 line) "," 'omit)) (match-string 3 line)))) ;; Remove watch when file or directory to be watched is deleted. (when (equal (cadr object) 'ignored) @@ -3887,7 +3794,7 @@ Only send the definition if it has not already been done." vec 5 (format-message "Sending script `%s'" name) ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names' ;; could result in unwanted command expansion. Avoid this. - (setq script (tramp-compat-replace-regexp-in-string + (setq script (replace-regexp-in-string (make-string 1 ?\t) (make-string 8 ? ) script)) ;; The script could contain a call of Perl. This is masked with `%s'. (when (and (string-match "%s" script) @@ -3960,8 +3867,7 @@ This function expects to be in the right *tramp* buffer." (setq result (concat "\\" progname)))) (unless result (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. In XEmacs, - ;; `remove' is in CL, and we want to avoid CL dependencies. + ;; Remove all ~/foo directories from dirlist. (let (newdl d) (while dirlist (setq d (car dirlist)) @@ -4210,16 +4116,14 @@ process to set up. VEC specifies the connection." (let ((cs (or (and (memq 'utf-8 (coding-system-list)) (string-match "utf-?8" (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) - (tramp-compat-funcall 'process-coding-system proc) + (process-coding-system proc) (cons 'undecided 'undecided))) cs-decode cs-encode) (when (symbolp cs) (setq cs (cons cs cs))) - (setq cs-decode (car cs)) - (setq cs-encode (cdr cs)) - (unless cs-decode (setq cs-decode 'undecided)) - (unless cs-encode (setq cs-encode 'undecided)) + (setq cs-decode (or (car cs) 'undecided) + cs-encode (or (cdr cs) 'undecided)) (setq cs-encode - (tramp-compat-coding-system-change-eol-conversion + (coding-system-change-eol-conversion cs-encode (if (string-match "^Darwin" (tramp-get-connection-property vec "uname" "")) @@ -4227,10 +4131,15 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "echo foo ; echo bar" t) (goto-char (point-min)) (when (search-forward "\r" nil t) - (setq cs-decode (tramp-compat-coding-system-change-eol-conversion + (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) - (tramp-compat-funcall - 'set-buffer-process-coding-system cs-decode cs-encode) + ;; Special setting for Mac OS X. + (when (and (string-match + "^Darwin" (tramp-get-connection-property vec "uname" "")) + (memq 'utf-8-hfs (coding-system-list))) + (setq cs-decode 'utf-8-hfs + cs-encode 'utf-8-hfs)) + (set-buffer-process-coding-system cs-decode cs-encode) (tramp-message vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)) ;; Look for ^M and do something useful if found. @@ -4295,7 +4204,7 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) - (tramp-compat-process-put proc 'remote-tty tty))) + (process-put proc 'remote-tty tty))) ;; Dump stty settings in the traces. (when (>= tramp-verbose 9) @@ -4308,7 +4217,7 @@ process to set up. VEC specifies the connection." (copy-sequence tramp-remote-process-environment))) unset vars item) (while env - (setq item (tramp-compat-split-string (car env) "=")) + (setq item (split-string (car env) "=" 'omit)) (setcdr item (mapconcat 'identity (cdr item) "=")) (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) (push (format "%s %s" (car item) (cdr item)) vars) @@ -4498,8 +4407,7 @@ Goes through the list `tramp-local-coding-commands' and value (format-spec-make ?t - (tramp-file-name-handler - 'file-remote-p tmpfile 'localname))))) + (file-remote-p tmpfile 'localname))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -4695,7 +4603,7 @@ Gateway hops are already opened." (push (vector (tramp-file-name-method hop) (tramp-file-name-user hop) - (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil) + (tramp-gw-open-connection vec gw hop) nil nil) target-alist) ;; For the password prompt, we need the correct values. ;; Therefore, we must remember the gateway vector. But we @@ -4829,6 +4737,7 @@ connection if a previous connection has died for some reason." (unless (and p (processp p) (memq (process-status p) '(run open))) ;; If `non-essential' is non-nil, don't reopen a new connection. + ;; This variable has been introduced with Emacs 24.1. (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) @@ -4881,7 +4790,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. (tramp-set-connection-property p "vector" vec) (set-process-sentinel p 'tramp-process-sentinel) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) @@ -5177,12 +5086,12 @@ Return ATTR." (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) (setcar (nthcdr 2 attr) -1)) (when (and (floatp (nth 2 attr)) - (<= (nth 2 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 2 attr) most-positive-fixnum)) (setcar (nthcdr 2 attr) (round (nth 2 attr)))) (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) (setcar (nthcdr 3 attr) -1)) (when (and (floatp (nth 3 attr)) - (<= (nth 3 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 3 attr) most-positive-fixnum)) (setcar (nthcdr 3 attr) (round (nth 3 attr)))) ;; Convert last access time. (unless (listp (nth 4 attr)) @@ -5203,7 +5112,7 @@ Return ATTR." (when (< (nth 7 attr) 0) (setcar (nthcdr 7 attr) -1)) (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 7 attr) most-positive-fixnum)) (setcar (nthcdr 7 attr) (round (nth 7 attr)))) ;; Convert file mode bits to string. (unless (stringp (nth 8 attr)) @@ -5335,7 +5244,7 @@ Return ATTR." (when elt1 (setcdr elt1 (append - (tramp-compat-split-string (or default-remote-path "") ":") + (split-string (or default-remote-path "") ":" 'omit) (cdr elt1))) (setq remote-path (delq 'tramp-default-remote-path remote-path))) @@ -5343,7 +5252,7 @@ Return ATTR." (when elt2 (setcdr elt2 (append - (tramp-compat-split-string (or own-remote-path "") ":") + (split-string (or own-remote-path "") ":" 'omit) (cdr elt2))) (setq remote-path (delq 'tramp-own-remote-path remote-path))) @@ -5547,7 +5456,7 @@ Return ATTR." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (tramp-file-name-handler 'file-remote-p tmpfile 'localname)))) + (file-remote-p tmpfile 'localname)))) (delete-file tmpfile)) result))) @@ -5830,5 +5739,7 @@ function cell is returned to be applied on a buffer." ;; rsync). ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. +;; * Check, whether we could also use "getent passwd" and "getent +;; group" for user/group name completion. ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 65c77eba0eb..2a38b0ef2f9 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1,6 +1,6 @@ ;;; tramp-smb.el --- Tramp access functions for SMB servers -;; Copyright (C) 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 2002-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes @@ -224,7 +224,6 @@ See `tramp-actions-before-shell' for more info.") (directory-files . tramp-smb-handle-directory-files) (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-smb-handle-expand-file-name) @@ -276,7 +275,7 @@ See `tramp-actions-before-shell' for more info.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (unhandled-file-name-directory . ignore) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-smb-handle-write-region)) @@ -419,12 +418,11 @@ pass to the OPERATION." (unwind-protect (progn (make-directory tmpdir) - (tramp-compat-copy-directory - dirname tmpdir keep-date 'parents) - (tramp-compat-copy-directory + (copy-directory dirname tmpdir keep-date 'parents) + (copy-directory (expand-file-name (file-name-nondirectory dirname) tmpdir) newname keep-date parents)) - (tramp-compat-delete-directory tmpdir 'recursive)))) + (delete-directory tmpdir 'recursive)))) ;; We can copy recursively. ((or t1 t2) @@ -448,7 +446,7 @@ pass to the OPERATION." (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) (localname (file-name-as-directory - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v)))) (tmpdir (make-temp-name (expand-file-name @@ -510,7 +508,7 @@ pass to the OPERATION." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-with-tar) (while (memq (process-status p) '(run open)) @@ -520,7 +518,7 @@ pass to the OPERATION." ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) (tramp-set-connection-property v "process-buffer" nil) - (when t1 (tramp-compat-delete-directory tmpdir 'recurse)))) + (when t1 (delete-directory tmpdir 'recurse)))) ;; Handle KEEP-DATE argument. (when keep-date @@ -555,7 +553,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." 0 (format "Copying %s to %s" filename newname) (if (file-directory-p filename) - (tramp-compat-copy-directory filename newname keep-date t t) + (tramp-compat-copy-directory + filename newname keep-date 'parents 'copy-contents) (let ((tmpfile (file-local-copy filename))) (if tmpfile @@ -601,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapc (lambda (file) (if (file-directory-p file) - (tramp-compat-delete-directory file recursive) + (delete-directory file recursive) (delete-file file))) ;; We do not want to delete "." and "..". (directory-files @@ -665,7 +664,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) ;; Remove double entries. - (tramp-compat-delete-dups result))) + (delete-dups result))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -730,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (domain (tramp-file-name-domain v)) (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) - (localname (tramp-compat-replace-regexp-in-string + (localname (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v))) (args (list (concat "//" real-host "/" share) "-E"))) @@ -765,11 +764,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-get-acl) (when (> (point-max) (point-min)) - (tramp-compat-funcall - 'substring-no-properties (buffer-string))))) + (substring-no-properties (buffer-string))))) ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) @@ -1068,9 +1066,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-smb-send-command v (if (tramp-smb-get-cifs-capabilities v) - (format - "posix_mkdir \"%s\" %s" - file (tramp-compat-decimal-to-octal (default-file-modes))) + (format "posix_mkdir \"%s\" %o" file (default-file-modes)) (format "mkdir \"%s\"" file))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. @@ -1240,12 +1236,7 @@ target of the symlink differ." (unless outbuf (kill-buffer (tramp-get-connection-property v "process-buffer" nil))) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -1296,9 +1287,10 @@ target of the symlink differ." (tramp-error v2 'file-error "Cannot rename `%s'" filename)))) ;; We must rename via copy. - (tramp-compat-copy-file filename newname ok-if-already-exists t t t) + (copy-file + filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (if (file-directory-p filename) - (tramp-compat-delete-directory filename 'recursive) + (delete-directory filename 'recursive) (delete-file filename))))) (defun tramp-smb-action-set-acl (proc vec) @@ -1325,10 +1317,10 @@ target of the symlink differ." (domain (tramp-file-name-domain v)) (port (tramp-file-name-port v)) (share (tramp-smb-get-share v)) - (localname (tramp-compat-replace-regexp-in-string + (localname (replace-regexp-in-string "\\\\" "/" (tramp-smb-get-localname v))) (args (list (concat "//" real-host "/" share) "-E" "-S" - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string "\n" "," acl-string)))) (if (not (zerop (length real-user))) @@ -1364,7 +1356,7 @@ target of the symlink differ." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-set-acl) (goto-char (point-max)) (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) @@ -1387,9 +1379,7 @@ target of the symlink differ." (when (tramp-smb-get-cifs-capabilities v) (tramp-flush-file-property v localname) (unless (tramp-smb-send-command - v (format "chmod \"%s\" %s" - (tramp-smb-get-localname v) - (tramp-compat-decimal-to-octal mode))) + v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode)) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -1460,9 +1450,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) - confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) @@ -1575,10 +1563,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." ;; Add directory itself. (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; There's a very strange error (debugged with XEmacs 21.4.14) - ;; If there's no short delay, it returns nil. No idea about. - (when (featurep 'xemacs) (sleep-for 0.01)) - ;; Return entries. (delq nil res)))))) @@ -1738,7 +1722,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (member "pathnames" (split-string - (buffer-substring (point) (point-at-eol)) nil t))))))))) + (buffer-substring (point) (point-at-eol)) nil 'omit))))))))) (defun tramp-smb-get-stat-capability (vec) "Check, whether the SMB server supports the STAT command." @@ -1878,7 +1862,7 @@ If ARGUMENT is non-nil, use it as argument for (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" vec) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; Set variables for computing the prompt for reading password. (setq tramp-current-method tramp-smb-method diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el index efa43b5880e..b3d84bb7bf8 100644 --- a/lisp/net/tramp-uu.el +++ b/lisp/net/tramp-uu.el @@ -1,6 +1,6 @@ ;;; tramp-uu.el --- uuencode in Lisp -;; Copyright (C) 2002-2015 Free Software Foundation, Inc. +;; Copyright (C) 2002-2016 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, terminals diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b7f53095a8e..e52f1958592 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1,6 +1,6 @@ ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Michael Albinus <michael.albinus@gmx.de> @@ -34,9 +34,7 @@ ;; Notes: ;; ----- ;; -;; This package only works for Emacs 22.1 and higher, and for XEmacs 21.4 -;; and higher. For XEmacs 21, you need the package `fsf-compat' for -;; the `with-timeout' macro. +;; This package only works for Emacs 23.1 and higher. ;; ;; Also see the todo list at the bottom of this file. ;; @@ -61,11 +59,7 @@ ;; Pacify byte-compiler. (eval-when-compile (require 'cl)) -(defvar bkup-backup-directory-info) -(defvar directory-sep-char) (defvar eshell-path-env) -(defvar ls-lisp-use-insert-directory-program) -(defvar outline-regexp) ;;; User Customizable Internal Variables: @@ -102,11 +96,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are :group 'tramp :type 'integer) -;; Emacs case. -(eval-and-compile - (when (boundp 'backup-directory-alist) - (defcustom tramp-backup-directory-alist nil - "Alist of filename patterns and backup directory names. +(defcustom tramp-backup-directory-alist nil + "Alist of filename patterns and backup directory names. Each element looks like (REGEXP . DIRECTORY), with the same meaning like in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY is a local file name, the backup directory is prepended with Tramp file @@ -116,34 +107,9 @@ name prefix \(method, user, host) of file. gives the same backup policy for Tramp files on their hosts like the policy for local files." - :group 'tramp - :type '(repeat (cons (regexp :tag "Regexp matching filename") - (directory :tag "Backup directory name")))))) - -;; XEmacs case. We cannot check for `bkup-backup-directory-info', because -;; the package "backup-dir" might not be loaded yet. -(eval-and-compile - (when (featurep 'xemacs) - (defcustom tramp-bkup-backup-directory-info nil - "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...)) -It has the same meaning like `bkup-backup-directory-info' from package -`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local -file name, the backup directory is prepended with Tramp file name prefix -\(method, user, host) of file. - -\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info) - -gives the same backup policy for Tramp files on their hosts like the -policy for local files." - :type '(repeat - (list (regexp :tag "File regexp") - (string :tag "Backup Dir") - (set :inline t - (const ok-create) - (const full-path) - (const prepend-name) - (const search-upward)))) - :group 'tramp))) + :group 'tramp + :type '(repeat (cons (regexp :tag "Regexp matching filename") + (directory :tag "Backup directory name")))) (defcustom tramp-auto-save-directory nil "Put auto-save files in this directory, if set. @@ -329,25 +295,9 @@ useful only in combination with `tramp-default-proxies-alist'.") ;; PuTTY is installed. We don't take it, if it is installed on a ;; non-windows system, or pscp from the pssh (parallel ssh) package ;; is found. - ((and (eq system-type 'windows-nt) - (executable-find "pscp")) - (if (or (fboundp 'password-read) - (fboundp 'auth-source-user-or-password) - (fboundp 'auth-source-search) - ;; Pageant is running. - (tramp-compat-process-running-p "Pageant")) - "pscp" - "plink")) + ((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp") ;; There is an ssh installation. - ((executable-find "scp") - (if (or (fboundp 'password-read) - (fboundp 'auth-source-user-or-password) - (fboundp 'auth-source-search) - ;; ssh-agent is running. - (getenv "SSH_AUTH_SOCK") - (getenv "SSH_AGENT_PID")) - "scp" - "ssh")) + ((executable-find "scp") "scp") ;; Fallback. (t "ftp")) "Default method to use for transferring files. @@ -482,6 +432,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists: * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files, * `tramp-parse-hosts' for \"/etc/hosts\" like files, * `tramp-parse-passwd' for \"/etc/passwd\" like files. + * `tramp-parse-etc-group' for \"/etc/group\" like files. * `tramp-parse-netrc' for \"~/.netrc\" like files. * `tramp-parse-putty' for PuTTY registered sessions. @@ -541,7 +492,7 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; regexp works only for GNU Emacs. ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. - (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)") + (concat "\\(?:^\\|\r\\)" "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*") "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' @@ -559,6 +510,7 @@ This regexp must match both `tramp-initial-end-of-output' and (defcustom tramp-password-prompt-regexp (format "^.*\\(%s\\).*:\^@? *" + ;; `password-word-equivalents' has been introduced with Emacs 24.4. (if (boundp 'password-word-equivalents) (regexp-opt (symbol-value 'password-word-equivalents)) "password\\|passphrase")) @@ -677,28 +629,17 @@ Useful for \"rsync\" like methods.") (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) -;; XEmacs is distributed with few Lisp packages. Further packages are -;; installed using EFS. If we use a unified filename format, then -;; Tramp is required in addition to EFS. (But why can't Tramp just -;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS -;; just like before.) Another reason for using a separate filename -;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but -;; Tramp only knows how to deal with `file-name-handler-alist', not -;; the other places. - -;; Currently, we have the choice between 'ftp and 'sep. ;;;###autoload -(defcustom tramp-syntax - (if (featurep 'xemacs) 'sep 'ftp) +(defcustom tramp-syntax 'ftp "Tramp filename syntax to be used. It can have the following values: - `ftp' -- Ange-FTP respective EFS like syntax (GNU Emacs default) - `sep' -- Syntax as defined for XEmacs." + `ftp' -- Ange-FTP like syntax + `sep' -- Syntax as defined for XEmacs originally." :group 'tramp :version "24.4" - :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp) + :type '(choice (const :tag "Ange-FTP" ftp) (const :tag "XEmacs" sep))) (defconst tramp-prefix-format @@ -883,15 +824,13 @@ See also `tramp-file-name-regexp'.") "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):" "\\`/[^/|:][^/|]*:") "Value for `tramp-file-name-regexp' for unified remoting. -Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and -Tramp. See `tramp-file-name-structure' for more explanations. +See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") ;;;###autoload (defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "Value for `tramp-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload @@ -919,7 +858,6 @@ Also see `tramp-file-name-structure'.") (if (memq system-type '(cygwin windows-nt)) "\\`/[^/]\\{2,\\}\\'" "\\`/[^/]*\\'") "Value for `tramp-completion-file-name-regexp' for unified remoting. -GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP. See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") @@ -928,7 +866,6 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate "\\`/\\([[][^]]*\\)?\\'" "Value for `tramp-completion-file-name-regexp' for separate remoting. -XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload @@ -951,10 +888,7 @@ Also see `tramp-file-name-structure'.") ;; to drop bytes when data is sent too quickly. There is also a connection ;; buffer local variable, which is computed depending on remote host properties ;; when `tramp-chunksize' is zero or nil. -(defcustom tramp-chunksize - (when (and (not (featurep 'xemacs)) - (memq system-type '(hpux))) - 500) +(defcustom tramp-chunksize (when (memq system-type '(hpux)) 500) ;; Parentheses in docstring starting at beginning of line are escaped. ;; Fontification is messed up when ;; `open-paren-in-column-0-is-defun-start' set to t. @@ -1111,8 +1045,7 @@ If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' entry does not exist, return nil." (let ((hash-entry - (tramp-compat-replace-regexp-in-string - "^tramp-" "" (symbol-name param)))) + (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry nil) @@ -1230,11 +1163,10 @@ their replacement." ;; This works with the current set of `tramp-obsolete-methods'. ;; Must be improved, if their are more sophisticated replacements. (setq result (substring result 0 -1))) - ;; We must mark, whether a default value has been used. Not - ;; applicable for XEmacs. - (if (or method (null result) (null (functionp 'propertize))) + ;; We must mark, whether a default value has been used. + (if (or method (null result)) result - (tramp-compat-funcall 'propertize result 'tramp-default t)))) + (propertize result 'tramp-default t)))) (defun tramp-find-user (method user host) "Return the right user string to use. @@ -1252,11 +1184,10 @@ This is USER, if non-nil. Otherwise, do a lookup in (setq choices nil))) luser) tramp-default-user))) - ;; We must mark, whether a default value has been used. Not - ;; applicable for XEmacs. - (if (or user (null result) (null (functionp 'propertize))) + ;; We must mark, whether a default value has been used. + (if (or user (null result)) result - (tramp-compat-funcall 'propertize result 'tramp-default t)))) + (propertize result 'tramp-default t)))) (defun tramp-find-host (method user host) "Return the right host string to use. @@ -1447,8 +1378,7 @@ ARGUMENTS to actually emit the message (if applicable)." (when (bobp) (insert (format - ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" - (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) + ";; Emacs: %s Tramp: %s -*- mode: outline; -*-" emacs-version tramp-version)) (when (>= tramp-verbose 10) (insert @@ -1481,7 +1411,6 @@ ARGUMENTS to actually emit the message (if applicable)." '("tramp-backtrace" "tramp-compat-condition-case-unless-debug" "tramp-compat-funcall" - "tramp-compat-with-temp-message" "tramp-condition-case-unless-debug" "tramp-debug-message" "tramp-error" @@ -1651,14 +1580,13 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) +(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) "")) - (tramp-compat-funcall 'progress-reporter-update reporter value)))) + (progress-reporter-update reporter value)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. @@ -1675,19 +1603,18 @@ without a visible progress reporter." ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) (ignore-errors - (let ((pr (tramp-compat-funcall - #'make-progress-reporter ,message))) + (let ((pr (make-progress-reporter ,message nil nil))) (when pr - (run-at-time 3 0.1 - #'tramp-progress-reporter-update pr))))))) + (run-at-time + 3 0.1 #'tramp-progress-reporter-update pr))))))) (unwind-protect ;; Execute the body. (prog1 (progn ,@body) (setq cookie "done")) ;; Stop progress reporter. - (if tm (tramp-compat-funcall 'cancel-timer tm)) + (if tm (cancel-timer tm)) (tramp-message ,vec ,level "%s...%s" ,message cookie))))) -(tramp-compat-font-lock-add-keywords +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) (defmacro with-tramp-file-property (vec file property &rest body) @@ -1706,8 +1633,7 @@ FILE must be a local file name on a connection identified via VEC." (put 'with-tramp-file-property 'lisp-indent-function 3) (put 'with-tramp-file-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) (defmacro with-tramp-connection-property (key property &rest body) "Check in Tramp for property PROPERTY, otherwise executes BODY and set." @@ -1722,7 +1648,7 @@ FILE must be a local file name on a connection identified via VEC." (put 'with-tramp-connection-property 'lisp-indent-function 2) (put 'with-tramp-connection-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) (defun tramp-drop-volume-letter (name) @@ -1806,28 +1732,22 @@ Adds another overlay hiding filename parts according to Tramp's special handling of `substitute-in-file-name'." (when (symbol-value 'minibuffer-completing-file-name) (setq tramp-rfn-eshadow-overlay - (tramp-compat-funcall - 'make-overlay - (tramp-compat-funcall 'minibuffer-prompt-end) - (tramp-compat-funcall 'minibuffer-prompt-end))) + (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) ;; Copy rfn-eshadow-overlay properties. - (let ((props (tramp-compat-funcall - 'overlay-properties (symbol-value 'rfn-eshadow-overlay)))) + (let ((props (overlay-properties (symbol-value 'rfn-eshadow-overlay)))) (while props ;; The `field' property prevents correct minibuffer ;; completion; we exclude it. (if (not (eq (car props) 'field)) - (tramp-compat-funcall - 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) + (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) (pop props) (pop props)))))) -(when (boundp 'rfn-eshadow-setup-minibuffer-hook) - (add-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer)))) +(add-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer))) (defconst tramp-rfn-eshadow-update-overlay-regexp (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) @@ -1839,15 +1759,13 @@ This is intended to be used as a minibuffer `post-command-hook' for been set up by `rfn-eshadow-setup-minibuffer'." ;; In remote files name, there is a shadowing just for the local part. (ignore-errors - (let ((end (or (tramp-compat-funcall - 'overlay-end (symbol-value 'rfn-eshadow-overlay)) - (tramp-compat-funcall 'minibuffer-prompt-end))) + (let ((end (or (overlay-end (symbol-value 'rfn-eshadow-overlay)) + (minibuffer-prompt-end))) ;; We do not want to send any remote command. (non-essential t)) (when (tramp-tramp-file-p - (tramp-compat-funcall - 'buffer-substring-no-properties end (point-max))) + (buffer-substring-no-properties end (point-max))) (save-excursion (save-restriction (narrow-to-region @@ -1859,17 +1777,15 @@ been set up by `rfn-eshadow-setup-minibuffer'." (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) (rfn-eshadow-update-overlay-hook nil) file-name-handler-alist) - (tramp-compat-funcall - 'move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))) - -(when (boundp 'rfn-eshadow-update-overlay-hook) - (add-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay)))) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay)))))))) + +(add-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay))) ;; Inodes don't exist for some file systems. Therefore we must ;; generate virtual ones. Used in `find-buffer-visiting'. The method @@ -1892,12 +1808,13 @@ been set up by `rfn-eshadow-setup-minibuffer'." If the file modes of FILENAME cannot be determined, return the value of `default-file-modes', without execute permissions." (or (file-modes filename) - (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) + (logand (default-file-modes) (string-to-number "0666" 8)))) (defun tramp-replace-environment-variables (filename) "Replace environment variables in FILENAME. Return the string with the replaced variables." (or (ignore-errors + ;; Optional arg has been introduced with Emacs 24 (?). (tramp-compat-funcall 'substitute-env-vars filename 'only-defined)) ;; We need an own implementation. (save-match-data @@ -1912,35 +1829,6 @@ Return the string with the replaced variables." t nil filename))) filename)))) -;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, -;; which calls corresponding functions (see minibuf.el). -(when (fboundp 'minibuffer-electric-separator) - (mapc - (lambda (x) - (eval - `(defadvice ,x - (around ,(intern (format "tramp-advice-%s" x)) activate) - "Invoke `substitute-in-file-name' for Tramp files." - (if (and (symbol-value 'minibuffer-electric-file-name-behavior) - (tramp-tramp-file-p (buffer-substring))) - ;; We don't need to handle `last-input-event', because - ;; due to the key map we know it must be ?/ or ?~. - (let ((s (concat (buffer-substring (point-min) (point)) - (string last-command-char)))) - (delete-region (point-min) (point)) - (insert (substitute-in-file-name s)) - (setq ad-return-value last-command-char)) - ad-do-it))) - (eval - `(add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x))) - (ad-activate ',x))))) - - '(minibuffer-electric-separator - minibuffer-electric-tilde))) - (defun tramp-find-file-name-coding-system-alist (filename tmpname) "Like `find-operation-coding-system' for Tramp filenames. Tramp's `insert-file-contents' and `write-region' work over @@ -2000,49 +1888,35 @@ ARGS are the arguments OPERATION has been called with." (cond ;; FILE resp DIRECTORY. ((member operation - (list 'access-file 'byte-compiler-base-file-name 'delete-directory - 'delete-file 'diff-latest-backup-file 'directory-file-name - 'directory-files 'directory-files-and-attributes - 'dired-compress-file 'dired-uncache - 'file-accessible-directory-p 'file-attributes - 'file-directory-p 'file-executable-p 'file-exists-p - 'file-local-copy 'file-modes - 'file-name-as-directory 'file-name-directory - 'file-name-nondirectory 'file-name-sans-versions - 'file-ownership-preserved-p 'file-readable-p - 'file-regular-p 'file-remote-p 'file-symlink-p 'file-truename - 'file-writable-p 'find-backup-file-name 'find-file-noselect - 'get-file-buffer 'insert-directory 'insert-file-contents - 'load 'make-directory 'make-directory-internal - 'set-file-modes 'substitute-in-file-name - 'unhandled-file-name-directory 'vc-registered - ;; Emacs 22+ only. - 'set-file-times - ;; Emacs 24+ only. - 'file-acl 'file-notify-add-watch - 'file-selinux-context 'set-file-acl 'set-file-selinux-context - ;; XEmacs only. - 'abbreviate-file-name 'create-file-buffer - 'dired-file-modtime 'dired-make-compressed-filename - 'dired-recursive-delete-directory 'dired-set-file-modtime - 'dired-shell-unhandle-file-name 'dired-uucode-file - 'insert-file-contents-literally 'make-temp-name 'recover-file - 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail)) + '(access-file byte-compiler-base-file-name delete-directory + delete-file diff-latest-backup-file directory-file-name + directory-files directory-files-and-attributes + dired-compress-file dired-uncache + file-accessible-directory-p file-attributes + file-directory-p file-executable-p file-exists-p + file-local-copy file-modes + file-name-as-directory file-name-directory + file-name-nondirectory file-name-sans-versions + file-ownership-preserved-p file-readable-p + file-regular-p file-remote-p file-symlink-p file-truename + file-writable-p find-backup-file-name find-file-noselect + get-file-buffer insert-directory insert-file-contents + load make-directory make-directory-internal + set-file-modes set-file-times substitute-in-file-name + unhandled-file-name-directory vc-registered + ;; Emacs 24+ only. + file-acl file-notify-add-watch file-selinux-context + set-file-acl set-file-selinux-context)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) (expand-file-name (nth 0 args)))) ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation - (list 'add-name-to-file 'copy-file 'expand-file-name - 'file-name-all-completions 'file-name-completion - 'file-newer-than-file-p 'make-symbolic-link 'rename-file - ;; Emacs 23+ only. - 'copy-directory - ;; Emacs 24+ only. - 'file-equal-p 'file-in-directory-p - ;; XEmacs only. - 'dired-make-relative-symlink - 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) + '(add-name-to-file copy-directory copy-file expand-file-name + file-name-all-completions file-name-completion + file-newer-than-file-p make-symbolic-link rename-file + ;; Emacs 24+ only. + file-equal-p file-in-directory-p)) (save-match-data (cond ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) @@ -2053,28 +1927,20 @@ ARGS are the arguments OPERATION has been called with." (nth 2 args)) ;; BUFFER. ((member operation - (list 'set-visited-file-modtime 'verify-visited-file-modtime - ;; Emacs 22+ only. - 'make-auto-save-file-name - ;; XEmacs only. - 'backup-buffer)) + '(make-auto-save-file-name + set-visited-file-modtime verify-visited-file-modtime)) (buffer-file-name (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - (list ;; not in Emacs 23+. - 'dired-call-process - ;; Emacs only. - 'shell-command - ;; Emacs 22+ only. - 'process-file - ;; Emacs 23+ only. - 'start-file-process - ;; XEmacs only. - 'dired-print-file 'dired-shell-call-process)) + '(process-file shell-command start-file-process)) default-directory) ;; PROC. - ((member operation (list 'file-notify-rm-watch 'file-notify-valid-p)) + ((member operation + '(;; Emacs 24+ only. + file-notify-rm-watch + ;; Emacs 25+ only. + file-notify-valid-p)) (when (processp (nth 0 args)) (with-current-buffer (process-buffer (nth 0 args)) default-directory))) @@ -2228,10 +2094,7 @@ preventing reentrant calls of Tramp.") (progn (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. Falls back to normal file name handler if no Tramp file name handler exists." - ;; We bind `directory-sep-char' here for XEmacs on Windows, which - ;; would otherwise use backslash. - (let ((directory-sep-char ?/) - (fn (assoc operation tramp-completion-file-name-handler-alist))) + (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and ;; When `tramp-mode' is not enabled, we don't do anything. fn tramp-mode @@ -2242,8 +2105,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; indicated his interest in using a fancier completion system. (or (eq tramp-syntax 'sep) (featurep 'tramp) ;; If it's loaded, we may as well use it. - ;; `partial-completion-mode' does not exist in XEmacs. - ;; It is obsoleted with Emacs 24.1. + ;; `partial-completion-mode' is obsoleted with Emacs 24.1. (and (boundp 'partial-completion-mode) (symbol-value 'partial-completion-mode)) ;; FIXME: These may have been loaded even if the user never @@ -2256,9 +2118,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) "Load Tramp file name handler, and perform OPERATION." - ;; Avoid recursive loading of tramp.el. `temporary-file-directory' - ;; does not exist in XEmacs, so we must use something else. - (let ((default-directory "/")) + ;; Avoid recursive loading of tramp.el. + (let ((default-directory temporary-file-directory)) (load "tramp" nil t)) (apply operation args))) @@ -2361,7 +2222,7 @@ should never be set globally, the intention is to let-bind it.") ;; variable. On the other hand, those files shouldn't have partial ;; Tramp file name syntax. Maybe another variable should be introduced ;; overwriting this check in such cases. Or we change Tramp file name -;; syntax in order to avoid ambiguities, like in XEmacs ... +;; syntax in order to avoid ambiguities. ;;;###tramp-autoload (defun tramp-completion-mode-p () "Check, whether method / user name / host name completion is active." @@ -2369,7 +2230,6 @@ should never be set globally, the intention is to let-bind it.") ;; Signal from outside. `non-essential' has been introduced in Emacs 24. (and (boundp 'non-essential) (symbol-value 'non-essential)) tramp-completion-mode - ;; Emacs. (equal last-input-event 'tab) (and (natnump last-input-event) (or @@ -2377,24 +2237,7 @@ should never be set globally, the intention is to let-bind it.") (equal last-input-event ?\t) (and (not (event-modifiers last-input-event)) (or (equal last-input-event ?\?) - (equal last-input-event ?\ ))))) - ;; XEmacs. - (and (featurep 'xemacs) - ;; `last-input-event' might be nil. - (not (null last-input-event)) - ;; `last-input-event' may have no character approximation. - (tramp-compat-funcall 'event-to-character last-input-event) - (or - ;; ?\t has event-modifier 'control. - (equal - (tramp-compat-funcall 'event-to-character last-input-event) ?\t) - (and (not (event-modifiers last-input-event)) - (or (equal - (tramp-compat-funcall 'event-to-character last-input-event) - ?\?) - (equal - (tramp-compat-funcall 'event-to-character last-input-event) - ?\ ))))))) + (equal last-input-event ?\ ))))))) (defun tramp-connectable-p (filename) "Check, whether it is possible to connect the remote host w/o side-effects. @@ -2804,6 +2647,22 @@ Host is always \"localhost\"." result)) ;;;###tramp-autoload +(defun tramp-parse-etc-group (filename) + "Return a list of (group host) tuples allowed to access. +Host is always \"localhost\"." + (tramp-parse-file filename 'tramp-parse-etc-group-group)) + +(defun tramp-parse-etc-group-group () + "Return a (group host) tuple allowed to access. +Host is always \"localhost\"." + (let ((result) + (split (split-string (buffer-substring (point) (point-at-eol)) ":"))) + (when (member (user-login-name) (split-string (nth 3 split) "," 'omit)) + (setq result (list (nth 0 split) "localhost"))) + (forward-line 1) + result)) + +;;;###tramp-autoload (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." @@ -2868,10 +2727,8 @@ User is always nil." (substring directory 0 -1) directory))) -(defun tramp-handle-directory-files - (directory &optional full match nosort files-only) +(defun tramp-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for Tramp files." - ;; FILES-ONLY is valid for XEmacs only. (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) @@ -2879,12 +2736,7 @@ User is always nil." (while temp (setq item (directory-file-name (pop temp))) - (when (and (or (null match) (string-match match item)) - (or (null files-only) - ;; Files only. - (and (equal files-only t) (file-regular-p item)) - ;; Directories only. - (file-directory-p item))) + (when (or (null match) (string-match match item)) (push (if full (concat directory item) item) result))) (if nosort result (sort result 'string<))))) @@ -2894,15 +2746,14 @@ User is always nil." "Like `directory-files-and-attributes' for Tramp files." (mapcar (lambda (x) - (cons x (tramp-compat-file-attributes + (cons x (file-attributes (if full x (expand-file-name x directory)) id-format))) (directory-files directory full match nosort))) -(defun tramp-handle-dired-uncache (dir &optional dir-p) +(defun tramp-handle-dired-uncache (dir) "Like `dired-uncache' for Tramp files." - ;; DIR-P is valid for XEmacs only. (with-parsed-tramp-file-name - (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil + (if (file-directory-p dir) dir (file-name-directory dir)) nil (tramp-flush-directory-property v localname))) (defun tramp-handle-file-accessible-directory-p (filename) @@ -3034,43 +2885,19 @@ User is always nil." (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil - ;; We set both variables. It doesn't matter whether it is - ;; Emacs or XEmacs. (let ((backup-directory-alist - ;; Emacs case. - (when (boundp 'backup-directory-alist) - (if (symbol-value 'tramp-backup-directory-alist) - (mapcar - (lambda (x) - (cons - (car x) - (if (and (stringp (cdr x)) - (file-name-absolute-p (cdr x)) - (not (tramp-file-name-p (cdr x)))) - (tramp-make-tramp-file-name method user host (cdr x)) - (cdr x)))) - (symbol-value 'tramp-backup-directory-alist)) - (symbol-value 'backup-directory-alist)))) - - (bkup-backup-directory-info - ;; XEmacs case. - (when (boundp 'bkup-backup-directory-info) - (if (symbol-value 'tramp-bkup-backup-directory-info) - (mapcar - (lambda (x) - (nconc - (list (car x)) - (list - (if (and (stringp (car (cdr x))) - (file-name-absolute-p (car (cdr x))) - (not (tramp-file-name-p (car (cdr x))))) - (tramp-make-tramp-file-name - method user host (car (cdr x))) - (car (cdr x)))) - (cdr (cdr x)))) - (symbol-value 'tramp-bkup-backup-directory-info)) - (symbol-value 'bkup-backup-directory-info))))) - + (if tramp-backup-directory-alist + (mapcar + (lambda (x) + (cons + (car x) + (if (and (stringp (cdr x)) + (file-name-absolute-p (cdr x)) + (not (tramp-file-name-p (cdr x)))) + (tramp-make-tramp-file-name method user host (cdr x)) + (cdr x)))) + tramp-backup-directory-alist) + backup-directory-alist))) (tramp-run-real-handler 'find-backup-file-name (list filename))))) (defun tramp-handle-insert-directory @@ -3181,8 +3008,7 @@ User is always nil." ;; When the file is not readable for the owner, it ;; cannot be inserted, even if it is readable for the ;; group or for everybody. - (set-file-modes - local-copy (tramp-compat-octal-to-decimal "0600")) + (set-file-modes local-copy (string-to-number "0600" 8)) (when (and (null remote-copy) (tramp-get-method-parameter @@ -3192,9 +3018,7 @@ User is always nil." (setq tramp-temp-buffer-file-name local-copy)) ;; We must ensure that `file-coding-system-alist' - ;; matches `local-copy'. We must also use `visit', - ;; otherwise there might be an error in the - ;; `revert-buffer' function under XEmacs. + ;; matches `local-copy'. (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename local-copy))) @@ -3250,7 +3074,7 @@ User is always nil." (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) (unwind-protect - (tramp-compat-load local-copy noerror t nosuffix must-suffix) + (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) @@ -3344,9 +3168,7 @@ User is always nil." (current-buffer)))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (tramp-compat-funcall 'display-message-or-buffer output-buffer) - (pop-to-buffer output-buffer)))))))) + (display-message-or-buffer output-buffer))))))) (defun tramp-handle-substitute-in-file-name (filename) "Like `substitute-in-file-name' for Tramp files. @@ -3366,14 +3188,6 @@ User is always nil." (let (process-environment) (tramp-run-real-handler 'substitute-in-file-name (list filename))))) -(defun tramp-handle-unhandled-file-name-directory (_filename) - "Like `unhandled-file-name-directory' for Tramp files." - ;; Starting with Emacs 23, we must simply return nil. But we must - ;; keep backward compatibility, also with XEmacs. "~/" cannot be - ;; returned, because there might be machines without a HOME - ;; directory (like hydra). - (and (< emacs-major-version 23) "/")) - (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." (unless (buffer-file-name) @@ -3402,7 +3216,7 @@ of." ;; connection. (if (or (not f) (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) @@ -3453,7 +3267,7 @@ of." (with-current-buffer (process-buffer proc) (file-exists-p (concat (file-remote-p default-directory) - (tramp-compat-process-get proc 'watch-name)))))) + (process-get proc 'watch-name)))))) ;;; Functions for establishing connection: @@ -3656,9 +3470,7 @@ for process communication also." ;; Under Windows XP, accept-process-output doesn't return ;; sometimes. So we add an additional timeout. (with-timeout ((or timeout 1)) - (if (featurep 'xemacs) - (accept-process-output p timeout timeout-msecs) - (accept-process-output p timeout timeout-msecs (and proc t)))) + (accept-process-output p timeout timeout-msecs (and proc t))) (tramp-message proc 10 "%s %s %s\n%s" proc (process-status proc) p (buffer-string))))) @@ -3683,11 +3495,10 @@ Erase echoed commands if exists." (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil)) ;; Sometimes, the echo string is suppressed on the remote side. (not (string-equal - (tramp-compat-funcall - 'substring-no-properties tramp-echo-mark-marker + (substring-no-properties + tramp-echo-mark-marker 0 (min tramp-echo-mark-marker-length (1- (point-max)))) - (tramp-compat-funcall - 'buffer-substring-no-properties + (buffer-substring-no-properties (point-min) (min (+ (point-min) tramp-echo-mark-marker-length) (point-max)))))) @@ -3705,22 +3516,15 @@ Expects the output of PROC to be sent to the current buffer. Returns the string that matched, or nil. Waits indefinitely if TIMEOUT is nil." (with-current-buffer (process-buffer proc) - (let ((found (tramp-check-for-regexp proc regexp)) - (start-time (current-time))) + (let ((found (tramp-check-for-regexp proc regexp))) (cond (timeout - ;; Work around a bug in XEmacs 21, where the timeout - ;; expires faster than it should. This degenerates - ;; to polling for buggy XEmacsen, but oh, well. - (while (and (not found) - (< (tramp-time-diff (current-time) start-time) - timeout)) - (with-timeout (timeout) - (while (not found) - (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) - (tramp-error-with-buffer - nil proc 'file-error "Process has died")) - (setq found (tramp-check-for-regexp proc regexp)))))) + (with-timeout (timeout) + (while (not found) + (tramp-accept-process-output proc 1) + (unless (memq (process-status proc) '(run open)) + (tramp-error-with-buffer + nil proc 'file-error "Process has died")) + (setq found (tramp-check-for-regexp proc regexp))))) (t (while (not found) (tramp-accept-process-output proc 1) @@ -3760,9 +3564,8 @@ the remote host use line-endings as defined in the variable (let (buffer-read-only) (delete-region (point-min) (point-max))) ;; Replace "\n" by `tramp-rsh-end-of-line'. (setq string - (mapconcat 'identity - (tramp-compat-split-string string "\n") - tramp-rsh-end-of-line)) + (mapconcat + 'identity (split-string string "\n") tramp-rsh-end-of-line)) (unless (or (string= string "") (string-equal (substring string -1) tramp-rsh-end-of-line)) (setq string (concat string tramp-rsh-end-of-line))) @@ -3826,57 +3629,47 @@ would yield t. On the other hand, the following check results in nil: (save-match-data (logior (cond - ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400")) + ((char-equal owner-read ?r) (string-to-number "00400" 8)) ((char-equal owner-read ?-) 0) (t (error "Second char `%c' must be one of `r-'" owner-read))) (cond - ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200")) + ((char-equal owner-write ?w) (string-to-number "00200" 8)) ((char-equal owner-write ?-) 0) (t (error "Third char `%c' must be one of `w-'" owner-write))) (cond - ((char-equal owner-execute-or-setid ?x) - (tramp-compat-octal-to-decimal "00100")) - ((char-equal owner-execute-or-setid ?S) - (tramp-compat-octal-to-decimal "04000")) - ((char-equal owner-execute-or-setid ?s) - (tramp-compat-octal-to-decimal "04100")) + ((char-equal owner-execute-or-setid ?x) (string-to-number "00100" 8)) + ((char-equal owner-execute-or-setid ?S) (string-to-number "04000" 8)) + ((char-equal owner-execute-or-setid ?s) (string-to-number "04100" 8)) ((char-equal owner-execute-or-setid ?-) 0) (t (error "Fourth char `%c' must be one of `xsS-'" owner-execute-or-setid))) (cond - ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040")) + ((char-equal group-read ?r) (string-to-number "00040" 8)) ((char-equal group-read ?-) 0) (t (error "Fifth char `%c' must be one of `r-'" group-read))) (cond - ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020")) + ((char-equal group-write ?w) (string-to-number "00020" 8)) ((char-equal group-write ?-) 0) (t (error "Sixth char `%c' must be one of `w-'" group-write))) (cond - ((char-equal group-execute-or-setid ?x) - (tramp-compat-octal-to-decimal "00010")) - ((char-equal group-execute-or-setid ?S) - (tramp-compat-octal-to-decimal "02000")) - ((char-equal group-execute-or-setid ?s) - (tramp-compat-octal-to-decimal "02010")) + ((char-equal group-execute-or-setid ?x) (string-to-number "00010" 8)) + ((char-equal group-execute-or-setid ?S) (string-to-number "02000" 8)) + ((char-equal group-execute-or-setid ?s) (string-to-number "02010" 8)) ((char-equal group-execute-or-setid ?-) 0) (t (error "Seventh char `%c' must be one of `xsS-'" group-execute-or-setid))) (cond - ((char-equal other-read ?r) - (tramp-compat-octal-to-decimal "00004")) + ((char-equal other-read ?r) (string-to-number "00004" 8)) ((char-equal other-read ?-) 0) (t (error "Eighth char `%c' must be one of `r-'" other-read))) (cond - ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002")) - ((char-equal other-write ?-) 0) - (t (error "Ninth char `%c' must be one of `w-'" other-write))) + ((char-equal other-write ?w) (string-to-number "00002" 8)) + ((char-equal other-write ?-) 0) + (t (error "Ninth char `%c' must be one of `w-'" other-write))) (cond - ((char-equal other-execute-or-sticky ?x) - (tramp-compat-octal-to-decimal "00001")) - ((char-equal other-execute-or-sticky ?T) - (tramp-compat-octal-to-decimal "01000")) - ((char-equal other-execute-or-sticky ?t) - (tramp-compat-octal-to-decimal "01001")) + ((char-equal other-execute-or-sticky ?x) (string-to-number "00001" 8)) + ((char-equal other-execute-or-sticky ?T) (string-to-number "01000" 8)) + ((char-equal other-execute-or-sticky ?t) (string-to-number "01001" 8)) ((char-equal other-execute-or-sticky ?-) 0) (t (error "Tenth char `%c' must be one of `xtT-'" other-execute-or-sticky))))))) @@ -3934,9 +3727,10 @@ This is used internally by `tramp-file-mode-from-int'." ;;;###tramp-autoload (defun tramp-get-local-gid (id-format) + ;; `group-gid' has been introduced with Emacs 24.4. (if (and (fboundp 'group-gid) (equal id-format 'integer)) (tramp-compat-funcall 'group-gid) - (nth 3 (tramp-compat-file-attributes "~/" id-format)))) + (nth 3 (file-attributes "~/" id-format)))) ;;;###tramp-autoload (defun tramp-check-cached-permissions (vec access) @@ -3958,7 +3752,7 @@ be granted." (tramp-get-file-property vec (tramp-file-name-localname vec) (concat "file-attributes-" suffix) nil) - (tramp-compat-file-attributes + (file-attributes (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -4029,7 +3823,7 @@ be granted." (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) (with-tramp-connection-property vec "tmpdir" (or (and (file-directory-p dir) (file-writable-p dir) - (tramp-file-name-handler 'file-remote-p dir 'localname)) + (file-remote-p dir 'localname)) (tramp-error vec 'file-error "Directory %s not accessible" dir))) dir)) @@ -4050,7 +3844,7 @@ Return the local name of the temporary file." (setq result nil) ;; This creates the file by side effect. (set-file-times result) - (set-file-modes result (tramp-compat-octal-to-decimal "0700")))) + (set-file-modes result (string-to-number "0700" 8)))) ;; Return the local part. (with-parsed-tramp-file-name result nil localname))) @@ -4066,9 +3860,6 @@ Return the local name of the temporary file." (remove-hook 'kill-buffer-hook 'tramp-delete-temp-file-function))) -;;; Auto saving to a special directory: -(defvar auto-save-file-name-transforms) - (defun tramp-handle-make-auto-save-file-name () "Like `make-auto-save-file-name' for Tramp files. Returns a file name in `tramp-auto-save-directory' for autosaving @@ -4083,9 +3874,8 @@ this file, if that variable is non-nil." (let ((system-type 'not-windows) (auto-save-file-name-transforms - (if (and (null tramp-auto-save-directory) - (boundp 'auto-save-file-name-transforms)) - (symbol-value 'auto-save-file-name-transforms))) + (if (null tramp-auto-save-directory) + auto-save-file-name-transforms)) (buffer-file-name (if (null tramp-auto-save-directory) buffer-file-name @@ -4099,61 +3889,8 @@ this file, if that variable is non-nil." ("]" . "_r")) (buffer-file-name)) tramp-auto-save-directory)))) - ;; Run plain `make-auto-save-file-name'. There might be an advice when - ;; it is not a magic file name operation (since Emacs 22). - ;; We must deactivate it temporarily. - (if (not (ad-is-active 'make-auto-save-file-name)) - (tramp-run-real-handler 'make-auto-save-file-name nil) - ;; else - (ad-deactivate 'make-auto-save-file-name) - (prog1 - (tramp-run-real-handler 'make-auto-save-file-name nil) - (ad-activate 'make-auto-save-file-name))))) - -(unless (tramp-exists-file-name-handler 'make-auto-save-file-name) - (defadvice make-auto-save-file-name - (around tramp-advice-make-auto-save-file-name () activate) - "Invoke `tramp-*-handle-make-auto-save-file-name' for Tramp files." - (if (tramp-tramp-file-p (buffer-file-name)) - ;; We cannot call `tramp-handle-make-auto-save-file-name' - ;; directly, because this would bypass the locking mechanism. - (setq ad-return-value - (tramp-file-name-handler 'make-auto-save-file-name)) - ad-do-it)) - (add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice - 'make-auto-save-file-name - 'around 'tramp-advice-make-auto-save-file-name) - (ad-activate 'make-auto-save-file-name)))) - -;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus -;; umask. This is a security threat. - -(defun tramp-set-auto-save-file-modes () - "Set permissions of autosaved remote files to the original permissions." - (let ((bfn (buffer-file-name))) - (when (and (tramp-tramp-file-p bfn) - (buffer-modified-p) - (stringp buffer-auto-save-file-name) - (not (equal bfn buffer-auto-save-file-name))) - (unless (file-exists-p buffer-auto-save-file-name) - (write-region "" nil buffer-auto-save-file-name)) - ;; Permissions should be set always, because there might be an old - ;; auto-saved file belonging to another original file. This could - ;; be a security threat. - (set-file-modes - buffer-auto-save-file-name - (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600")))))) - -(unless (and (featurep 'xemacs) - (= emacs-major-version 21) - (> emacs-minor-version 4)) - (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)))) + ;; Run plain `make-auto-save-file-name'. + (tramp-run-real-handler 'make-auto-save-file-name nil))) (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. @@ -4247,27 +3984,24 @@ Invokes `password-read' if available, `read-passwd' else." (tramp-check-for-regexp proc tramp-password-prompt-regexp) (format "%s for %s " (capitalize (match-string 1)) key)))) ;; We suspend the timers while reading the password. - (stimers (and (functionp 'with-timeout-suspend) - (tramp-compat-funcall 'with-timeout-suspend))) + (stimers (with-timeout-suspend)) auth-info auth-passwd) (unwind-protect (with-parsed-tramp-file-name key nil (prog1 (or - ;; See if auth-sources contains something useful, if - ;; it's bound. `auth-source-user-or-password' is an - ;; obsoleted function, it has been replaced by + ;; See if auth-sources contains something useful. + ;; `auth-source-user-or-password' is an obsoleted + ;; function since Emacs 24.1, it has been replaced by ;; `auth-source-search'. (ignore-errors - (and (boundp 'auth-sources) - (tramp-get-connection-property + (and (tramp-get-connection-property v "first-password-request" nil) ;; Try with Tramp's current method. (if (fboundp 'auth-source-search) (setq auth-info - (tramp-compat-funcall - 'auth-source-search + (auth-source-search :max 1 :user (or tramp-current-user t) :host tramp-current-host @@ -4277,21 +4011,17 @@ Invokes `password-read' if available, `read-passwd' else." auth-passwd (if (functionp auth-passwd) (funcall auth-passwd) auth-passwd)) - (tramp-compat-funcall - 'auth-source-user-or-password + (tramp-compat-funcall 'auth-source-user-or-password "password" tramp-current-host tramp-current-method)))) ;; Try the password cache. - (when (functionp 'password-read) - (let ((password - (tramp-compat-funcall 'password-read pw-prompt key))) - (tramp-compat-funcall 'password-cache-add key password) - password)) + (let ((password (password-read pw-prompt key))) + (password-cache-add key password) + password) ;; Else, get the password interactively. (read-passwd pw-prompt)) (tramp-set-connection-property v "first-password-request" nil))) ;; Reenable the timers. - (and (functionp 'with-timeout-unsuspend) - (tramp-compat-funcall 'with-timeout-unsuspend stimers))))) + (with-timeout-unsuspend stimers)))) ;;;###tramp-autoload (defun tramp-clear-passwd (vec) @@ -4303,11 +4033,10 @@ Invokes `password-read' if available, `read-passwd' else." (tramp-dissect-file-name (concat tramp-prefix-format - (tramp-compat-replace-regexp-in-string + (replace-regexp-in-string (concat tramp-postfix-hop-regexp "$") tramp-postfix-host-format hop)))))) - (tramp-compat-funcall - 'password-cache-remove + (password-cache-remove (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -4330,24 +4059,7 @@ Invokes `password-read' if available, `read-passwd' else." (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." - (cond ((and (fboundp 'subtract-time) - (fboundp 'float-time)) - (tramp-compat-funcall - 'float-time (tramp-compat-funcall 'subtract-time t1 t2))) - ((and (fboundp 'subtract-time) - (fboundp 'time-to-seconds)) - (tramp-compat-funcall - 'time-to-seconds (tramp-compat-funcall 'subtract-time t1 t2))) - ((fboundp 'itimer-time-difference) - (tramp-compat-funcall - 'itimer-time-difference - (if (< (length t1) 3) (append t1 '(0)) t1) - (if (< (length t2) 3) (append t2 '(0)) t2))) - (t - (let ((time (time-subtract t1 t2))) - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (nth 2 time) 0) 1000000.0)))))) + (float-time (subtract-time t1 t2))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -4442,7 +4154,6 @@ Only works for Bourne-like shells." ;; * In Emacs 21, `insert-directory' shows total number of bytes used ;; by the files in that directory. Add this here. ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) -;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index f93cfc4e8ae..64cc47e26a5 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -1,12 +1,12 @@ ;;; trampver.el --- Transparent Remote Access, Multiple Protocol ;;; lisp/trampver.el. Generated from trampver.el.in by configure. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.2.13.25.1 +;; Version: 2.3.0-pre ;; This file is part of GNU Emacs. @@ -27,45 +27,36 @@ ;; In the Tramp GIT repository, the version number and the bug report ;; address are auto-frobbed from configure.ac, so you should edit that -;; file and run "autoconf && ./configure" to change them. (X)Emacs +;; file and run "autoconf && ./configure" to change them. Emacs ;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.13.25.1" +(defconst tramp-version "2.3.0-pre" "This version of Tramp.") ;;;###tramp-autoload (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") -;; `locate-dominating-file' does not exist in XEmacs. But it is not used here. -(autoload 'locate-dominating-file "files") -(autoload 'tramp-compat-replace-regexp-in-string "tramp-compat") - (defun tramp-repository-get-version () "Try to return as a string the repository revision of the Tramp sources." - (unless (featurep 'xemacs) - (let ((dir (locate-dominating-file (locate-library "tramp") ".git"))) - (when dir - (with-temp-buffer - (let ((default-directory (file-name-as-directory dir))) - (and (zerop - (ignore-errors - (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) - (not (zerop (buffer-size))) - (tramp-compat-replace-regexp-in-string - "\n" "" (buffer-string))))))))) - -;; Check for (X)Emacs version. -(let ((x (if (or (>= emacs-major-version 22) - (and (featurep 'xemacs) - (= emacs-major-version 21) - (>= emacs-minor-version 4))) - "ok" - (format "Tramp 2.2.13.25.1 is not fit for %s" - (when (string-match "^.*$" (emacs-version)) - (match-string 0 (emacs-version))))))) + (let ((dir (locate-dominating-file (locate-library "tramp") ".git"))) + (when dir + (with-temp-buffer + (let ((default-directory (file-name-as-directory dir))) + (and (zerop + (ignore-errors + (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) + (not (zerop (buffer-size))) + (replace-regexp-in-string "\n" "" (buffer-string)))))))) + +;; Check for Emacs version. +(let ((x (if (>= emacs-major-version 23) + "ok" + (format "Tramp 2.3.0-pre is not fit for %s" + (when (string-match "^.*$" (emacs-version)) + (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) (add-hook 'tramp-unload-hook diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index 7cb017f39a3..41b7a7bb9cd 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -1,6 +1,6 @@ ;;; webjump.el --- programmable Web hotlist -;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 2001-2016 Free Software Foundation, Inc. ;; Author: Neil W. Van Dyke <nwv@acm.org> ;; Created: 09-Aug-1996 diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 794a4676a5e..421c1953e33 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -1,6 +1,6 @@ ;;; zeroconf.el --- Service browser using Avahi. -;; Copyright (C) 2008-2015 Free Software Foundation, Inc. +;; Copyright (C) 2008-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, hardware |