aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2010-09-16 11:11:13 +0900
committerKenichi Handa2010-09-16 11:11:13 +0900
commit38d50547c2a8195bed0aaeafbbc4c0f277d4e416 (patch)
tree388416c9f2cc4746d0d2d9e525a50a6c2f00f3d4
parentfa3f60399014127e711f3f438004950cba0bddb9 (diff)
parent6139f995addcb8fce63deb30c7ed0e6f2b618b02 (diff)
downloademacs-38d50547c2a8195bed0aaeafbbc4c0f277d4e416.tar.gz
emacs-38d50547c2a8195bed0aaeafbbc4c0f277d4e416.zip
merge trunk
-rw-r--r--ChangeLog13
-rw-r--r--README.imagemagick151
-rw-r--r--admin/unidata/unidata-gen.el2
-rwxr-xr-xconfigure166
-rw-r--r--configure.in19
-rw-r--r--doc/emacs/ChangeLog20
-rw-r--r--doc/emacs/cal-xtra.texi4
-rw-r--r--doc/emacs/calendar.texi9
-rw-r--r--doc/emacs/emacs.texi1
-rw-r--r--doc/emacs/trouble.texi191
-rw-r--r--doc/emacs/xresources.texi2
-rw-r--r--doc/lispref/ChangeLog8
-rw-r--r--doc/lispref/display.texi89
-rw-r--r--doc/lispref/syntax.texi91
-rw-r--r--doc/lispref/text.texi44
-rw-r--r--doc/misc/ChangeLog16
-rw-r--r--doc/misc/org.texi1001
-rw-r--r--doc/misc/tramp.texi29
-rw-r--r--doc/misc/trampver.texi4
-rw-r--r--etc/ChangeLog13
-rw-r--r--etc/NEWS58
-rw-r--r--etc/NEWS.232
-rw-r--r--etc/TODO502
-rw-r--r--etc/emacs.bash71
-rw-r--r--etc/emacs.csh31
-rw-r--r--etc/ms-kermit172
-rw-r--r--lisp/ChangeLog668
-rw-r--r--lisp/Makefile.in21
-rw-r--r--lisp/ansi-color.el4
-rw-r--r--lisp/calendar/appt.el15
-rw-r--r--lisp/calendar/diary-lib.el22
-rw-r--r--lisp/calendar/time-date.el8
-rw-r--r--lisp/emacs-lisp/byte-run.el13
-rw-r--r--lisp/emacs-lisp/bytecomp.el46
-rw-r--r--lisp/emacs-lisp/regexp-opt.el2
-rw-r--r--lisp/emacs-lisp/syntax.el247
-rw-r--r--lisp/epa-file.el17
-rw-r--r--lisp/font-lock.el45
-rw-r--r--lisp/gnus/.dir-locals.el3
-rw-r--r--lisp/gnus/ChangeLog88
-rw-r--r--lisp/gnus/gnus-async.el14
-rw-r--r--lisp/gnus/gnus-html.el242
-rw-r--r--lisp/gnus/gnus-registry.el2
-rw-r--r--lisp/gnus/gnus-start.el47
-rw-r--r--lisp/gnus/gnus-sum.el10
-rw-r--r--lisp/gnus/mail-source.el8
-rw-r--r--lisp/gnus/mm-decode.el4
-rw-r--r--lisp/gnus/nnrss.el58
-rw-r--r--lisp/gnus/pop3.el41
-rw-r--r--lisp/image.el15
-rw-r--r--lisp/international/ucs-normalize.el2
-rw-r--r--lisp/language/hebrew.el4
-rw-r--r--lisp/makefile.w32-in21
-rw-r--r--lisp/menu-bar.el24
-rw-r--r--lisp/net/imap.el240
-rw-r--r--lisp/net/netrc.el22
-rw-r--r--lisp/net/rcirc.el113
-rw-r--r--lisp/net/tramp-cache.el150
-rw-r--r--lisp/net/tramp-cmds.el8
-rw-r--r--lisp/net/tramp-compat.el103
-rw-r--r--lisp/net/tramp-fish.el1181
-rw-r--r--lisp/net/tramp-ftp.el32
-rw-r--r--lisp/net/tramp-gvfs.el55
-rw-r--r--lisp/net/tramp-gw.el32
-rw-r--r--lisp/net/tramp-imap.el27
-rw-r--r--lisp/net/tramp-sh.el5509
-rw-r--r--lisp/net/tramp-smb.el34
-rw-r--r--lisp/net/tramp-uu.el5
-rw-r--r--lisp/net/tramp.el6478
-rw-r--r--lisp/net/trampver.el17
-rw-r--r--lisp/notifications.el20
-rw-r--r--lisp/nxml/TODO468
-rw-r--r--lisp/obsolete/old-whitespace.el2
-rw-r--r--lisp/progmodes/ada-mode.el632
-rw-r--r--lisp/progmodes/antlr-mode.el2
-rw-r--r--lisp/progmodes/autoconf.el7
-rw-r--r--lisp/progmodes/cc-engine.el112
-rw-r--r--lisp/progmodes/cfengine.el20
-rw-r--r--lisp/progmodes/compile.el33
-rw-r--r--lisp/progmodes/cperl-mode.el8
-rw-r--r--lisp/progmodes/fortran.el19
-rw-r--r--lisp/progmodes/gud.el24
-rw-r--r--lisp/progmodes/js.el76
-rw-r--r--lisp/progmodes/make-mode.el37
-rw-r--r--lisp/progmodes/mixal-mode.el23
-rw-r--r--lisp/progmodes/octave-mod.el49
-rw-r--r--lisp/progmodes/perl-mode.el334
-rw-r--r--lisp/progmodes/python.el96
-rw-r--r--lisp/progmodes/ruby-mode.el390
-rw-r--r--lisp/progmodes/sh-script.el104
-rw-r--r--lisp/progmodes/simula.el28
-rw-r--r--lisp/progmodes/sql.el701
-rw-r--r--lisp/progmodes/tcl.el13
-rw-r--r--lisp/progmodes/vhdl-mode.el18
-rw-r--r--lisp/repeat.el7
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/subr.el59
-rw-r--r--lisp/textmodes/bibtex.el4
-rw-r--r--lisp/textmodes/ispell.el53
-rw-r--r--lisp/textmodes/reftex.el1
-rw-r--r--lisp/textmodes/sgml-mode.el11
-rw-r--r--lisp/textmodes/tex-mode.el16
-rw-r--r--lisp/textmodes/texinfo.el15
-rw-r--r--lisp/url/ChangeLog17
-rw-r--r--lisp/url/url-cache.el21
-rw-r--r--lisp/url/url-cookie.el36
-rw-r--r--lisp/url/url-gw.el22
-rw-r--r--lisp/url/url-history.el10
-rw-r--r--lisp/url/url-irc.el9
-rw-r--r--lisp/url/url-util.el2
-rw-r--r--lisp/url/url-vars.el40
-rw-r--r--lisp/vc/vc-hg.el8
-rwxr-xr-xmake-dist4
-rw-r--r--src/ChangeLog77
-rw-r--r--src/ChangeLog.102
-rw-r--r--src/ChangeLog.86
-rw-r--r--src/Makefile.in10
-rw-r--r--src/buffer.c2
-rw-r--r--src/charset.c2
-rw-r--r--src/cmds.c2
-rw-r--r--src/coding.c7
-rw-r--r--src/config.in3
-rw-r--r--src/editfns.c2
-rw-r--r--src/emacs.c4
-rw-r--r--src/fileio.c2
-rw-r--r--src/fns.c141
-rw-r--r--src/lisp.h6
-rw-r--r--src/term.c1
-rw-r--r--src/xml.c141
-rw-r--r--src/xterm.c156
-rw-r--r--test/ChangeLog4
-rw-r--r--test/indent/octave.m8
132 files changed, 11551 insertions, 10985 deletions
diff --git a/ChangeLog b/ChangeLog
index a5176fa66dd..a8879b330c9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
12010-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * configure.in (HAVE_LIBXML2): Check that the libxml2 we found can
4 be used. This fixes a conf problem on Mac OS X.
5
62010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
7
8 * configure.in: Check for libxml2.
9
102010-09-09 Glenn Morris <rgm@gnu.org>
11
12 * make-dist: No more TODO files under lisp/.
13
12010-09-04 Eli Zaretskii <eliz@gnu.org> 142010-09-04 Eli Zaretskii <eliz@gnu.org>
2 15
3 * config.bat: Produce lisp/gnus/_dir-locals.el from 16 * config.bat: Produce lisp/gnus/_dir-locals.el from
diff --git a/README.imagemagick b/README.imagemagick
deleted file mode 100644
index 792e9fd90ea..00000000000
--- a/README.imagemagick
+++ /dev/null
@@ -1,151 +0,0 @@
1* README for the ImageMagick Emacs branch
2
3This is the imagemagick branch of Emacs. Imagemagick can now be used
4to load many new image formats, and also do useful transforms like
5scaling and rotation.
6
7This file will attempt to contain draft NEWS, Changelog and manual
8entries for the new functionality.
9
10You might need to regenerate the configure scripts:
11aclocal
12automake
13autoheader
14autoconf
15./configure --with-imagemagick
16
17
18* TODO image-type-header-regexps priorities the jpeg loader over the
19imagemagick one. This is not wrong, but how should a user go about
20prefering the imagemagick loader? The user might like zooming etc in
21jpegs.
22
23try (setq image-type-header-regexps nil) for a quick hack to prefer
24imagemagick over the jpg loader.
25
26* TODO For some reason its unbearably slow to look at a page in a large
27 image bundle using the :index feature. The imagemagick "display"
28 command is also a bit slow, but nowhere near as slow as the emacs
29 code. It seems imagemagick tries to unpack every page when loading
30 the bundle. This feature is not the primary usecase for the
31 imagemagick patch though.
32
33 ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load.
34 It is now way faster to use the :index feature, but its still not
35 very fast.
36
37** DONE optimize number of pages calculation for bundles as suggested by
38 imagemagick forum: "set the density to something low like 2 and use
39 MagickPingImage()"
40
41** TODO try to cache the num pages calculation. it can take a while to
42 calculate the number of pages, and if you need to do it for each
43 page view, page-flipping becomes uselessly slow.
44
45* TODO integrate with image-dired
46
47* TODO integrate with docview.
48
49* TODO integrate with image-mode
50Some work has been done, M-x image-transform-fit-to-height will fit
51the image to the height of the Emacs window for instance.
52
53* TODO look for optimizations for handling images with low depth
54Currently the code seems to default to 24 bit RGB which is costly for
55images with lower bit depth.
56
57* TODO complete documentation drafts below
58
59* DONE fix inconsistencys with spelling of imagemagick in the src
60* DONE report number of images in image bundle types somehow
61Works like for "gif" support. Thanks to Juri Linkov.
62* DONE probably add pdf to inhibited types
63* DONE inhibit types is defconst should probably be defcustom
64* TODO decide what to do with some uncommitted imagemagick support
65 functions for image size etc.
66* TODO Test with more systems
67Tested on Fedora 12, Fedora 14 so far, and the libmagick that ships with it.
68Ubuntu 8.04 was also tested, but it seems it ships a broken
69ImageMagick.
70
71I also tried using an imagemagick compiled from their SVN, in
72parallell with the one packaged by Fedora, it worked well.
73
74* DONE Also need some way to handle render methods that only work on newer ImageMagicks
75Is handled by configure now
76
77* Some nits from Stefan Monnier
78I just took a quick look at the code and I see the following nits to fix:
79
80** DONE obviously a merge will have to come with a good ChangeLog.
81** DONE also the merge will need to come with documentation. Maybe not in the
82 Texinfo form yet, but at least in the etc/NEWS with enough info that
83 describes the `scale' and other such arguments that someone can start
84 using them.
85** DONE the README talks about naming inconsistencies, I think these should be
86 fixed before a first commit (should be straightforward).
87
88** DONE the "let" in image.el should not be followed by a line break and the while
89 should be replaced by a dolist.
90
91** DONE the prototype of imagemagick_load_image has some odd indentation in ([[2010.06.14]])
92 its args, not sure what happened.
93** DONE a few lines in the C code break the 80columns limit.
94** DONE please use ANSI style function declarations rather than K&R for new code. ([[2010.06.14]])
95** DONE you can get rid of the prototypes by reordering the code. ([[2010.06.14]])
96** DONE the docstrings in DEFUN should not be indented (they'll display ([[2010.06.14]])
97 weirdly otherwise in C-h f).
98** DONE Some "{" are at the end of a for/if rather than on their own line. ([[2010.06.14]])
99** DONE why use "*( imtypes + i)" rather than "imtypes[i]"? ([[2010.06.14]])
100** DONE some "," lack a space after them. ([[2010.06.14]])
101** DONE several "=" and "==" lack spaces around them. ([[2010.06.14]])
102
103
104* NEWS entry
105** ImageMagick support
106It is now possible to use the Imagemagick library to load many new
107image formats in Emacs.
108
109To enable, use the following configure option:
110--with-imagemagick
111
112The new function (imagemagick-types) returns a list of image file
113extensions that your installation of imagemagick supports.
114
115The function (imagemagick-register-types) will enable the imagemagick
116support for the extensions in imagemagick-types minus the types listed
117in imagemagick-types-inhibit.
118
119imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by default.
120This means imagemagick will be used also to load jpeg files, if you
121have both jpeg and imagemagick libraries linked. Add 'JPG to
122imagemagick-types-inhibit if you do not want this.
123
124imagemagick-render-type is a new variable which can be set to choose
125between screen render methods.
126
127- 0 is a conservative metod which works with older ImageMagick
128 versions. It is a bit slow, but robust.
129
130- 1 utilizes a newer ImageMagick method
131
132
133Images loaded with imagemagick will support a couple of new display
134specification behaviours:
135
136- if the :width and :height keywords are specified, these values are
137used for scaling the image. If only one of :width or :height is
138specified, the other one will be calculated so as to preserve the
139aspect ratio.If both :width and :height are specified, aspect ratio
140will not be preserved.
141
142- :rotation specifies a rotation angle in degrees.
143
144- :index specifies which image inside an image bundle file format, such
145as TIFF or DJVM, to view.
146
147The image-metadata function can be used to retrieve the total number
148of images in an image bundle. This is simmilar to how GIF files work.
149
150* Manual entry
151nothing yet, but the NEWS entry could be adapted.
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 88e21d7226e..211c6f0a530 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -95,7 +95,7 @@
95 (with-temp-buffer 95 (with-temp-buffer
96 ;; Insert a file of this format: 96 ;; Insert a file of this format:
97 ;; (CHAR NAME CATEGORY ...) 97 ;; (CHAR NAME CATEGORY ...)
98 ;; where CHAR is a charater code, the following elements are strings 98 ;; where CHAR is a character code, the following elements are strings
99 ;; representing character properties. 99 ;; representing character properties.
100 (insert-file-contents unidata-text-file) 100 (insert-file-contents unidata-text-file)
101 (goto-char (point-min)) 101 (goto-char (point-min))
diff --git a/configure b/configure
index 527c53690bd..f1ae71f73ac 100755
--- a/configure
+++ b/configure
@@ -660,6 +660,8 @@ BLESSMAIL_TARGET
660LIBS_MAIL 660LIBS_MAIL
661liblockfile 661liblockfile
662ALLOCA 662ALLOCA
663LIBXML2_LIBS
664LIBXML2_CFLAGS
663LIBXSM 665LIBXSM
664LIBGPM 666LIBGPM
665LIBGIF 667LIBGIF
@@ -807,6 +809,7 @@ with_tiff
807with_gif 809with_gif
808with_png 810with_png
809with_rsvg 811with_rsvg
812with_xml2
810with_imagemagick 813with_imagemagick
811with_xft 814with_xft
812with_libotf 815with_libotf
@@ -1514,6 +1517,7 @@ Optional Packages:
1514 --without-gif don't compile with GIF image support 1517 --without-gif don't compile with GIF image support
1515 --without-png don't compile with PNG image support 1518 --without-png don't compile with PNG image support
1516 --without-rsvg don't compile with SVG image support 1519 --without-rsvg don't compile with SVG image support
1520 --without-xml2 don't compile with XML parsing support
1517 --with-imagemagick compile with ImageMagick image support 1521 --with-imagemagick compile with ImageMagick image support
1518 --without-xft don't use XFT for anti aliased fonts 1522 --without-xft don't use XFT for anti aliased fonts
1519 --without-libotf don't use libotf for OpenType font support 1523 --without-libotf don't use libotf for OpenType font support
@@ -2732,6 +2736,14 @@ else
2732fi 2736fi
2733 2737
2734 2738
2739# Check whether --with-xml2 was given.
2740if test "${with_xml2+set}" = set; then :
2741 withval=$with_xml2;
2742else
2743 with_xml2=yes
2744fi
2745
2746
2735# Check whether --with-imagemagick was given. 2747# Check whether --with-imagemagick was given.
2736if test "${with_imagemagick+set}" = set; then : 2748if test "${with_imagemagick+set}" = set; then :
2737 withval=$with_imagemagick; 2749 withval=$with_imagemagick;
@@ -11070,6 +11082,160 @@ $as_echo "#define HAVE_X_SM 1" >>confdefs.h
11070fi 11082fi
11071 11083
11072 11084
11085### Use libxml (-lxml2) if available
11086if test "${with_xml2}" != "no"; then
11087 ### I'm not sure what the version number should be, so I just guessed.
11088
11089 succeeded=no
11090
11091 # Extract the first word of "pkg-config", so it can be a program name with args.
11092set dummy pkg-config; ac_word=$2
11093{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
11094$as_echo_n "checking for $ac_word... " >&6; }
11095if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
11096 $as_echo_n "(cached) " >&6
11097else
11098 case $PKG_CONFIG in
11099 [\\/]* | ?:[\\/]*)
11100 ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
11101 ;;
11102 *)
11103 as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
11104for as_dir in $PATH
11105do
11106 IFS=$as_save_IFS
11107 test -z "$as_dir" && as_dir=.
11108 for ac_exec_ext in '' $ac_executable_extensions; do
11109 if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
11110 ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
11111 $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
11112 break 2
11113 fi
11114done
11115 done
11116IFS=$as_save_IFS
11117
11118 test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
11119 ;;
11120esac
11121fi
11122PKG_CONFIG=$ac_cv_path_PKG_CONFIG
11123if test -n "$PKG_CONFIG"; then
11124 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
11125$as_echo "$PKG_CONFIG" >&6; }
11126else
11127 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
11128$as_echo "no" >&6; }
11129fi
11130
11131
11132
11133 if test "$PKG_CONFIG" = "no" ; then
11134 HAVE_LIBXML2=no
11135 else
11136 PKG_CONFIG_MIN_VERSION=0.9.0
11137 if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
11138 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.2.0" >&5
11139$as_echo_n "checking for libxml-2.0 > 2.2.0... " >&6; }
11140
11141 if $PKG_CONFIG --exists "libxml-2.0 > 2.2.0" 2>&5; then
11142 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
11143$as_echo "yes" >&6; }
11144 succeeded=yes
11145
11146 { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5
11147$as_echo_n "checking LIBXML2_CFLAGS... " >&6; }
11148 LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'`
11149 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5
11150$as_echo "$LIBXML2_CFLAGS" >&6; }
11151
11152 { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5
11153$as_echo_n "checking LIBXML2_LIBS... " >&6; }
11154 LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'`
11155 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5
11156$as_echo "$LIBXML2_LIBS" >&6; }
11157 else
11158 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
11159$as_echo "no" >&6; }
11160 LIBXML2_CFLAGS=""
11161 LIBXML2_LIBS=""
11162 ## If we have a custom action on failure, don't print errors, but
11163 ## do set a variable so people can do so.
11164 LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.2.0"`
11165
11166 fi
11167
11168
11169
11170 else
11171 echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
11172 echo "*** See http://www.freedesktop.org/software/pkgconfig"
11173 fi
11174 fi
11175
11176 if test $succeeded = yes; then
11177 HAVE_LIBXML2=yes
11178 else
11179 HAVE_LIBXML2=no
11180 fi
11181
11182 if test "${HAVE_LIBXML2}" = "yes"; then
11183 LIBS="$LIBXML2_LIBS $LIBS"
11184 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5
11185$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; }
11186if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then :
11187 $as_echo_n "(cached) " >&6
11188else
11189 ac_check_lib_save_LIBS=$LIBS
11190LIBS="-lxml2 $LIBS"
11191cat confdefs.h - <<_ACEOF >conftest.$ac_ext
11192/* end confdefs.h. */
11193
11194/* Override any GCC internal prototype to avoid an error.
11195 Use char because int might match the return type of a GCC
11196 builtin and then its argument prototype would still apply. */
11197#ifdef __cplusplus
11198extern "C"
11199#endif
11200char htmlReadMemory ();
11201int
11202main ()
11203{
11204return htmlReadMemory ();
11205 ;
11206 return 0;
11207}
11208_ACEOF
11209if ac_fn_c_try_link "$LINENO"; then :
11210 ac_cv_lib_xml2_htmlReadMemory=yes
11211else
11212 ac_cv_lib_xml2_htmlReadMemory=no
11213fi
11214rm -f core conftest.err conftest.$ac_objext \
11215 conftest$ac_exeext conftest.$ac_ext
11216LIBS=$ac_check_lib_save_LIBS
11217fi
11218{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5
11219$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; }
11220if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then :
11221 HAVE_LIBXML2=yes
11222else
11223 HAVE_LIBXML2=no
11224fi
11225
11226 if test "${HAVE_LIBXML2}" = "yes"; then
11227
11228$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h
11229
11230 else
11231 LIBXML2_LIBS=""
11232 LIBXML2_CFLAGS=""
11233 fi
11234 fi
11235fi
11236
11237
11238
11073# If netdb.h doesn't declare h_errno, we must declare it by hand. 11239# If netdb.h doesn't declare h_errno, we must declare it by hand.
11074{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 11240{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5
11075$as_echo_n "checking whether netdb declares h_errno... " >&6; } 11241$as_echo_n "checking whether netdb declares h_errno... " >&6; }
diff --git a/configure.in b/configure.in
index e69ce064c0c..b814b1a0236 100644
--- a/configure.in
+++ b/configure.in
@@ -155,6 +155,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support])
155OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) 155OPTION_DEFAULT_ON([gif],[don't compile with GIF image support])
156OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) 156OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
157OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) 157OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
158OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
158OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) 159OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
159 160
160OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) 161OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
@@ -2535,6 +2536,24 @@ if test "${HAVE_X11}" = "yes"; then
2535fi 2536fi
2536AC_SUBST(LIBXSM) 2537AC_SUBST(LIBXSM)
2537 2538
2539### Use libxml (-lxml2) if available
2540if test "${with_xml2}" != "no"; then
2541 ### I'm not sure what the version number should be, so I just guessed.
2542 PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.2.0, HAVE_LIBXML2=yes, HAVE_LIBXML2=no)
2543 if test "${HAVE_LIBXML2}" = "yes"; then
2544 LIBS="$LIBXML2_LIBS $LIBS"
2545 AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no)
2546 if test "${HAVE_LIBXML2}" = "yes"; then
2547 AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).])
2548 else
2549 LIBXML2_LIBS=""
2550 LIBXML2_CFLAGS=""
2551 fi
2552 fi
2553fi
2554AC_SUBST(LIBXML2_LIBS)
2555AC_SUBST(LIBXML2_CFLAGS)
2556
2538# If netdb.h doesn't declare h_errno, we must declare it by hand. 2557# If netdb.h doesn't declare h_errno, we must declare it by hand.
2539AC_CACHE_CHECK(whether netdb declares h_errno, 2558AC_CACHE_CHECK(whether netdb declares h_errno,
2540 emacs_cv_netdb_declares_h_errno, 2559 emacs_cv_netdb_declares_h_errno,
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 0be5e5d86bb..80be53432e0 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,23 @@
12010-09-14 Glenn Morris <rgm@gnu.org>
2
3 * cal-xtra.texi (Fancy Diary Display): Emphasize that sort should be
4 the last hook item.
5
6 * calendar.texi (Appointments): Also updated when a diary include file
7 is saved.
8
92010-09-14 Glenn Morris <rgm@gnu.org>
10
11 * trouble.texi (Bugs): Update the section intro.
12 (Known Problems): New section.
13 (Checklist): Misc updates. Prefer M-x report-emacs-bug.
14 (Sending Patches): Bug fixes are best as responses to existing bugs.
15 * emacs.texi (Known Problems): Add menu entry for new section.
16
172010-09-09 Glenn Morris <rgm@gnu.org>
18
19 * xresources.texi: Untabify.
20
12010-09-06 Chong Yidong <cyd@stupidchicken.com> 212010-09-06 Chong Yidong <cyd@stupidchicken.com>
2 22
3 * dired.texi (Dired Enter): Minor doc fix (Bug#6982). 23 * dired.texi (Dired Enter): Minor doc fix (Bug#6982).
diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi
index 60588542356..de36ccc4f5f 100644
--- a/doc/emacs/cal-xtra.texi
+++ b/doc/emacs/cal-xtra.texi
@@ -613,7 +613,9 @@ each day's diary entries by their time of day. Here's how:
613@noindent 613@noindent
614For each day, this sorts diary entries that begin with a recognizable 614For each day, this sorts diary entries that begin with a recognizable
615time of day according to their times. Diary entries without times come 615time of day according to their times. Diary entries without times come
616first within each day. 616first within each day. Note how the sort command is placed at the end
617of the hook list, in case earlier members of the list change the order
618of the diary entries, or add items.
617 619
618@vindex diary-include-string 620@vindex diary-include-string
619 Your main diary file can include other files. This permits a group of 621 Your main diary file can include other files. This permits a group of
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 5698fd5ff58..89504764d7d 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -1508,7 +1508,14 @@ automatically just after midnight. You can force an update at any
1508time by re-enabling appointment notification. Both these actions also 1508time by re-enabling appointment notification. Both these actions also
1509display the day's diary buffer, unless you set 1509display the day's diary buffer, unless you set
1510@code{appt-display-diary} to @code{nil}. The appointments list is 1510@code{appt-display-diary} to @code{nil}. The appointments list is
1511also updated whenever the diary file is saved. 1511also updated whenever the diary file (or a file it includes; see
1512@iftex
1513@inforef{Fancy Diary Display,, emacs-xtra})
1514@end iftex
1515@ifnottex
1516@ref{Fancy Diary Display})
1517@end ifnottex
1518is saved.
1512 1519
1513@findex appt-add 1520@findex appt-add
1514@findex appt-delete 1521@findex appt-delete
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 4de9ee4a57a..17337d2c592 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -1137,6 +1137,7 @@ Dealing with Emacs Trouble
1137 1137
1138Reporting Bugs 1138Reporting Bugs
1139 1139
1140* Known Problems:: How to read about known problems and bugs.
1140* Bug Criteria:: Have you really found a bug? 1141* Bug Criteria:: Have you really found a bug?
1141* Understanding Bug Reporting:: How to report a bug effectively. 1142* Understanding Bug Reporting:: How to report a bug effectively.
1142* Checklist:: Steps to follow for a good bug report. 1143* Checklist:: Steps to follow for a good bug report.
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 0390b7da910..2f90b30bf83 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -409,29 +409,76 @@ say something to the psychotherapist, you must end it by typing
409@section Reporting Bugs 409@section Reporting Bugs
410 410
411@cindex bugs 411@cindex bugs
412 Sometimes you will encounter a bug in Emacs. Although we cannot 412 If you think you have found a bug in Emacs, please report it. We
413promise we can or will fix the bug, and we might not even agree that it 413cannot promise to fix it, or always to agree that it is a bug, but we
414is a bug, we want to hear about problems you encounter. Often we agree 414certainly want to hear about it. The same applies for new features
415they are bugs and want to fix them. 415you would like to see added. The following sections will help you to
416 416construct an effective bug report.
417 To make it possible for us to fix a bug, you must report it. In order
418to do so effectively, you must know when and how to do it.
419
420 Before reporting a bug, it is a good idea to see if it is already
421known. You can find the list of known problems in the file
422@file{etc/PROBLEMS} in the Emacs distribution; type @kbd{C-h C-p} to read
423it. Some additional user-level problems can be found in @ref{Bugs and
424problems, , Bugs and problems, efaq, GNU Emacs FAQ}. Looking up your
425problem in these two documents might provide you with a solution or a
426work-around, or give you additional information about related issues.
427 417
428@menu 418@menu
419* Known Problems:: How to read about known problems and bugs.
429* Criteria: Bug Criteria. Have you really found a bug? 420* Criteria: Bug Criteria. Have you really found a bug?
430* Understanding Bug Reporting:: How to report a bug effectively. 421* Understanding Bug Reporting:: How to report a bug effectively.
431* Checklist:: Steps to follow for a good bug report. 422* Checklist:: Steps to follow for a good bug report.
432* Sending Patches:: How to send a patch for GNU Emacs. 423* Sending Patches:: How to send a patch for GNU Emacs.
433@end menu 424@end menu
434 425
426@node Known Problems
427@subsection Reading Existing Bug Reports and Known Problems
428
429 Before reporting a bug, if at all possible please check to see if it
430is already known about. Indeed, it may already have been fixed in a
431later release of Emacs, or in the development version. Here is a list
432of the main places you can read about known issues:
433
434@itemize
435@item
436The @file{etc/PROBLEMS} file in the Emacs distribution; type @kbd{C-h
437C-p} to read it. This file contains a list of particularly well-known
438issues that have been encountered in compiling, installing and running
439Emacs. Often, there are suggestions for workarounds and solutions.
440
441@item
442Some additional user-level problems can be found in @ref{Bugs and
443problems, , Bugs and problems, efaq, GNU Emacs FAQ}.
444
445@item
446The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup
447@samp{gnu.emacs.bug}). This is where you will find most Emacs bug
448reports. You can read the list archives at
449@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. If you
450like, you can also subscribe to the list. Be aware that the sole
451purpose of this list is to provide the Emacs maintainers with
452information about bugs and feature requests. Reports may contain
453fairly large amounts of data; spectators should not complain about
454this.
455
456@item
457The bug tracker at @url{http://debbugs.gnu.org}. From early 2008,
458reports from the @samp{bug-gnu-emacs} list have been sent here. The
459tracker contains the same information as the mailing list, just in a
460different format. You may prefer to browse and read reports using the
461tracker.
462
463@item
464The @samp{emacs-pretest-bug} mailing list. This list is no longer
465used, and is mainly of historical interest. At one time, it was used
466for bug reports in development (i.e., not yet released) versions of
467Emacs. You can read the archives for 2003 to mid 2007 at
468@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. From
469late 2007 to mid 2008, the address was an alias for the
470@samp{emacs-devel} mailing list. From mid 2008 onwards, it has been
471an alias for @samp{bug-gnu-emacs}.
472
473@item
474The @samp{emacs-devel} mailing list. Sometimes people report bugs to
475this mailing list. This is not the main purpose of the list, however,
476and it is much better to send bug reports to the bug list. You should
477not feel obliged to read this list before reporting a bug.
478
479@end itemize
480
481
435@node Bug Criteria 482@node Bug Criteria
436@subsection When Is There a Bug 483@subsection When Is There a Bug
437 484
@@ -540,56 +587,81 @@ well.
540@subsection Checklist for Bug Reports 587@subsection Checklist for Bug Reports
541 588
542@cindex reporting bugs 589@cindex reporting bugs
543 The best way to send a bug report is to mail it electronically to the 590
544Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}. (If you want to 591 Before reporting a bug, first try to see if the problem has already
545suggest a change as an improvement, use the same address.) 592been reported (@pxref{Known Problems}).
546 593
547 If you'd like to read the bug reports, you can find them on the 594If you are able to, try the latest release of Emacs to see if the
548newsgroup @samp{gnu.emacs.bug}; keep in mind, however, that as a 595problem has already been fixed. Even better is to try the latest
549spectator you should not criticize anything about what you see there. 596development version. We recognize that this is not easy for some
550The purpose of bug reports is to give information to the Emacs 597people, so do not feel that you absolutely must do this before making
551maintainers. Spectators are welcome only as long as they do not 598a report.
552interfere with this. In particular, some bug reports contain fairly
553large amounts of data; spectators should not complain about this.
554
555 Please do not post bug reports using netnews; mail is more reliable
556than netnews about reporting your correct address, which we may need
557in order to ask you for more information. If your data is more than
558500,000 bytes, please don't include it directly in the bug report;
559instead, offer to send it on request, or make it available by ftp and
560say where.
561 599
562@findex report-emacs-bug 600@findex report-emacs-bug
563 A convenient way to send a bug report for Emacs is to use the command 601 The best way to write a bug report for Emacs is to use the command
564@kbd{M-x report-emacs-bug}. This sets up a mail buffer (@pxref{Sending 602@kbd{M-x report-emacs-bug}. This sets up a mail buffer
565Mail}) and automatically inserts @emph{some} of the essential 603(@pxref{Sending Mail}) and automatically inserts @emph{some} of the
566information. However, it cannot supply all the necessary information; 604essential information. However, it cannot supply all the necessary
567you should still read and follow the guidelines below, so you can enter 605information; you should still read and follow the guidelines below, so
568the other crucial information by hand before you send the message. 606you can enter the other crucial information by hand before you send
607the message. You may feel that some of the information inserted by
608@kbd{M-x report-emacs-bug} is not relevant, but unless you are
609absolutely sure it is best to leave it, so that the developers can
610decide for themselves.
611
612When you have finished writing your report, type @kbd{C-c C-c} and it
613will be sent to the Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}.
614(If you want to suggest an improvement or new feature, use the same
615address.) If you cannot send mail from inside Emacs, you can copy the
616text of your report to your normal mail client and send it to that
617address. Or you can simply send an email to that address describing
618the problem.
619
620Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
621stored in the tracker at @url{http://debbugs.gnu.org}. Please try to
622include a valid reply email address, in case we need to ask you for
623more information about your report. Submissions are moderated, so
624there may be a delay before your report appears.
625
626You do not need to know how the @url{http://debbugs.gnu.org} bug
627tracker works in order to report a bug, but if you want to, you can
628read the tracker's online documentation to see the various features
629you can use.
630
631All mail sent to the @samp{bug-gnu-emacs} mailing list is also
632gatewayed to the @samp{bug.gnu.emacs} newsgroup. The reverse is also
633true, but we ask you not to post bug reports via the newsgroup. It
634can make it much harder to contact you if we need to ask for more
635information, and it does not integrate well with the bug tracker.
636
637If your data is more than 500,000 bytes, please don't include it
638directly in the bug report; instead, offer to send it on request, or
639make it available by ftp and say where.
569 640
570 To enable maintainers to investigate a bug, your report 641 To enable maintainers to investigate a bug, your report
571should include all these things: 642should include all these things:
572 643
573@itemize @bullet 644@itemize @bullet
574@item 645@item
575The version number of Emacs. Without this, we won't know whether there 646The version number of Emacs. Without this, we won't know whether there is any
576is any point in looking for the bug in the current version of GNU 647point in looking for the bug in the current version of GNU Emacs.
577Emacs.
578 648
579You can get the version number by typing @kbd{M-x emacs-version 649@kbd{M-x report-emacs-bug} includes this information automatically,
580@key{RET}}. If that command does not work, you probably have something 650but if you are not using that command for your report you can get the
581other than GNU Emacs, so you will have to report the bug somewhere 651version number by typing @kbd{M-x emacs-version @key{RET}}. If that
582else. 652command does not work, you probably have something other than GNU
653Emacs, so you will have to report the bug somewhere else.
583 654
584@item 655@item
585The type of machine you are using, and the operating system name and 656The type of machine you are using, and the operating system name and
586version number. @kbd{M-x emacs-version @key{RET}} provides this 657version number (again, automatically included by @kbd{M-x
587information too. Copy its output from the @samp{*Messages*} buffer, so 658report-emacs-bug}). @kbd{M-x emacs-version @key{RET}} provides this
588that you get it all and get it accurately. 659information too. Copy its output from the @samp{*Messages*} buffer,
660so that you get it all and get it accurately.
589 661
590@item 662@item
591The operands given to the @code{configure} command when Emacs was 663The operands given to the @code{configure} command when Emacs was
592installed. 664installed (automatically included by @kbd{M-x report-emacs-bug}).
593 665
594@item 666@item
595A complete list of any modifications you have made to the Emacs source. 667A complete list of any modifications you have made to the Emacs source.
@@ -619,12 +691,15 @@ the last line is terminated, but try telling the bugs that).
619 691
620@item 692@item
621The precise commands we need to type to reproduce the bug. 693The precise commands we need to type to reproduce the bug.
694If at all possible, give a full recipe for an Emacs started with the
695@samp{-Q} option (@pxref{Initial Options}). This bypasses your
696@file{.emacs} customizations.
622 697
623@findex open-dribble-file 698@findex open-dribble-file
624@cindex dribble file 699@cindex dribble file
625@cindex logging keystrokes 700@cindex logging keystrokes
626The easy way to record the input to Emacs precisely is to write a 701One way to record the input to Emacs precisely is to write a dribble
627dribble file. To start the file, execute the Lisp expression 702file. To start the file, execute the Lisp expression
628 703
629@example 704@example
630(open-dribble-file "~/dribble") 705(open-dribble-file "~/dribble")
@@ -735,7 +810,7 @@ Check whether any programs you have loaded into the Lisp world,
735including your @file{.emacs} file, set any variables that may affect the 810including your @file{.emacs} file, set any variables that may affect the
736functioning of Emacs. Also, see whether the problem happens in a 811functioning of Emacs. Also, see whether the problem happens in a
737freshly started Emacs without loading your @file{.emacs} file (start 812freshly started Emacs without loading your @file{.emacs} file (start
738Emacs with the @code{-q} switch to prevent loading the init file). If 813Emacs with the @code{-Q} switch to prevent loading the init files). If
739the problem does @emph{not} occur then, you must report the precise 814the problem does @emph{not} occur then, you must report the precise
740contents of any programs that you must load into the Lisp world in order 815contents of any programs that you must load into the Lisp world in order
741to cause the problem to occur. 816to cause the problem to occur.
@@ -907,12 +982,10 @@ your best to help.
907@itemize @bullet 982@itemize @bullet
908@item 983@item
909Send an explanation with your changes of what problem they fix or what 984Send an explanation with your changes of what problem they fix or what
910improvement they bring about. For a bug fix, just include a copy of the 985improvement they bring about. For a fix for an existing bug, it is
911bug report, and explain why the change fixes the bug. 986best to reply to the relevant discussion on the @samp{bug-gnu-emacs}
912 987list, or item in the @url{http://debbugs.gnu.org} tracker. Explain
913(Referring to a bug report is not as good as including it, because then 988why your change fixes the bug.
914we will have to look it up, and we have probably already deleted it if
915we've already fixed the bug.)
916 989
917@item 990@item
918Always include a proper bug report for the problem you think you have 991Always include a proper bug report for the problem you think you have
diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi
index 2a543eeee08..ecf5c02f32b 100644
--- a/doc/emacs/xresources.texi
+++ b/doc/emacs/xresources.texi
@@ -480,7 +480,7 @@ Emacs.menu*.font: 8x16
480For dialog boxes, use @samp{dialog*}: 480For dialog boxes, use @samp{dialog*}:
481 481
482@example 482@example
483Emacs.dialog*.faceName: Sans-12 483Emacs.dialog*.faceName: Sans-12
484@end example 484@end example
485 485
486@noindent 486@noindent
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 5534283ccd1..e3df5fab9e9 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,11 @@
12010-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * syntax.texi (Syntax Flags): Document new `c' flag.
4
52010-09-09 Glenn Morris <rgm@gnu.org>
6
7 * display.texi (ImageMagick Images): General cleanup.
8
12010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) 92010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change)
2 10
3 * files.texi (Directory Names): Use \` rather than ^. 11 * files.texi (Directory Names): Use \` rather than ^.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index a565b4dd6ff..037c334ab88 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -4468,47 +4468,56 @@ specifying the bounding box of the PostScript image, analogous to the
4468 4468
4469@node ImageMagick Images 4469@node ImageMagick Images
4470@subsection ImageMagick Images 4470@subsection ImageMagick Images
4471The Imagemagick library can be used to load many image formats in Emacs. 4471@cindex ImageMagick images
4472@cindex images, support for more formats
4473
4474 If you build Emacs with ImageMagick (@url{http://www.imagemagick.org})
4475support, you can use the ImageMagick library to load many image formats.
4476
4477@findex imagemagick-types
4478The function @code{imagemagick-types} returns a list of image file
4479extensions that your installation of ImageMagick supports. To enable
4480support, you must call the function @code{imagemagick-register-types}.
4481
4482@vindex imagemagick-types-inhibit
4483The variable @code{imagemagick-types-inhibit} specifies a list of
4484image types that you do @emph{not} want ImageMagick to handle. There
4485may be overlap between image loaders in your Emacs installation, and
4486you may prefer to use a different one for a given image type (which
4487@c FIXME how is this priority determined?
4488loader will be used in practice depends on the priority of the loaders).
4489@c FIXME why are these uppercase when image-types is lower-case?
4490@c FIXME what are the possibe options? Are these actually file extensions?
4491For example, if you never want to use the ImageMagick loader to use
4492JPEG files, add @code{JPG} to this list.
4493
4494@vindex imagemagick-render-type
4495You can set the variable @code{imagemagick-render-type} to choose
4496between screen render methods for the ImageMagick loader. The options
4497are: @code{0}, a conservative method which works with older
4498@c FIXME details of this "newer method"?
4499@c Presumably it is faster but may be less "robust"?
4500ImageMagick versions (it is a bit slow, but robust); and @code{1},
4501a newer ImageMagick method.
4502
4503Images loaded with ImageMagick support a few new display specifications:
4472 4504
4473The function (imagemagick-types) returns a list of image file 4505@table @code
4474extensions that your installation of imagemagick supports. 4506@item :width, :height
4475 4507The @code{:width} and @code{:height} keywords are used for scaling the
4476The function (imagemagick-register-types) will enable the imagemagick 4508image. If only one of them is specified, the other one will be
4477support for the extensions in imagemagick-types minus the types listed 4509calculated so as to preserve the aspect ratio. If both are specified,
4478in imagemagick-types-inhibit. 4510aspect ratio may not be preserved.
4479 4511
4480imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by 4512@item :rotation
4481default. There can be overlap between image loaders in your Emacs 4513Specifies a rotation angle in degrees.
4482installation. If you never want to use the ImageMagick loader to use 4514
4483Jpeg files, for instance, add 'JPG to imagemagick-types-inhibit. Which 4515@item :index
4484loader that will be used in practice depends on the priority of the 4516Specifies which image to view inside an image bundle file format, such
4485loaders. 4517as TIFF or DJVM. You can use the @code{image-metadata} function to
4486 4518retrieve the total number of images in an image bundle (this is
4487imagemagick-render-type is a new variable which can be set to choose 4519similar to how GIF files work).
4488between screen render methods for the ImageMagick loader. 4520@end table
4489
4490- 0 is a conservative metod which works with older ImageMagick
4491 versions. It is a bit slow, but robust.
4492
4493- 1 utilizes a newer ImageMagick method
4494
4495
4496Images loaded with imagemagick will support a couple of new display
4497specification behaviours:
4498
4499- if the :width and :height keywords are specified, these values are
4500used for scaling the image. If only one of :width or :height is
4501specified, the other one will be calculated so as to preserve the
4502aspect ratio.If both :width and :height are specified, aspect ratio
4503will not be preserved.
4504
4505- :rotation specifies a rotation angle in degrees.
4506
4507- :index specifies which image inside an image bundle file format, such
4508as TIFF or DJVM, to view.
4509
4510The image-metadata function can be used to retrieve the total number
4511of images in an image bundle. This is simmilar to how GIF files work.
4512 4521
4513 4522
4514@node Other Image Types 4523@node Other Image Types
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 9add9b76e79..a608db16f89 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -292,19 +292,21 @@ identifying them as generic string delimiters.
292@cindex syntax flags 292@cindex syntax flags
293 293
294 In addition to the classes, entries for characters in a syntax table 294 In addition to the classes, entries for characters in a syntax table
295can specify flags. There are seven possible flags, represented by the 295can specify flags. There are eight possible flags, represented by the
296characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{n}, 296characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{c},
297and @samp{p}. 297@samp{n}, and @samp{p}.
298 298
299 All the flags except @samp{n} and @samp{p} are used to describe 299 All the flags except @samp{p} are used to describe comment
300multi-character comment delimiters. The digit flags indicate that a 300delimiters. The digit flags are used for comment delimiters made up
301character can @emph{also} be part of a comment sequence, in addition to 301of 2 characters. They indicate that a character can @emph{also} be
302the syntactic properties associated with its character class. The flags 302part of a comment sequence, in addition to the syntactic properties
303are independent of the class and each other for the sake of characters 303associated with its character class. The flags are independent of the
304such as @samp{*} in C mode, which is a punctuation character, @emph{and} 304class and each other for the sake of characters such as @samp{*} in
305the second character of a start-of-comment sequence (@samp{/*}), 305C mode, which is a punctuation character, @emph{and} the second
306@emph{and} the first character of an end-of-comment sequence 306character of a start-of-comment sequence (@samp{/*}), @emph{and} the
307(@samp{*/}). 307first character of an end-of-comment sequence (@samp{*/}). The flags
308@samp{b}, @samp{c}, and @samp{n} are used to qualify the corresponding
309comment delimiter.
308 310
309 Here is a table of the possible flags for a character @var{c}, 311 Here is a table of the possible flags for a character @var{c},
310and what they mean: 312and what they mean:
@@ -325,63 +327,62 @@ sequence.
325@samp{4} means @var{c} is the second character of such a sequence. 327@samp{4} means @var{c} is the second character of such a sequence.
326 328
327@item 329@item
328@c Emacs 19 feature
329@samp{b} means that @var{c} as a comment delimiter belongs to the 330@samp{b} means that @var{c} as a comment delimiter belongs to the
330alternative ``b'' comment style. 331alternative ``b'' comment style. For a two-character comment starter,
332this flag is only significant on the second char, and for a 2-character
333comment ender it is only significant on the first char.
331 334
332Emacs supports two comment styles simultaneously in any one syntax 335@item
333table. This is for the sake of C++. Each style of comment syntax has 336@samp{c} means that @var{c} as a comment delimiter belongs to the
334its own comment-start sequence and its own comment-end sequence. Each 337alternative ``c'' comment style. For a two-character comment
335comment must stick to one style or the other; thus, if it starts with 338delimiter, @samp{c} on either character makes it of style ``c''.
336the comment-start sequence of style ``b,'' it must also end with the
337comment-end sequence of style ``b.''
338 339
339The two comment-start sequences must begin with the same character; only 340@item
340the second character may differ. Mark the second character of the 341@samp{n} on a comment delimiter character specifies
341``b''-style comment-start sequence with the @samp{b} flag. 342that this kind of comment can be nested. For a two-character
343comment delimiter, @samp{n} on either character makes it
344nestable.
342 345
343A comment-end sequence (one or two characters) applies to the ``b'' 346Emacs supports several comment styles simultaneously in any one syntax
344style if its first character has the @samp{b} flag set; otherwise, it 347table. A comment style is a set of flags @samp{b}, @samp{c}, and
345applies to the ``a'' style. 348@samp{n}, so there can be up to 8 different comment styles.
349Each comment delimiter has a style and only matches comment delimiters
350of the same style. Thus if a comment starts with the comment-start
351sequence of style ``bn'', it will extend until the next matching
352comment-end sequence of style ``bn''.
346 353
347The appropriate comment syntax settings for C++ are as follows: 354The appropriate comment syntax settings for C++ can be as follows:
348 355
349@table @asis 356@table @asis
350@item @samp{/} 357@item @samp{/}
351@samp{124b} 358@samp{124}
352@item @samp{*} 359@item @samp{*}
353@samp{23} 360@samp{23b}
354@item newline 361@item newline
355@samp{>b} 362@samp{>}
356@end table 363@end table
357 364
358This defines four comment-delimiting sequences: 365This defines four comment-delimiting sequences:
359 366
360@table @asis 367@table @asis
361@item @samp{/*} 368@item @samp{/*}
362This is a comment-start sequence for ``a'' style because the 369This is a comment-start sequence for ``b'' style because the
363second character, @samp{*}, does not have the @samp{b} flag. 370second character, @samp{*}, has the @samp{b} flag.
364 371
365@item @samp{//} 372@item @samp{//}
366This is a comment-start sequence for ``b'' style because the second 373This is a comment-start sequence for ``a'' style because the second
367character, @samp{/}, does have the @samp{b} flag. 374character, @samp{/}, does not have the @samp{b} flag.
368 375
369@item @samp{*/} 376@item @samp{*/}
370This is a comment-end sequence for ``a'' style because the first 377This is a comment-end sequence for ``b'' style because the first
371character, @samp{*}, does not have the @samp{b} flag. 378character, @samp{*}, does have the @samp{b} flag.
372 379
373@item newline 380@item newline
374This is a comment-end sequence for ``b'' style, because the newline 381This is a comment-end sequence for ``a'' style, because the newline
375character has the @samp{b} flag. 382character does not have the @samp{b} flag.
376@end table 383@end table
377 384
378@item 385@item
379@samp{n} on a comment delimiter character specifies
380that this kind of comment can be nested. For a two-character
381comment delimiter, @samp{n} on either character makes it
382nestable.
383
384@item
385@c Emacs 19 feature 386@c Emacs 19 feature
386@samp{p} identifies an additional ``prefix character'' for Lisp syntax. 387@samp{p} identifies an additional ``prefix character'' for Lisp syntax.
387These characters are treated as whitespace when they appear between 388These characters are treated as whitespace when they appear between
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 142a071f494..ff4e65d299f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -59,6 +59,7 @@ the character after point.
59 position stored in a register. 59 position stored in a register.
60* Base 64:: Conversion to or from base 64 encoding. 60* Base 64:: Conversion to or from base 64 encoding.
61* MD5 Checksum:: Compute the MD5 "message digest"/"checksum". 61* MD5 Checksum:: Compute the MD5 "message digest"/"checksum".
62* Parsing HTML:: Parsing HTML and XML.
62* Atomic Changes:: Installing several buffer changes "atomically". 63* Atomic Changes:: Installing several buffer changes "atomically".
63* Change Hooks:: Supplying functions to be run when text is changed. 64* Change Hooks:: Supplying functions to be run when text is changed.
64@end menu 65@end menu
@@ -4106,6 +4107,49 @@ using the specified or chosen coding system. However, if
4106coding instead. 4107coding instead.
4107@end defun 4108@end defun
4108 4109
4110@node Parsing HTML
4111@section Parsing HTML
4112@cindex parsing html
4113@cindex parsing xml
4114
4115Emacs provides an interface to the @code{libxml2} library via two
4116functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The
4117HTML function will parse ``real world'' HTML and try to return a
4118sensible parse tree, while the XML function is somewhat stricter about
4119syntax.
4120
4121They both take a two optional parameter. The first is a buffer, and
4122the second is a base URL to be used to expand relative URLs in the
4123document, if any.
4124
4125Here's an example demonstrating the structure of the parsed data you
4126get out. Given this HTML document:
4127
4128@example
4129<html><hEad></head><body width=101><div class=thing>Foo<div>Yes
4130@end example
4131
4132You get this parse tree:
4133
4134@example
4135(html
4136 (head)
4137 (body
4138 (:width . "101")
4139 (div
4140 (:class . "thing")
4141 (text . "Foo")
4142 (div
4143 (text . "Yes\n")))))
4144@end example
4145
4146It's a simple tree structure, where the @code{car} for each node is
4147the name of the node, and the @code{cdr} is the value, or the list of
4148values.
4149
4150Attributes are coded the same way as child nodes, but with @samp{:} as
4151the first character.
4152
4109@node Atomic Changes 4153@node Atomic Changes
4110@section Atomic Change Groups 4154@section Atomic Change Groups
4111@cindex atomic changes 4155@cindex atomic changes
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 3c2a1f4169a..d8346259c6f 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,19 @@
12010-09-13 Michael Albinus <michael.albinus@gmx.de>
2
3 * tramp.texi (Inline methods): Remove "ssh1_old", "ssh2_old" and
4 "fish" methods.
5 (External methods): Remove "scp1_old" and "scp2_old" methods.
6
72010-09-09 Michael Albinus <michael.albinus@gmx.de>
8
9 * tramp.texi: Remove Japanese manual. Fix typo.
10
11 * trampver.texi: Update release number. Remove japanesemanual.
12
132010-09-09 Glenn Morris <rgm@gnu.org>
14
15 * org.texi: Restore clobbered changes (copyright years, untabify).
16
12010-09-04 Julien Danjou <julien@danjou.info> (tiny change) 172010-09-04 Julien Danjou <julien@danjou.info> (tiny change)
2 18
3 * gnus.texi (Adaptive Scoring): Fix typo. 19 * gnus.texi (Adaptive Scoring): Fix typo.
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 9074f171e4b..97b8d3ebc03 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -51,7 +51,8 @@ e.g.,
51@copying 51@copying
52This manual is for Org version @value{VERSION}. 52This manual is for Org version @value{VERSION}.
53 53
54Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation 54Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009, 2010
55Free Software Foundation, Inc.
55 56
56@quotation 57@quotation
57Permission is granted to copy, distribute and/or modify this document 58Permission is granted to copy, distribute and/or modify this document
@@ -101,400 +102,400 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison,
101@end ifnottex 102@end ifnottex
102 103
103@menu 104@menu
104* Introduction:: Getting started 105* Introduction:: Getting started
105* Document Structure:: A tree works like your brain 106* Document Structure:: A tree works like your brain
106* Tables:: Pure magic for quick formatting 107* Tables:: Pure magic for quick formatting
107* Hyperlinks:: Notes in context 108* Hyperlinks:: Notes in context
108* TODO Items:: Every tree branch can be a TODO item 109* TODO Items:: Every tree branch can be a TODO item
109* Tags:: Tagging headlines and matching sets of tags 110* Tags:: Tagging headlines and matching sets of tags
110* Properties and Columns:: Storing information about an entry 111* Properties and Columns:: Storing information about an entry
111* Dates and Times:: Making items useful for planning 112* Dates and Times:: Making items useful for planning
112* Capture - Refile - Archive:: The ins and outs for projects 113* Capture - Refile - Archive:: The ins and outs for projects
113* Agenda Views:: Collecting information into views 114* Agenda Views:: Collecting information into views
114* Markup:: Prepare text for rich export 115* Markup:: Prepare text for rich export
115* Exporting:: Sharing and publishing of notes 116* Exporting:: Sharing and publishing of notes
116* Publishing:: Create a web site of linked Org files 117* Publishing:: Create a web site of linked Org files
117* Working With Source Code:: Export, evaluate, and tangle code blocks 118* Working With Source Code:: Export, evaluate, and tangle code blocks
118* Miscellaneous:: All the rest which did not fit elsewhere 119* Miscellaneous:: All the rest which did not fit elsewhere
119* Hacking:: How to hack your way around 120* Hacking:: How to hack your way around
120* MobileOrg:: Viewing and capture on a mobile device 121* MobileOrg:: Viewing and capture on a mobile device
121* History and Acknowledgments:: How Org came into being 122* History and Acknowledgments:: How Org came into being
122* Main Index:: An index of Org's concepts and features 123* Main Index:: An index of Org's concepts and features
123* Key Index:: Key bindings and where they are described 124* Key Index:: Key bindings and where they are described
124* Variable Index:: Variables mentioned in the manual 125* Variable Index:: Variables mentioned in the manual
125 126
126@detailmenu 127@detailmenu
127 --- The Detailed Node Listing --- 128 --- The Detailed Node Listing ---
128 129
129Introduction 130Introduction
130 131
131* Summary:: Brief summary of what Org does 132* Summary:: Brief summary of what Org does
132* Installation:: How to install a downloaded version of Org 133* Installation:: How to install a downloaded version of Org
133* Activation:: How to activate Org for certain buffers 134* Activation:: How to activate Org for certain buffers
134* Feedback:: Bug reports, ideas, patches etc. 135* Feedback:: Bug reports, ideas, patches etc.
135* Conventions:: Type-setting conventions in the manual 136* Conventions:: Type-setting conventions in the manual
136 137
137Document structure 138Document structure
138 139
139* Outlines:: Org is based on Outline mode 140* Outlines:: Org is based on Outline mode
140* Headlines:: How to typeset Org tree headlines 141* Headlines:: How to typeset Org tree headlines
141* Visibility cycling:: Show and hide, much simplified 142* Visibility cycling:: Show and hide, much simplified
142* Motion:: Jumping to other headlines 143* Motion:: Jumping to other headlines
143* Structure editing:: Changing sequence and level of headlines 144* Structure editing:: Changing sequence and level of headlines
144* Sparse trees:: Matches embedded in context 145* Sparse trees:: Matches embedded in context
145* Plain lists:: Additional structure within an entry 146* Plain lists:: Additional structure within an entry
146* Drawers:: Tucking stuff away 147* Drawers:: Tucking stuff away
147* Blocks:: Folding blocks 148* Blocks:: Folding blocks
148* Footnotes:: How footnotes are defined in Org's syntax 149* Footnotes:: How footnotes are defined in Org's syntax
149* Orgstruct mode:: Structure editing outside Org 150* Orgstruct mode:: Structure editing outside Org
150 151
151Tables 152Tables
152 153
153* Built-in table editor:: Simple tables 154* Built-in table editor:: Simple tables
154* Column width and alignment:: Overrule the automatic settings 155* Column width and alignment:: Overrule the automatic settings
155* Column groups:: Grouping to trigger vertical lines 156* Column groups:: Grouping to trigger vertical lines
156* Orgtbl mode:: The table editor as minor mode 157* Orgtbl mode:: The table editor as minor mode
157* The spreadsheet:: The table editor has spreadsheet capabilities 158* The spreadsheet:: The table editor has spreadsheet capabilities
158* Org-Plot:: Plotting from org tables 159* Org-Plot:: Plotting from org tables
159 160
160The spreadsheet 161The spreadsheet
161 162
162* References:: How to refer to another field or range 163* References:: How to refer to another field or range
163* Formula syntax for Calc:: Using Calc to compute stuff 164* Formula syntax for Calc:: Using Calc to compute stuff
164* Formula syntax for Lisp:: Writing formulas in Emacs Lisp 165* Formula syntax for Lisp:: Writing formulas in Emacs Lisp
165* Field formulas:: Formulas valid for a single field 166* Field formulas:: Formulas valid for a single field
166* Column formulas:: Formulas valid for an entire column 167* Column formulas:: Formulas valid for an entire column
167* Editing and debugging formulas:: Fixing formulas 168* Editing and debugging formulas:: Fixing formulas
168* Updating the table:: Recomputing all dependent fields 169* Updating the table:: Recomputing all dependent fields
169* Advanced features:: Field names, parameters and automatic recalc 170* Advanced features:: Field names, parameters and automatic recalc
170 171
171Hyperlinks 172Hyperlinks
172 173
173* Link format:: How links in Org are formatted 174* Link format:: How links in Org are formatted
174* Internal links:: Links to other places in the current file 175* Internal links:: Links to other places in the current file
175* External links:: URL-like links to the world 176* External links:: URL-like links to the world
176* Handling links:: Creating, inserting and following 177* Handling links:: Creating, inserting and following
177* Using links outside Org:: Linking from my C source code? 178* Using links outside Org:: Linking from my C source code?
178* Link abbreviations:: Shortcuts for writing complex links 179* Link abbreviations:: Shortcuts for writing complex links
179* Search options:: Linking to a specific location 180* Search options:: Linking to a specific location
180* Custom searches:: When the default search is not enough 181* Custom searches:: When the default search is not enough
181 182
182Internal links 183Internal links
183 184
184* Radio targets:: Make targets trigger links in plain text 185* Radio targets:: Make targets trigger links in plain text
185 186
186TODO items 187TODO items
187 188
188* TODO basics:: Marking and displaying TODO entries 189* TODO basics:: Marking and displaying TODO entries
189* TODO extensions:: Workflow and assignments 190* TODO extensions:: Workflow and assignments
190* Progress logging:: Dates and notes for progress 191* Progress logging:: Dates and notes for progress
191* Priorities:: Some things are more important than others 192* Priorities:: Some things are more important than others
192* Breaking down tasks:: Splitting a task into manageable pieces 193* Breaking down tasks:: Splitting a task into manageable pieces
193* Checkboxes:: Tick-off lists 194* Checkboxes:: Tick-off lists
194 195
195Extended use of TODO keywords 196Extended use of TODO keywords
196 197
197* Workflow states:: From TODO to DONE in steps 198* Workflow states:: From TODO to DONE in steps
198* TODO types:: I do this, Fred does the rest 199* TODO types:: I do this, Fred does the rest
199* Multiple sets in one file:: Mixing it all, and still finding your way 200* Multiple sets in one file:: Mixing it all, and still finding your way
200* Fast access to TODO states:: Single letter selection of a state 201* Fast access to TODO states:: Single letter selection of a state
201* Per-file keywords:: Different files, different requirements 202* Per-file keywords:: Different files, different requirements
202* Faces for TODO keywords:: Highlighting states 203* Faces for TODO keywords:: Highlighting states
203* TODO dependencies:: When one task needs to wait for others 204* TODO dependencies:: When one task needs to wait for others
204 205
205Progress logging 206Progress logging
206 207
207* Closing items:: When was this entry marked DONE? 208* Closing items:: When was this entry marked DONE?
208* Tracking TODO state changes:: When did the status change? 209* Tracking TODO state changes:: When did the status change?
209* Tracking your habits:: How consistent have you been? 210* Tracking your habits:: How consistent have you been?
210 211
211Tags 212Tags
212 213
213* Tag inheritance:: Tags use the tree structure of the outline 214* Tag inheritance:: Tags use the tree structure of the outline
214* Setting tags:: How to assign tags to a headline 215* Setting tags:: How to assign tags to a headline
215* Tag searches:: Searching for combinations of tags 216* Tag searches:: Searching for combinations of tags
216 217
217Properties and columns 218Properties and columns
218 219
219* Property syntax:: How properties are spelled out 220* Property syntax:: How properties are spelled out
220* Special properties:: Access to other Org-mode features 221* Special properties:: Access to other Org-mode features
221* Property searches:: Matching property values 222* Property searches:: Matching property values
222* Property inheritance:: Passing values down the tree 223* Property inheritance:: Passing values down the tree
223* Column view:: Tabular viewing and editing 224* Column view:: Tabular viewing and editing
224* Property API:: Properties for Lisp programmers 225* Property API:: Properties for Lisp programmers
225 226
226Column view 227Column view
227 228
228* Defining columns:: The COLUMNS format property 229* Defining columns:: The COLUMNS format property
229* Using column view:: How to create and use column view 230* Using column view:: How to create and use column view
230* Capturing column view:: A dynamic block for column view 231* Capturing column view:: A dynamic block for column view
231 232
232Defining columns 233Defining columns
233 234
234* Scope of column definitions:: Where defined, where valid? 235* Scope of column definitions:: Where defined, where valid?
235* Column attributes:: Appearance and content of a column 236* Column attributes:: Appearance and content of a column
236 237
237Dates and times 238Dates and times
238 239
239* Timestamps:: Assigning a time to a tree entry 240* Timestamps:: Assigning a time to a tree entry
240* Creating timestamps:: Commands which insert timestamps 241* Creating timestamps:: Commands which insert timestamps
241* Deadlines and scheduling:: Planning your work 242* Deadlines and scheduling:: Planning your work
242* Clocking work time:: Tracking how long you spend on a task 243* Clocking work time:: Tracking how long you spend on a task
243* Resolving idle time:: Resolving time if you've been idle 244* Resolving idle time:: Resolving time if you've been idle
244* Effort estimates:: Planning work effort in advance 245* Effort estimates:: Planning work effort in advance
245* Relative timer:: Notes with a running timer 246* Relative timer:: Notes with a running timer
246 247
247Creating timestamps 248Creating timestamps
248 249
249* The date/time prompt:: How Org-mode helps you entering date and time 250* The date/time prompt:: How Org-mode helps you entering date and time
250* Custom time format:: Making dates look different 251* Custom time format:: Making dates look different
251 252
252Deadlines and scheduling 253Deadlines and scheduling
253 254
254* Inserting deadline/schedule:: Planning items 255* Inserting deadline/schedule:: Planning items
255* Repeated tasks:: Items that show up again and again 256* Repeated tasks:: Items that show up again and again
256 257
257Capture - Refile - Archive 258Capture - Refile - Archive
258 259
259* Capture:: Capturing new stuff 260* Capture:: Capturing new stuff
260* Attachments:: Add files to tasks 261* Attachments:: Add files to tasks
261* RSS Feeds:: Getting input from RSS feeds 262* RSS Feeds:: Getting input from RSS feeds
262* Protocols:: External (e.g. Browser) access to Emacs and Org 263* Protocols:: External (e.g. Browser) access to Emacs and Org
263* Refiling notes:: Moving a tree from one place to another 264* Refiling notes:: Moving a tree from one place to another
264* Archiving:: What to do with finished projects 265* Archiving:: What to do with finished projects
265 266
266Capture 267Capture
267 268
268* Setting up capture:: Where notes will be stored 269* Setting up capture:: Where notes will be stored
269* Using capture:: Commands to invoke and terminate capture 270* Using capture:: Commands to invoke and terminate capture
270* Capture templates:: Define the outline of different note types 271* Capture templates:: Define the outline of different note types
271 272
272Capture templates 273Capture templates
273 274
274* Template elements:: What is needed for a complete template entry 275* Template elements:: What is needed for a complete template entry
275* Template expansion:: Filling in information about time and context 276* Template expansion:: Filling in information about time and context
276 277
277Archiving 278Archiving
278 279
279* Moving subtrees:: Moving a tree to an archive file 280* Moving subtrees:: Moving a tree to an archive file
280* Internal archiving:: Switch off a tree but keep it in the file 281* Internal archiving:: Switch off a tree but keep it in the file
281 282
282Agenda views 283Agenda views
283 284
284* Agenda files:: Files being searched for agenda information 285* Agenda files:: Files being searched for agenda information
285* Agenda dispatcher:: Keyboard access to agenda views 286* Agenda dispatcher:: Keyboard access to agenda views
286* Built-in agenda views:: What is available out of the box? 287* Built-in agenda views:: What is available out of the box?
287* Presentation and sorting:: How agenda items are prepared for display 288* Presentation and sorting:: How agenda items are prepared for display
288* Agenda commands:: Remote editing of Org trees 289* Agenda commands:: Remote editing of Org trees
289* Custom agenda views:: Defining special searches and views 290* Custom agenda views:: Defining special searches and views
290* Exporting Agenda Views:: Writing a view to a file 291* Exporting Agenda Views:: Writing a view to a file
291* Agenda column view:: Using column view for collected entries 292* Agenda column view:: Using column view for collected entries
292 293
293The built-in agenda views 294The built-in agenda views
294 295
295* Weekly/daily agenda:: The calendar page with current tasks 296* Weekly/daily agenda:: The calendar page with current tasks
296* Global TODO list:: All unfinished action items 297* Global TODO list:: All unfinished action items
297* Matching tags and properties:: Structured information with fine-tuned search 298* Matching tags and properties:: Structured information with fine-tuned search
298* Timeline:: Time-sorted view for single file 299* Timeline:: Time-sorted view for single file
299* Search view:: Find entries by searching for text 300* Search view:: Find entries by searching for text
300* Stuck projects:: Find projects you need to review 301* Stuck projects:: Find projects you need to review
301 302
302Presentation and sorting 303Presentation and sorting
303 304
304* Categories:: Not all tasks are equal 305* Categories:: Not all tasks are equal
305* Time-of-day specifications:: How the agenda knows the time 306* Time-of-day specifications:: How the agenda knows the time
306* Sorting of agenda items:: The order of things 307* Sorting of agenda items:: The order of things
307 308
308Custom agenda views 309Custom agenda views
309 310
310* Storing searches:: Type once, use often 311* Storing searches:: Type once, use often
311* Block agenda:: All the stuff you need in a single buffer 312* Block agenda:: All the stuff you need in a single buffer
312* Setting Options:: Changing the rules 313* Setting Options:: Changing the rules
313 314
314Markup for rich export 315Markup for rich export
315 316
316* Structural markup elements:: The basic structure as seen by the exporter 317* Structural markup elements:: The basic structure as seen by the exporter
317* Images and tables:: Tables and Images will be included 318* Images and tables:: Tables and Images will be included
318* Literal examples:: Source code examples with special formatting 319* Literal examples:: Source code examples with special formatting
319* Include files:: Include additional files into a document 320* Include files:: Include additional files into a document
320* Index entries:: Making an index 321* Index entries:: Making an index
321* Macro replacement:: Use macros to create complex output 322* Macro replacement:: Use macros to create complex output
322* Embedded LaTeX:: LaTeX can be freely used inside Org documents 323* Embedded LaTeX:: LaTeX can be freely used inside Org documents
323 324
324Structural markup elements 325Structural markup elements
325 326
326* Document title:: Where the title is taken from 327* Document title:: Where the title is taken from
327* Headings and sections:: The document structure as seen by the exporter 328* Headings and sections:: The document structure as seen by the exporter
328* Table of contents:: The if and where of the table of contents 329* Table of contents:: The if and where of the table of contents
329* Initial text:: Text before the first heading? 330* Initial text:: Text before the first heading?
330* Lists:: Lists 331* Lists:: Lists
331* Paragraphs:: Paragraphs 332* Paragraphs:: Paragraphs
332* Footnote markup:: Footnotes 333* Footnote markup:: Footnotes
333* Emphasis and monospace:: Bold, italic, etc. 334* Emphasis and monospace:: Bold, italic, etc.
334* Horizontal rules:: Make a line 335* Horizontal rules:: Make a line
335* Comment lines:: What will *not* be exported 336* Comment lines:: What will *not* be exported
336 337
337Embedded La@TeX{} 338Embedded La@TeX{}
338 339
339* Special symbols:: Greek letters and other symbols 340* Special symbols:: Greek letters and other symbols
340* Subscripts and superscripts:: Simple syntax for raising/lowering text 341* Subscripts and superscripts:: Simple syntax for raising/lowering text
341* LaTeX fragments:: Complex formulas made easy 342* LaTeX fragments:: Complex formulas made easy
342* Previewing LaTeX fragments:: What will this snippet look like? 343* Previewing LaTeX fragments:: What will this snippet look like?
343* CDLaTeX mode:: Speed up entering of formulas 344* CDLaTeX mode:: Speed up entering of formulas
344 345
345Exporting 346Exporting
346 347
347* Selective export:: Using tags to select and exclude trees 348* Selective export:: Using tags to select and exclude trees
348* Export options:: Per-file export settings 349* Export options:: Per-file export settings
349* The export dispatcher:: How to access exporter commands 350* The export dispatcher:: How to access exporter commands
350* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding 351* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
351* HTML export:: Exporting to HTML 352* HTML export:: Exporting to HTML
352* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF 353* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF
353* DocBook export:: Exporting to DocBook 354* DocBook export:: Exporting to DocBook
354* TaskJuggler export:: Exporting to TaskJuggler 355* TaskJuggler export:: Exporting to TaskJuggler
355* Freemind export:: Exporting to Freemind mind maps 356* Freemind export:: Exporting to Freemind mind maps
356* XOXO export:: Exporting to XOXO 357* XOXO export:: Exporting to XOXO
357* iCalendar export:: Exporting in iCalendar format 358* iCalendar export:: Exporting in iCalendar format
358 359
359HTML export 360HTML export
360 361
361* HTML Export commands:: How to invoke HTML export 362* HTML Export commands:: How to invoke HTML export
362* Quoting HTML tags:: Using direct HTML in Org-mode 363* Quoting HTML tags:: Using direct HTML in Org-mode
363* Links in HTML export:: How links will be interpreted and formatted 364* Links in HTML export:: How links will be interpreted and formatted
364* Tables in HTML export:: How to modify the formatting of tables 365* Tables in HTML export:: How to modify the formatting of tables
365* Images in HTML export:: How to insert figures into HTML output 366* Images in HTML export:: How to insert figures into HTML output
366* Text areas in HTML export:: An alternative way to show an example 367* Text areas in HTML export:: An alternative way to show an example
367* CSS support:: Changing the appearance of the output 368* CSS support:: Changing the appearance of the output
368* JavaScript support:: Info and Folding in a web browser 369* JavaScript support:: Info and Folding in a web browser
369 370
370La@TeX{} and PDF export 371La@TeX{} and PDF export
371 372
372* LaTeX/PDF export commands:: Which key invokes which commands 373* LaTeX/PDF export commands:: Which key invokes which commands
373* Header and sectioning:: Setting up the export file structure 374* Header and sectioning:: Setting up the export file structure
374* Quoting LaTeX code:: Incorporating literal La@TeX{} code 375* Quoting LaTeX code:: Incorporating literal La@TeX{} code
375* Tables in LaTeX export:: Options for exporting tables to La@TeX{} 376* Tables in LaTeX export:: Options for exporting tables to La@TeX{}
376* Images in LaTeX export:: How to insert figures into La@TeX{} output 377* Images in LaTeX export:: How to insert figures into La@TeX{} output
377* Beamer class export:: Turning the file into a presentation 378* Beamer class export:: Turning the file into a presentation
378 379
379DocBook export 380DocBook export
380 381
381* DocBook export commands:: How to invoke DocBook export 382* DocBook export commands:: How to invoke DocBook export
382* Quoting DocBook code:: Incorporating DocBook code in Org files 383* Quoting DocBook code:: Incorporating DocBook code in Org files
383* Recursive sections:: Recursive sections in DocBook 384* Recursive sections:: Recursive sections in DocBook
384* Tables in DocBook export:: Tables are exported as HTML tables 385* Tables in DocBook export:: Tables are exported as HTML tables
385* Images in DocBook export:: How to insert figures into DocBook output 386* Images in DocBook export:: How to insert figures into DocBook output
386* Special characters:: How to handle special characters 387* Special characters:: How to handle special characters
387 388
388Publishing 389Publishing
389 390
390* Configuration:: Defining projects 391* Configuration:: Defining projects
391* Uploading files:: How to get files up on the server 392* Uploading files:: How to get files up on the server
392* Sample configuration:: Example projects 393* Sample configuration:: Example projects
393* Triggering publication:: Publication commands 394* Triggering publication:: Publication commands
394 395
395Configuration 396Configuration
396 397
397* Project alist:: The central configuration variable 398* Project alist:: The central configuration variable
398* Sources and destinations:: From here to there 399* Sources and destinations:: From here to there
399* Selecting files:: What files are part of the project? 400* Selecting files:: What files are part of the project?
400* Publishing action:: Setting the function doing the publishing 401* Publishing action:: Setting the function doing the publishing
401* Publishing options:: Tweaking HTML export 402* Publishing options:: Tweaking HTML export
402* Publishing links:: Which links keep working after publishing? 403* Publishing links:: Which links keep working after publishing?
403* Sitemap:: Generating a list of all pages 404* Sitemap:: Generating a list of all pages
404* Generating an index:: An index that reaches across pages 405* Generating an index:: An index that reaches across pages
405 406
406Sample configuration 407Sample configuration
407 408
408* Simple example:: One-component publishing 409* Simple example:: One-component publishing
409* Complex example:: A multi-component publishing example 410* Complex example:: A multi-component publishing example
410 411
411Working with source code 412Working with source code
412 413
413* Structure of code blocks:: Code block syntax described 414* Structure of code blocks:: Code block syntax described
414* Editing source code:: Language major-mode editing 415* Editing source code:: Language major-mode editing
415* Exporting code blocks:: Export contents and/or results 416* Exporting code blocks:: Export contents and/or results
416* Extracting source code:: Create pure source code files 417* Extracting source code:: Create pure source code files
417* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer 418* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer
418* Library of Babel:: Use and contribute to a library of useful code blocks 419* Library of Babel:: Use and contribute to a library of useful code blocks
419* Languages:: List of supported code block languages 420* Languages:: List of supported code block languages
420* Header arguments:: Configure code block functionality 421* Header arguments:: Configure code block functionality
421* Results of evaluation:: How evaluation results are handled 422* Results of evaluation:: How evaluation results are handled
422* Noweb reference syntax:: Literate programming in Org-mode 423* Noweb reference syntax:: Literate programming in Org-mode
423* Key bindings and useful functions:: Work quickly with code blocks 424* Key bindings and useful functions:: Work quickly with code blocks
424* Batch execution:: Call functions from the command line 425* Batch execution:: Call functions from the command line
425 426
426Header arguments 427Header arguments
427 428
428* Using header arguments:: Different ways to set header arguments 429* Using header arguments:: Different ways to set header arguments
429* Specific header arguments:: List of header arguments 430* Specific header arguments:: List of header arguments
430 431
431Using header arguments 432Using header arguments
432 433
433* System-wide header arguments:: Set global default values 434* System-wide header arguments:: Set global default values
434* Language-specific header arguments:: Set default values by language 435* Language-specific header arguments:: Set default values by language
435* Buffer-wide header arguments:: Set default values for a specific buffer 436* Buffer-wide header arguments:: Set default values for a specific buffer
436* Header arguments in Org-mode properties:: Set default values for a buffer or heading 437* Header arguments in Org-mode properties:: Set default values for a buffer or heading
437* Code block specific header arguments:: The most common way to set values 438* Code block specific header arguments:: The most common way to set values
438 439
439Specific header arguments 440Specific header arguments
440 441
441* var:: Pass arguments to code blocks 442* var:: Pass arguments to code blocks
442* results:: Specify the type of results and how they will be collected and handled 443* results:: Specify the type of results and how they will be collected and handled
443* file:: Specify a path for file output 444* file:: Specify a path for file output
444* dir:: Specify the default directory for code block execution 445* dir:: Specify the default directory for code block execution
445* exports:: Export code and/or results 446* exports:: Export code and/or results
446* tangle:: Toggle tangling and specify file name 447* tangle:: Toggle tangling and specify file name
447* no-expand:: Turn off variable assignment and noweb expansion during tangling 448* no-expand:: Turn off variable assignment and noweb expansion during tangling
448* session:: Preserve the state of code evaluation 449* session:: Preserve the state of code evaluation
449* noweb:: Toggle expansion of noweb references 450* noweb:: Toggle expansion of noweb references
450* cache:: Avoid re-evaluating unchanged code blocks 451* cache:: Avoid re-evaluating unchanged code blocks
451* hlines:: Handle horizontal lines in tables 452* hlines:: Handle horizontal lines in tables
452* colnames:: Handle column names in tables 453* colnames:: Handle column names in tables
453* rownames:: Handle row names in tables 454* rownames:: Handle row names in tables
454* shebang:: Make tangled files executable 455* shebang:: Make tangled files executable
455 456
456Miscellaneous 457Miscellaneous
457 458
458* Completion:: M-TAB knows what you need 459* Completion:: M-TAB knows what you need
459* Speed keys:: Electric commands at the beginning of a headline 460* Speed keys:: Electric commands at the beginning of a headline
460* Code evaluation security:: Org mode files evaluate inline code 461* Code evaluation security:: Org mode files evaluate inline code
461* Customization:: Adapting Org to your taste 462* Customization:: Adapting Org to your taste
462* In-buffer settings:: Overview of the #+KEYWORDS 463* In-buffer settings:: Overview of the #+KEYWORDS
463* The very busy C-c C-c key:: When in doubt, press C-c C-c 464* The very busy C-c C-c key:: When in doubt, press C-c C-c
464* Clean view:: Getting rid of leading stars in the outline 465* Clean view:: Getting rid of leading stars in the outline
465* TTY keys:: Using Org on a tty 466* TTY keys:: Using Org on a tty
466* Interaction:: Other Emacs packages 467* Interaction:: Other Emacs packages
467 468
468Interaction with other packages 469Interaction with other packages
469 470
470* Cooperation:: Packages Org cooperates with 471* Cooperation:: Packages Org cooperates with
471* Conflicts:: Packages that lead to conflicts 472* Conflicts:: Packages that lead to conflicts
472 473
473Hacking 474Hacking
474 475
475* Hooks:: Who to reach into Org's internals 476* Hooks:: Who to reach into Org's internals
476* Add-on packages:: Available extensions 477* Add-on packages:: Available extensions
477* Adding hyperlink types:: New custom link types 478* Adding hyperlink types:: New custom link types
478* Context-sensitive commands:: How to add functionality to such commands 479* Context-sensitive commands:: How to add functionality to such commands
479* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs 480* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs
480* Dynamic blocks:: Automatically filled blocks 481* Dynamic blocks:: Automatically filled blocks
481* Special agenda views:: Customized views 482* Special agenda views:: Customized views
482* Extracting agenda information:: Postprocessing of agenda information 483* Extracting agenda information:: Postprocessing of agenda information
483* Using the property API:: Writing programs that use entry properties 484* Using the property API:: Writing programs that use entry properties
484* Using the mapping API:: Mapping over all or selected entries 485* Using the mapping API:: Mapping over all or selected entries
485 486
486Tables and lists in arbitrary syntax 487Tables and lists in arbitrary syntax
487 488
488* Radio tables:: Sending and receiving radio tables 489* Radio tables:: Sending and receiving radio tables
489* A LaTeX example:: Step by step, almost a tutorial 490* A LaTeX example:: Step by step, almost a tutorial
490* Translator functions:: Copy and modify 491* Translator functions:: Copy and modify
491* Radio lists:: Doing the same for lists 492* Radio lists:: Doing the same for lists
492 493
493MobileOrg 494MobileOrg
494 495
495* Setting up the staging area:: Where to interact with the mobile device 496* Setting up the staging area:: Where to interact with the mobile device
496* Pushing to MobileOrg:: Uploading Org files and agendas 497* Pushing to MobileOrg:: Uploading Org files and agendas
497* Pulling from MobileOrg:: Integrating captured and flagged items 498* Pulling from MobileOrg:: Integrating captured and flagged items
498 499
499@end detailmenu 500@end detailmenu
500@end menu 501@end menu
@@ -504,11 +505,11 @@ MobileOrg
504@cindex introduction 505@cindex introduction
505 506
506@menu 507@menu
507* Summary:: Brief summary of what Org does 508* Summary:: Brief summary of what Org does
508* Installation:: How to install a downloaded version of Org 509* Installation:: How to install a downloaded version of Org
509* Activation:: How to activate Org for certain buffers 510* Activation:: How to activate Org for certain buffers
510* Feedback:: Bug reports, ideas, patches etc. 511* Feedback:: Bug reports, ideas, patches etc.
511* Conventions:: Type-setting conventions in the manual 512* Conventions:: Type-setting conventions in the manual
512@end menu 513@end menu
513 514
514@node Summary, Installation, Introduction, Introduction 515@node Summary, Installation, Introduction, Introduction
@@ -805,17 +806,17 @@ Org is based on Outline mode and provides flexible commands to
805edit the structure of the document. 806edit the structure of the document.
806 807
807@menu 808@menu
808* Outlines:: Org is based on Outline mode 809* Outlines:: Org is based on Outline mode
809* Headlines:: How to typeset Org tree headlines 810* Headlines:: How to typeset Org tree headlines
810* Visibility cycling:: Show and hide, much simplified 811* Visibility cycling:: Show and hide, much simplified
811* Motion:: Jumping to other headlines 812* Motion:: Jumping to other headlines
812* Structure editing:: Changing sequence and level of headlines 813* Structure editing:: Changing sequence and level of headlines
813* Sparse trees:: Matches embedded in context 814* Sparse trees:: Matches embedded in context
814* Plain lists:: Additional structure within an entry 815* Plain lists:: Additional structure within an entry
815* Drawers:: Tucking stuff away 816* Drawers:: Tucking stuff away
816* Blocks:: Folding blocks 817* Blocks:: Folding blocks
817* Footnotes:: How footnotes are defined in Org's syntax 818* Footnotes:: How footnotes are defined in Org's syntax
818* Orgstruct mode:: Structure editing outside Org 819* Orgstruct mode:: Structure editing outside Org
819@end menu 820@end menu
820 821
821@node Outlines, Headlines, Document Structure, Document Structure 822@node Outlines, Headlines, Document Structure, Document Structure
@@ -1640,12 +1641,12 @@ calculator).
1640@end ifnotinfo 1641@end ifnotinfo
1641 1642
1642@menu 1643@menu
1643* Built-in table editor:: Simple tables 1644* Built-in table editor:: Simple tables
1644* Column width and alignment:: Overrule the automatic settings 1645* Column width and alignment:: Overrule the automatic settings
1645* Column groups:: Grouping to trigger vertical lines 1646* Column groups:: Grouping to trigger vertical lines
1646* Orgtbl mode:: The table editor as minor mode 1647* Orgtbl mode:: The table editor as minor mode
1647* The spreadsheet:: The table editor has spreadsheet capabilities 1648* The spreadsheet:: The table editor has spreadsheet capabilities
1648* Org-Plot:: Plotting from org tables 1649* Org-Plot:: Plotting from org tables
1649@end menu 1650@end menu
1650 1651
1651@node Built-in table editor, Column width and alignment, Tables, Tables 1652@node Built-in table editor, Column width and alignment, Tables, Tables
@@ -2019,14 +2020,14 @@ fields in the table corresponding to the references at the point in the
2019formula, moving these references by arrow keys 2020formula, moving these references by arrow keys
2020 2021
2021@menu 2022@menu
2022* References:: How to refer to another field or range 2023* References:: How to refer to another field or range
2023* Formula syntax for Calc:: Using Calc to compute stuff 2024* Formula syntax for Calc:: Using Calc to compute stuff
2024* Formula syntax for Lisp:: Writing formulas in Emacs Lisp 2025* Formula syntax for Lisp:: Writing formulas in Emacs Lisp
2025* Field formulas:: Formulas valid for a single field 2026* Field formulas:: Formulas valid for a single field
2026* Column formulas:: Formulas valid for an entire column 2027* Column formulas:: Formulas valid for an entire column
2027* Editing and debugging formulas:: Fixing formulas 2028* Editing and debugging formulas:: Fixing formulas
2028* Updating the table:: Recomputing all dependent fields 2029* Updating the table:: Recomputing all dependent fields
2029* Advanced features:: Field names, parameters and automatic recalc 2030* Advanced features:: Field names, parameters and automatic recalc
2030@end menu 2031@end menu
2031 2032
2032@node References, Formula syntax for Calc, The spreadsheet, The spreadsheet 2033@node References, Formula syntax for Calc, The spreadsheet, The spreadsheet
@@ -2730,14 +2731,14 @@ Like HTML, Org provides links inside a file, external links to
2730other files, Usenet articles, emails, and much more. 2731other files, Usenet articles, emails, and much more.
2731 2732
2732@menu 2733@menu
2733* Link format:: How links in Org are formatted 2734* Link format:: How links in Org are formatted
2734* Internal links:: Links to other places in the current file 2735* Internal links:: Links to other places in the current file
2735* External links:: URL-like links to the world 2736* External links:: URL-like links to the world
2736* Handling links:: Creating, inserting and following 2737* Handling links:: Creating, inserting and following
2737* Using links outside Org:: Linking from my C source code? 2738* Using links outside Org:: Linking from my C source code?
2738* Link abbreviations:: Shortcuts for writing complex links 2739* Link abbreviations:: Shortcuts for writing complex links
2739* Search options:: Linking to a specific location 2740* Search options:: Linking to a specific location
2740* Custom searches:: When the default search is not enough 2741* Custom searches:: When the default search is not enough
2741@end menu 2742@end menu
2742 2743
2743@node Link format, Internal links, Hyperlinks, Hyperlinks 2744@node Link format, Internal links, Hyperlinks, Hyperlinks
@@ -2830,7 +2831,7 @@ several times in direct succession goes back to positions recorded
2830earlier. 2831earlier.
2831 2832
2832@menu 2833@menu
2833* Radio targets:: Make targets trigger links in plain text 2834* Radio targets:: Make targets trigger links in plain text
2834@end menu 2835@end menu
2835 2836
2836@node Radio targets, , Internal links, Internal links 2837@node Radio targets, , Internal links, Internal links
@@ -3285,12 +3286,12 @@ throughout your notes file. Org-mode compensates for this by providing
3285methods to give you an overview of all the things that you have to do. 3286methods to give you an overview of all the things that you have to do.
3286 3287
3287@menu 3288@menu
3288* TODO basics:: Marking and displaying TODO entries 3289* TODO basics:: Marking and displaying TODO entries
3289* TODO extensions:: Workflow and assignments 3290* TODO extensions:: Workflow and assignments
3290* Progress logging:: Dates and notes for progress 3291* Progress logging:: Dates and notes for progress
3291* Priorities:: Some things are more important than others 3292* Priorities:: Some things are more important than others
3292* Breaking down tasks:: Splitting a task into manageable pieces 3293* Breaking down tasks:: Splitting a task into manageable pieces
3293* Checkboxes:: Tick-off lists 3294* Checkboxes:: Tick-off lists
3294@end menu 3295@end menu
3295 3296
3296@node TODO basics, TODO extensions, TODO Items, TODO Items 3297@node TODO basics, TODO extensions, TODO Items, TODO Items
@@ -3382,13 +3383,13 @@ Note that @i{tags} are another way to classify headlines in general and
3382TODO items in particular (@pxref{Tags}). 3383TODO items in particular (@pxref{Tags}).
3383 3384
3384@menu 3385@menu
3385* Workflow states:: From TODO to DONE in steps 3386* Workflow states:: From TODO to DONE in steps
3386* TODO types:: I do this, Fred does the rest 3387* TODO types:: I do this, Fred does the rest
3387* Multiple sets in one file:: Mixing it all, and still finding your way 3388* Multiple sets in one file:: Mixing it all, and still finding your way
3388* Fast access to TODO states:: Single letter selection of a state 3389* Fast access to TODO states:: Single letter selection of a state
3389* Per-file keywords:: Different files, different requirements 3390* Per-file keywords:: Different files, different requirements
3390* Faces for TODO keywords:: Highlighting states 3391* Faces for TODO keywords:: Highlighting states
3391* TODO dependencies:: When one task needs to wait for others 3392* TODO dependencies:: When one task needs to wait for others
3392@end menu 3393@end menu
3393 3394
3394@node Workflow states, TODO types, TODO extensions, TODO extensions 3395@node Workflow states, TODO types, TODO extensions, TODO extensions
@@ -3679,9 +3680,9 @@ information on how to clock working time for a task, see @ref{Clocking
3679work time}. 3680work time}.
3680 3681
3681@menu 3682@menu
3682* Closing items:: When was this entry marked DONE? 3683* Closing items:: When was this entry marked DONE?
3683* Tracking TODO state changes:: When did the status change? 3684* Tracking TODO state changes:: When did the status change?
3684* Tracking your habits:: How consistent have you been? 3685* Tracking your habits:: How consistent have you been?
3685@end menu 3686@end menu
3686 3687
3687@node Closing items, Tracking TODO state changes, Progress logging, Progress logging 3688@node Closing items, Tracking TODO state changes, Progress logging, Progress logging
@@ -4143,9 +4144,9 @@ You may specify special faces for specific tags using the variable
4143(@pxref{Faces for TODO keywords}). 4144(@pxref{Faces for TODO keywords}).
4144 4145
4145@menu 4146@menu
4146* Tag inheritance:: Tags use the tree structure of the outline 4147* Tag inheritance:: Tags use the tree structure of the outline
4147* Setting tags:: How to assign tags to a headline 4148* Setting tags:: How to assign tags to a headline
4148* Tag searches:: Searching for combinations of tags 4149* Tag searches:: Searching for combinations of tags
4149@end menu 4150@end menu
4150 4151
4151@node Tag inheritance, Setting tags, Tags, Tags 4152@node Tag inheritance, Setting tags, Tags, Tags
@@ -4432,12 +4433,12 @@ Properties can be conveniently edited and viewed in column view
4432(@pxref{Column view}). 4433(@pxref{Column view}).
4433 4434
4434@menu 4435@menu
4435* Property syntax:: How properties are spelled out 4436* Property syntax:: How properties are spelled out
4436* Special properties:: Access to other Org-mode features 4437* Special properties:: Access to other Org-mode features
4437* Property searches:: Matching property values 4438* Property searches:: Matching property values
4438* Property inheritance:: Passing values down the tree 4439* Property inheritance:: Passing values down the tree
4439* Column view:: Tabular viewing and editing 4440* Column view:: Tabular viewing and editing
4440* Property API:: Properties for Lisp programmers 4441* Property API:: Properties for Lisp programmers
4441@end menu 4442@end menu
4442 4443
4443@node Property syntax, Special properties, Properties and Columns, Properties and Columns 4444@node Property syntax, Special properties, Properties and Columns, Properties and Columns
@@ -4673,9 +4674,9 @@ Column view also works in agenda buffers (@pxref{Agenda Views}) where
4673queries have collected selected items, possibly from a number of files. 4674queries have collected selected items, possibly from a number of files.
4674 4675
4675@menu 4676@menu
4676* Defining columns:: The COLUMNS format property 4677* Defining columns:: The COLUMNS format property
4677* Using column view:: How to create and use column view 4678* Using column view:: How to create and use column view
4678* Capturing column view:: A dynamic block for column view 4679* Capturing column view:: A dynamic block for column view
4679@end menu 4680@end menu
4680 4681
4681@node Defining columns, Using column view, Column view, Column view 4682@node Defining columns, Using column view, Column view, Column view
@@ -4687,8 +4688,8 @@ Setting up a column view first requires defining the columns. This is
4687done by defining a column format line. 4688done by defining a column format line.
4688 4689
4689@menu 4690@menu
4690* Scope of column definitions:: Where defined, where valid? 4691* Scope of column definitions:: Where defined, where valid?
4691* Column attributes:: Appearance and content of a column 4692* Column attributes:: Appearance and content of a column
4692@end menu 4693@end menu
4693 4694
4694@node Scope of column definitions, Column attributes, Defining columns, Defining columns 4695@node Scope of column definitions, Column attributes, Defining columns, Defining columns
@@ -4770,7 +4771,7 @@ values.
4770 4771
4771@example 4772@example
4772:COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.} 4773:COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.}
4773 %10Time_Estimate@{:@} %CLOCKSUM 4774 %10Time_Estimate@{:@} %CLOCKSUM
4774:Owner_ALL: Tammy Mark Karl Lisa Don 4775:Owner_ALL: Tammy Mark Karl Lisa Don
4775:Status_ALL: "In progress" "Not started yet" "Finished" "" 4776:Status_ALL: "In progress" "Not started yet" "Finished" ""
4776:Approved_ALL: "[ ]" "[X]" 4777:Approved_ALL: "[ ]" "[X]"
@@ -4970,13 +4971,13 @@ something was created or last changed. However, in Org-mode this term
4970is used in a much wider sense. 4971is used in a much wider sense.
4971 4972
4972@menu 4973@menu
4973* Timestamps:: Assigning a time to a tree entry 4974* Timestamps:: Assigning a time to a tree entry
4974* Creating timestamps:: Commands which insert timestamps 4975* Creating timestamps:: Commands which insert timestamps
4975* Deadlines and scheduling:: Planning your work 4976* Deadlines and scheduling:: Planning your work
4976* Clocking work time:: Tracking how long you spend on a task 4977* Clocking work time:: Tracking how long you spend on a task
4977* Resolving idle time:: Resolving time if you've been idle 4978* Resolving idle time:: Resolving time if you've been idle
4978* Effort estimates:: Planning work effort in advance 4979* Effort estimates:: Planning work effort in advance
4979* Relative timer:: Notes with a running timer 4980* Relative timer:: Notes with a running timer
4980@end menu 4981@end menu
4981 4982
4982 4983
@@ -5132,8 +5133,8 @@ the following column).
5132 5133
5133 5134
5134@menu 5135@menu
5135* The date/time prompt:: How Org-mode helps you entering date and time 5136* The date/time prompt:: How Org-mode helps you entering date and time
5136* Custom time format:: Making dates look different 5137* Custom time format:: Making dates look different
5137@end menu 5138@end menu
5138 5139
5139@node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps 5140@node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps
@@ -5365,8 +5366,8 @@ late warnings. However, it will show the item on each day where the
5365sexp entry matches. 5366sexp entry matches.
5366 5367
5367@menu 5368@menu
5368* Inserting deadline/schedule:: Planning items 5369* Inserting deadline/schedule:: Planning items
5369* Repeated tasks:: Items that show up again and again 5370* Repeated tasks:: Items that show up again and again
5370@end menu 5371@end menu
5371 5372
5372@node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling 5373@node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling
@@ -5888,12 +5889,12 @@ system, tasks and projects need to be moved around. Moving completed project
5888trees to an archive file keeps the system compact and fast. 5889trees to an archive file keeps the system compact and fast.
5889 5890
5890@menu 5891@menu
5891* Capture:: Capturing new stuff 5892* Capture:: Capturing new stuff
5892* Attachments:: Add files to tasks 5893* Attachments:: Add files to tasks
5893* RSS Feeds:: Getting input from RSS feeds 5894* RSS Feeds:: Getting input from RSS feeds
5894* Protocols:: External (e.g. Browser) access to Emacs and Org 5895* Protocols:: External (e.g. Browser) access to Emacs and Org
5895* Refiling notes:: Moving a tree from one place to another 5896* Refiling notes:: Moving a tree from one place to another
5896* Archiving:: What to do with finished projects 5897* Archiving:: What to do with finished projects
5897@end menu 5898@end menu
5898 5899
5899@node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive 5900@node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive
@@ -5921,9 +5922,9 @@ flow. The basic process of capturing is very similar to remember, but Org
5921does enhance it with templates and more. 5922does enhance it with templates and more.
5922 5923
5923@menu 5924@menu
5924* Setting up capture:: Where notes will be stored 5925* Setting up capture:: Where notes will be stored
5925* Using capture:: Commands to invoke and terminate capture 5926* Using capture:: Commands to invoke and terminate capture
5926* Capture templates:: Define the outline of different note types 5927* Capture templates:: Define the outline of different note types
5927@end menu 5928@end menu
5928 5929
5929@node Setting up capture, Using capture, Capture, Capture 5930@node Setting up capture, Using capture, Capture, Capture
@@ -6016,8 +6017,8 @@ place where you started the capture process.
6016 6017
6017 6018
6018@menu 6019@menu
6019* Template elements:: What is needed for a complete template entry 6020* Template elements:: What is needed for a complete template entry
6020* Template expansion:: Filling in information about time and context 6021* Template expansion:: Filling in information about time and context
6021@end menu 6022@end menu
6022 6023
6023@node Template elements, Template expansion, Capture templates, Capture templates 6024@node Template elements, Template expansion, Capture templates, Capture templates
@@ -6326,8 +6327,8 @@ information. Here is just an example:
6326@example 6327@example
6327(setq org-feed-alist 6328(setq org-feed-alist
6328 '(("Slashdot" 6329 '(("Slashdot"
6329 "http://rss.slashdot.org/Slashdot/slashdot" 6330 "http://rss.slashdot.org/Slashdot/slashdot"
6330 "~/txt/org/feeds.org" "Slashdot Entries"))) 6331 "~/txt/org/feeds.org" "Slashdot Entries")))
6331@end example 6332@end example
6332 6333
6333@noindent 6334@noindent
@@ -6440,8 +6441,8 @@ Archive the current entry using the command specified in the variable
6440@end table 6441@end table
6441 6442
6442@menu 6443@menu
6443* Moving subtrees:: Moving a tree to an archive file 6444* Moving subtrees:: Moving a tree to an archive file
6444* Internal archiving:: Switch off a tree but keep it in the file 6445* Internal archiving:: Switch off a tree but keep it in the file
6445@end menu 6446@end menu
6446 6447
6447@node Moving subtrees, Internal archiving, Archiving, Archiving 6448@node Moving subtrees, Internal archiving, Archiving, Archiving
@@ -6618,14 +6619,14 @@ window configuration is restored when the agenda exits:
6618@code{org-agenda-restore-windows-after-quit}. 6619@code{org-agenda-restore-windows-after-quit}.
6619 6620
6620@menu 6621@menu
6621* Agenda files:: Files being searched for agenda information 6622* Agenda files:: Files being searched for agenda information
6622* Agenda dispatcher:: Keyboard access to agenda views 6623* Agenda dispatcher:: Keyboard access to agenda views
6623* Built-in agenda views:: What is available out of the box? 6624* Built-in agenda views:: What is available out of the box?
6624* Presentation and sorting:: How agenda items are prepared for display 6625* Presentation and sorting:: How agenda items are prepared for display
6625* Agenda commands:: Remote editing of Org trees 6626* Agenda commands:: Remote editing of Org trees
6626* Custom agenda views:: Defining special searches and views 6627* Custom agenda views:: Defining special searches and views
6627* Exporting Agenda Views:: Writing a view to a file 6628* Exporting Agenda Views:: Writing a view to a file
6628* Agenda column view:: Using column view for collected entries 6629* Agenda column view:: Using column view for collected entries
6629@end menu 6630@end menu
6630 6631
6631@node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views 6632@node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views
@@ -6767,12 +6768,12 @@ a number of special tags matches. @xref{Custom agenda views}.
6767In this section we describe the built-in views. 6768In this section we describe the built-in views.
6768 6769
6769@menu 6770@menu
6770* Weekly/daily agenda:: The calendar page with current tasks 6771* Weekly/daily agenda:: The calendar page with current tasks
6771* Global TODO list:: All unfinished action items 6772* Global TODO list:: All unfinished action items
6772* Matching tags and properties:: Structured information with fine-tuned search 6773* Matching tags and properties:: Structured information with fine-tuned search
6773* Timeline:: Time-sorted view for single file 6774* Timeline:: Time-sorted view for single file
6774* Search view:: Find entries by searching for text 6775* Search view:: Find entries by searching for text
6775* Stuck projects:: Find projects you need to review 6776* Stuck projects:: Find projects you need to review
6776@end menu 6777@end menu
6777 6778
6778@node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views 6779@node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views
@@ -7237,9 +7238,9 @@ The prefix is followed by a cleaned-up version of the outline headline
7237associated with the item. 7238associated with the item.
7238 7239
7239@menu 7240@menu
7240* Categories:: Not all tasks are equal 7241* Categories:: Not all tasks are equal
7241* Time-of-day specifications:: How the agenda knows the time 7242* Time-of-day specifications:: How the agenda knows the time
7242* Sorting of agenda items:: The order of things 7243* Sorting of agenda items:: The order of things
7243@end menu 7244@end menu
7244 7245
7245@node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting 7246@node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting
@@ -7628,12 +7629,12 @@ Internet, and outside of business hours, with something like this:
7628@group 7629@group
7629(defun org-my-auto-exclude-function (tag) 7630(defun org-my-auto-exclude-function (tag)
7630 (and (cond 7631 (and (cond
7631 ((string= tag "Net") 7632 ((string= tag "Net")
7632 (/= 0 (call-process "/sbin/ping" nil nil nil 7633 (/= 0 (call-process "/sbin/ping" nil nil nil
7633 "-c1" "-q" "-t1" "mail.gnu.org"))) 7634 "-c1" "-q" "-t1" "mail.gnu.org")))
7634 ((or (string= tag "Errand") (string= tag "Call")) 7635 ((or (string= tag "Errand") (string= tag "Call"))
7635 (let ((hour (nth 2 (decode-time)))) 7636 (let ((hour (nth 2 (decode-time))))
7636 (or (< hour 8) (> hour 21))))) 7637 (or (< hour 8) (> hour 21)))))
7637 (concat "-" tag))) 7638 (concat "-" tag)))
7638 7639
7639(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) 7640(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function)
@@ -7963,9 +7964,9 @@ agenda buffers. Custom agenda commands will be accessible through the
7963dispatcher (@pxref{Agenda dispatcher}), just like the default commands. 7964dispatcher (@pxref{Agenda dispatcher}), just like the default commands.
7964 7965
7965@menu 7966@menu
7966* Storing searches:: Type once, use often 7967* Storing searches:: Type once, use often
7967* Block agenda:: All the stuff you need in a single buffer 7968* Block agenda:: All the stuff you need in a single buffer
7968* Setting Options:: Changing the rules 7969* Setting Options:: Changing the rules
7969@end menu 7970@end menu
7970 7971
7971@node Storing searches, Block agenda, Custom agenda views, Custom agenda views 7972@node Storing searches, Block agenda, Custom agenda views, Custom agenda views
@@ -8350,29 +8351,29 @@ Org-mode has rules on how to prepare text for rich export. This section
8350summarizes the markup rules used in an Org-mode buffer. 8351summarizes the markup rules used in an Org-mode buffer.
8351 8352
8352@menu 8353@menu
8353* Structural markup elements:: The basic structure as seen by the exporter 8354* Structural markup elements:: The basic structure as seen by the exporter
8354* Images and tables:: Tables and Images will be included 8355* Images and tables:: Tables and Images will be included
8355* Literal examples:: Source code examples with special formatting 8356* Literal examples:: Source code examples with special formatting
8356* Include files:: Include additional files into a document 8357* Include files:: Include additional files into a document
8357* Index entries:: Making an index 8358* Index entries:: Making an index
8358* Macro replacement:: Use macros to create complex output 8359* Macro replacement:: Use macros to create complex output
8359* Embedded LaTeX:: LaTeX can be freely used inside Org documents 8360* Embedded LaTeX:: LaTeX can be freely used inside Org documents
8360@end menu 8361@end menu
8361 8362
8362@node Structural markup elements, Images and tables, Markup, Markup 8363@node Structural markup elements, Images and tables, Markup, Markup
8363@section Structural markup elements 8364@section Structural markup elements
8364 8365
8365@menu 8366@menu
8366* Document title:: Where the title is taken from 8367* Document title:: Where the title is taken from
8367* Headings and sections:: The document structure as seen by the exporter 8368* Headings and sections:: The document structure as seen by the exporter
8368* Table of contents:: The if and where of the table of contents 8369* Table of contents:: The if and where of the table of contents
8369* Initial text:: Text before the first heading? 8370* Initial text:: Text before the first heading?
8370* Lists:: Lists 8371* Lists:: Lists
8371* Paragraphs:: Paragraphs 8372* Paragraphs:: Paragraphs
8372* Footnote markup:: Footnotes 8373* Footnote markup:: Footnotes
8373* Emphasis and monospace:: Bold, italic, etc. 8374* Emphasis and monospace:: Bold, italic, etc.
8374* Horizontal rules:: Make a line 8375* Horizontal rules:: Make a line
8375* Comment lines:: What will *not* be exported 8376* Comment lines:: What will *not* be exported
8376@end menu 8377@end menu
8377 8378
8378@node Document title, Headings and sections, Structural markup elements, Structural markup elements 8379@node Document title, Headings and sections, Structural markup elements, Structural markup elements
@@ -8801,11 +8802,11 @@ If you observe a few conventions, Org-mode knows how to find it and what
8801to do with it. 8802to do with it.
8802 8803
8803@menu 8804@menu
8804* Special symbols:: Greek letters and other symbols 8805* Special symbols:: Greek letters and other symbols
8805* Subscripts and superscripts:: Simple syntax for raising/lowering text 8806* Subscripts and superscripts:: Simple syntax for raising/lowering text
8806* LaTeX fragments:: Complex formulas made easy 8807* LaTeX fragments:: Complex formulas made easy
8807* Previewing LaTeX fragments:: What will this snippet look like? 8808* Previewing LaTeX fragments:: What will this snippet look like?
8808* CDLaTeX mode:: Speed up entering of formulas 8809* CDLaTeX mode:: Speed up entering of formulas
8809@end menu 8810@end menu
8810 8811
8811@node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX 8812@node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX
@@ -9064,17 +9065,17 @@ Org supports export of selected regions when @code{transient-mark-mode} is
9064enabled (default in Emacs 23). 9065enabled (default in Emacs 23).
9065 9066
9066@menu 9067@menu
9067* Selective export:: Using tags to select and exclude trees 9068* Selective export:: Using tags to select and exclude trees
9068* Export options:: Per-file export settings 9069* Export options:: Per-file export settings
9069* The export dispatcher:: How to access exporter commands 9070* The export dispatcher:: How to access exporter commands
9070* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding 9071* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
9071* HTML export:: Exporting to HTML 9072* HTML export:: Exporting to HTML
9072* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF 9073* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF
9073* DocBook export:: Exporting to DocBook 9074* DocBook export:: Exporting to DocBook
9074* TaskJuggler export:: Exporting to TaskJuggler 9075* TaskJuggler export:: Exporting to TaskJuggler
9075* Freemind export:: Exporting to Freemind mind maps 9076* Freemind export:: Exporting to Freemind mind maps
9076* XOXO export:: Exporting to XOXO 9077* XOXO export:: Exporting to XOXO
9077* iCalendar export:: Exporting in iCalendar format 9078* iCalendar export:: Exporting in iCalendar format
9078@end menu 9079@end menu
9079 9080
9080@node Selective export, Export options, Exporting, Exporting 9081@node Selective export, Export options, Exporting, Exporting
@@ -9327,14 +9328,14 @@ HTML formatting, in ways similar to John Gruber's @emph{markdown}
9327language, but with additional support for tables. 9328language, but with additional support for tables.
9328 9329
9329@menu 9330@menu
9330* HTML Export commands:: How to invoke HTML export 9331* HTML Export commands:: How to invoke HTML export
9331* Quoting HTML tags:: Using direct HTML in Org-mode 9332* Quoting HTML tags:: Using direct HTML in Org-mode
9332* Links in HTML export:: How links will be interpreted and formatted 9333* Links in HTML export:: How links will be interpreted and formatted
9333* Tables in HTML export:: How to modify the formatting of tables 9334* Tables in HTML export:: How to modify the formatting of tables
9334* Images in HTML export:: How to insert figures into HTML output 9335* Images in HTML export:: How to insert figures into HTML output
9335* Text areas in HTML export:: An alternative way to show an example 9336* Text areas in HTML export:: An alternative way to show an example
9336* CSS support:: Changing the appearance of the output 9337* CSS support:: Changing the appearance of the output
9337* JavaScript support:: Info and Folding in a web browser 9338* JavaScript support:: Info and Folding in a web browser
9338@end menu 9339@end menu
9339 9340
9340@node HTML Export commands, Quoting HTML tags, HTML export, HTML export 9341@node HTML Export commands, Quoting HTML tags, HTML export, HTML export
@@ -9681,12 +9682,12 @@ implement links and cross references, the PDF output file will be fully
9681linked. 9682linked.
9682 9683
9683@menu 9684@menu
9684* LaTeX/PDF export commands:: Which key invokes which commands 9685* LaTeX/PDF export commands:: Which key invokes which commands
9685* Header and sectioning:: Setting up the export file structure 9686* Header and sectioning:: Setting up the export file structure
9686* Quoting LaTeX code:: Incorporating literal La@TeX{} code 9687* Quoting LaTeX code:: Incorporating literal La@TeX{} code
9687* Tables in LaTeX export:: Options for exporting tables to La@TeX{} 9688* Tables in LaTeX export:: Options for exporting tables to La@TeX{}
9688* Images in LaTeX export:: How to insert figures into La@TeX{} output 9689* Images in LaTeX export:: How to insert figures into La@TeX{} output
9689* Beamer class export:: Turning the file into a presentation 9690* Beamer class export:: Turning the file into a presentation
9690@end menu 9691@end menu
9691 9692
9692@node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export 9693@node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export
@@ -10011,12 +10012,12 @@ tools and stylesheets.
10011Currently DocBook exporter only supports DocBook V5.0. 10012Currently DocBook exporter only supports DocBook V5.0.
10012 10013
10013@menu 10014@menu
10014* DocBook export commands:: How to invoke DocBook export 10015* DocBook export commands:: How to invoke DocBook export
10015* Quoting DocBook code:: Incorporating DocBook code in Org files 10016* Quoting DocBook code:: Incorporating DocBook code in Org files
10016* Recursive sections:: Recursive sections in DocBook 10017* Recursive sections:: Recursive sections in DocBook
10017* Tables in DocBook export:: Tables are exported as HTML tables 10018* Tables in DocBook export:: Tables are exported as HTML tables
10018* Images in DocBook export:: How to insert figures into DocBook output 10019* Images in DocBook export:: How to insert figures into DocBook output
10019* Special characters:: How to handle special characters 10020* Special characters:: How to handle special characters
10020@end menu 10021@end menu
10021 10022
10022@node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export 10023@node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export
@@ -10442,10 +10443,10 @@ conversion so that files are available in both formats on the server.
10442Publishing has been contributed to Org by David O'Toole. 10443Publishing has been contributed to Org by David O'Toole.
10443 10444
10444@menu 10445@menu
10445* Configuration:: Defining projects 10446* Configuration:: Defining projects
10446* Uploading files:: How to get files up on the server 10447* Uploading files:: How to get files up on the server
10447* Sample configuration:: Example projects 10448* Sample configuration:: Example projects
10448* Triggering publication:: Publication commands 10449* Triggering publication:: Publication commands
10449@end menu 10450@end menu
10450 10451
10451@node Configuration, Uploading files, Publishing, Publishing 10452@node Configuration, Uploading files, Publishing, Publishing
@@ -10455,14 +10456,14 @@ Publishing needs significant configuration to specify files, destination
10455and many other properties of a project. 10456and many other properties of a project.
10456 10457
10457@menu 10458@menu
10458* Project alist:: The central configuration variable 10459* Project alist:: The central configuration variable
10459* Sources and destinations:: From here to there 10460* Sources and destinations:: From here to there
10460* Selecting files:: What files are part of the project? 10461* Selecting files:: What files are part of the project?
10461* Publishing action:: Setting the function doing the publishing 10462* Publishing action:: Setting the function doing the publishing
10462* Publishing options:: Tweaking HTML export 10463* Publishing options:: Tweaking HTML export
10463* Publishing links:: Which links keep working after publishing? 10464* Publishing links:: Which links keep working after publishing?
10464* Sitemap:: Generating a list of all pages 10465* Sitemap:: Generating a list of all pages
10465* Generating an index:: An index that reaches across pages 10466* Generating an index:: An index that reaches across pages
10466@end menu 10467@end menu
10467 10468
10468@node Project alist, Sources and destinations, Configuration, Configuration 10469@node Project alist, Sources and destinations, Configuration, Configuration
@@ -10836,8 +10837,8 @@ project publishing only a set of Org files. The second example is
10836more complex, with a multi-component project. 10837more complex, with a multi-component project.
10837 10838
10838@menu 10839@menu
10839* Simple example:: One-component publishing 10840* Simple example:: One-component publishing
10840* Complex example:: A multi-component publishing example 10841* Complex example:: A multi-component publishing example
10841@end menu 10842@end menu
10842 10843
10843@node Simple example, Complex example, Sample configuration, Sample configuration 10844@node Simple example, Complex example, Sample configuration, Sample configuration
@@ -10966,18 +10967,18 @@ Davison and Eric Schulte, and was originally named Org-babel.
10966The following sections describe Org-mode's code block handling facilities. 10967The following sections describe Org-mode's code block handling facilities.
10967 10968
10968@menu 10969@menu
10969* Structure of code blocks:: Code block syntax described 10970* Structure of code blocks:: Code block syntax described
10970* Editing source code:: Language major-mode editing 10971* Editing source code:: Language major-mode editing
10971* Exporting code blocks:: Export contents and/or results 10972* Exporting code blocks:: Export contents and/or results
10972* Extracting source code:: Create pure source code files 10973* Extracting source code:: Create pure source code files
10973* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer 10974* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer
10974* Library of Babel:: Use and contribute to a library of useful code blocks 10975* Library of Babel:: Use and contribute to a library of useful code blocks
10975* Languages:: List of supported code block languages 10976* Languages:: List of supported code block languages
10976* Header arguments:: Configure code block functionality 10977* Header arguments:: Configure code block functionality
10977* Results of evaluation:: How evaluation results are handled 10978* Results of evaluation:: How evaluation results are handled
10978* Noweb reference syntax:: Literate programming in Org-mode 10979* Noweb reference syntax:: Literate programming in Org-mode
10979* Key bindings and useful functions:: Work quickly with code blocks 10980* Key bindings and useful functions:: Work quickly with code blocks
10980* Batch execution:: Call functions from the command line 10981* Batch execution:: Call functions from the command line
10981@end menu 10982@end menu
10982 10983
10983@comment node-name, next, previous, up 10984@comment node-name, next, previous, up
@@ -11271,8 +11272,8 @@ section provides an overview of the use of header arguments, and then
11271describes each header argument in detail. 11272describes each header argument in detail.
11272 11273
11273@menu 11274@menu
11274* Using header arguments:: Different ways to set header arguments 11275* Using header arguments:: Different ways to set header arguments
11275* Specific header arguments:: List of header arguments 11276* Specific header arguments:: List of header arguments
11276@end menu 11277@end menu
11277 11278
11278@node Using header arguments, Specific header arguments, Header arguments, Header arguments 11279@node Using header arguments, Specific header arguments, Header arguments, Header arguments
@@ -11282,7 +11283,7 @@ The values of header arguments can be set in five different ways, each more
11282specific (and having higher priority) than the last. 11283specific (and having higher priority) than the last.
11283@menu 11284@menu
11284* System-wide header arguments:: Set global default values 11285* System-wide header arguments:: Set global default values
11285* Language-specific header arguments:: Set default values by language 11286* Language-specific header arguments:: Set default values by language
11286* Buffer-wide header arguments:: Set default values for a specific buffer 11287* Buffer-wide header arguments:: Set default values for a specific buffer
11287* Header arguments in Org-mode properties:: Set default values for a buffer or heading 11288* Header arguments in Org-mode properties:: Set default values for a buffer or heading
11288* Code block specific header arguments:: The most common way to set values 11289* Code block specific header arguments:: The most common way to set values
@@ -11419,25 +11420,25 @@ Header arguments for ``Library of Babel'' or function call lines can be set as s
11419The following header arguments are defined: 11420The following header arguments are defined:
11420 11421
11421@menu 11422@menu
11422* var:: Pass arguments to code blocks 11423* var:: Pass arguments to code blocks
11423* results:: Specify the type of results and how they will 11424* results:: Specify the type of results and how they will
11424 be collected and handled 11425 be collected and handled
11425* file:: Specify a path for file output 11426* file:: Specify a path for file output
11426* dir:: Specify the default (possibly remote) 11427* dir:: Specify the default (possibly remote)
11427 directory for code block execution 11428 directory for code block execution
11428* exports:: Export code and/or results 11429* exports:: Export code and/or results
11429* tangle:: Toggle tangling and specify file name 11430* tangle:: Toggle tangling and specify file name
11430* no-expand:: Turn off variable assignment and noweb 11431* no-expand:: Turn off variable assignment and noweb
11431 expansion during tangling 11432 expansion during tangling
11432* comments:: Toggle insertion of comments in tangled 11433* comments:: Toggle insertion of comments in tangled
11433 code files 11434 code files
11434* session:: Preserve the state of code evaluation 11435* session:: Preserve the state of code evaluation
11435* noweb:: Toggle expansion of noweb references 11436* noweb:: Toggle expansion of noweb references
11436* cache:: Avoid re-evaluating unchanged code blocks 11437* cache:: Avoid re-evaluating unchanged code blocks
11437* hlines:: Handle horizontal lines in tables 11438* hlines:: Handle horizontal lines in tables
11438* colnames:: Handle column names in tables 11439* colnames:: Handle column names in tables
11439* rownames:: Handle row names in tables 11440* rownames:: Handle row names in tables
11440* shebang:: Make tangled files executable 11441* shebang:: Make tangled files executable
11441* eval:: Limit evaluation of specific code blocks 11442* eval:: Limit evaluation of specific code blocks
11442@end menu 11443@end menu
11443 11444
@@ -12292,15 +12293,15 @@ emacsclient \
12292@chapter Miscellaneous 12293@chapter Miscellaneous
12293 12294
12294@menu 12295@menu
12295* Completion:: M-TAB knows what you need 12296* Completion:: M-TAB knows what you need
12296* Speed keys:: Electric commands at the beginning of a headline 12297* Speed keys:: Electric commands at the beginning of a headline
12297* Code evaluation security:: Org mode files evaluate inline code 12298* Code evaluation security:: Org mode files evaluate inline code
12298* Customization:: Adapting Org to your taste 12299* Customization:: Adapting Org to your taste
12299* In-buffer settings:: Overview of the #+KEYWORDS 12300* In-buffer settings:: Overview of the #+KEYWORDS
12300* The very busy C-c C-c key:: When in doubt, press C-c C-c 12301* The very busy C-c C-c key:: When in doubt, press C-c C-c
12301* Clean view:: Getting rid of leading stars in the outline 12302* Clean view:: Getting rid of leading stars in the outline
12302* TTY keys:: Using Org on a tty 12303* TTY keys:: Using Org on a tty
12303* Interaction:: Other Emacs packages 12304* Interaction:: Other Emacs packages
12304@end menu 12305@end menu
12305 12306
12306 12307
@@ -12928,8 +12929,8 @@ Org lives in the world of GNU Emacs and interacts in various ways
12928with other code out there. 12929with other code out there.
12929 12930
12930@menu 12931@menu
12931* Cooperation:: Packages Org cooperates with 12932* Cooperation:: Packages Org cooperates with
12932* Conflicts:: Packages that lead to conflicts 12933* Conflicts:: Packages that lead to conflicts
12933@end menu 12934@end menu
12934 12935
12935@node Cooperation, Conflicts, Interaction, Interaction 12936@node Cooperation, Conflicts, Interaction, Interaction
@@ -13077,9 +13078,9 @@ fixed this problem:
13077 13078
13078@lisp 13079@lisp
13079(add-hook 'org-mode-hook 13080(add-hook 'org-mode-hook
13080 (lambda () 13081 (lambda ()
13081 (org-set-local 'yas/trigger-key [tab]) 13082 (org-set-local 'yas/trigger-key [tab])
13082 (define-key yas/keymap [tab] 'yas/next-field-group))) 13083 (define-key yas/keymap [tab] 'yas/next-field-group)))
13083@end lisp 13084@end lisp
13084 13085
13085@item @file{windmove.el} by Hovav Shacham 13086@item @file{windmove.el} by Hovav Shacham
@@ -13121,16 +13122,16 @@ This appendix covers some aspects where users can extend the functionality of
13121Org. 13122Org.
13122 13123
13123@menu 13124@menu
13124* Hooks:: Who to reach into Org's internals 13125* Hooks:: Who to reach into Org's internals
13125* Add-on packages:: Available extensions 13126* Add-on packages:: Available extensions
13126* Adding hyperlink types:: New custom link types 13127* Adding hyperlink types:: New custom link types
13127* Context-sensitive commands:: How to add functionality to such commands 13128* Context-sensitive commands:: How to add functionality to such commands
13128* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs 13129* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs
13129* Dynamic blocks:: Automatically filled blocks 13130* Dynamic blocks:: Automatically filled blocks
13130* Special agenda views:: Customized views 13131* Special agenda views:: Customized views
13131* Extracting agenda information:: Postprocessing of agenda information 13132* Extracting agenda information:: Postprocessing of agenda information
13132* Using the property API:: Writing programs that use entry properties 13133* Using the property API:: Writing programs that use entry properties
13133* Using the mapping API:: Mapping over all or selected entries 13134* Using the mapping API:: Mapping over all or selected entries
13134@end menu 13135@end menu
13135 13136
13136@node Hooks, Add-on packages, Hacking, Hacking 13137@node Hooks, Add-on packages, Hacking, Hacking
@@ -13322,10 +13323,10 @@ can use Org's facilities to edit and structure lists by turning
13322 13323
13323 13324
13324@menu 13325@menu
13325* Radio tables:: Sending and receiving radio tables 13326* Radio tables:: Sending and receiving radio tables
13326* A LaTeX example:: Step by step, almost a tutorial 13327* A LaTeX example:: Step by step, almost a tutorial
13327* Translator functions:: Copy and modify 13328* Translator functions:: Copy and modify
13328* Radio lists:: Doing the same for lists 13329* Radio lists:: Doing the same for lists
13329@end menu 13330@end menu
13330 13331
13331@node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax 13332@node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax
@@ -14098,9 +14099,9 @@ in-buffer settings, but it will understand the logistics of TODO state
14098(@pxref{Setting tags}) only for those set in these variables. 14099(@pxref{Setting tags}) only for those set in these variables.
14099 14100
14100@menu 14101@menu
14101* Setting up the staging area:: Where to interact with the mobile device 14102* Setting up the staging area:: Where to interact with the mobile device
14102* Pushing to MobileOrg:: Uploading Org files and agendas 14103* Pushing to MobileOrg:: Uploading Org files and agendas
14103* Pulling from MobileOrg:: Integrating captured and flagged items 14104* Pulling from MobileOrg:: Integrating captured and flagged items
14104@end menu 14105@end menu
14105 14106
14106@node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg 14107@node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index b9c83be457e..775e4788de0 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -16,7 +16,7 @@
16 16
17@include trampver.texi 17@include trampver.texi
18 18
19@c Macro for formatting a filename according to the repective syntax. 19@c Macro for formatting a filename according to the respective syntax.
20@c xxx and yyy are auxiliary macros in order to omit leading and 20@c xxx and yyy are auxiliary macros in order to omit leading and
21@c trailing whitespace. Not very elegant, but I don't know it better. 21@c trailing whitespace. Not very elegant, but I don't know it better.
22 22
@@ -105,11 +105,6 @@ If you're using the other Emacs flavor, you should read the
105@end ifset 105@end ifset
106 106
107@ifhtml 107@ifhtml
108@ifset jamanual
109This manual is also available as a @uref{@value{japanesemanual},
110Japanese translation}.
111@end ifset
112
113The latest release of @value{tramp} is available for 108The latest release of @value{tramp} is available for
114@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see 109@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see
115@ref{Obtaining Tramp} for more details, including the CVS server 110@ref{Obtaining Tramp} for more details, including the CVS server
@@ -171,7 +166,6 @@ Installing @value{tramp} with your @value{emacsname}
171 166
172* Installation parameters:: Parameters in order to control installation. 167* Installation parameters:: Parameters in order to control installation.
173* Load paths:: How to plug-in @value{tramp} into your environment. 168* Load paths:: How to plug-in @value{tramp} into your environment.
174* Japanese manual:: Japanese manual.
175 169
176@end ifset 170@end ifset
177 171
@@ -625,10 +619,6 @@ or 2 to connect to the remote host. (You can also specify in
625@file{~/.ssh/config}, the SSH configuration file, which protocol 619@file{~/.ssh/config}, the SSH configuration file, which protocol
626should be used, and use the regular @option{ssh} method.) 620should be used, and use the regular @option{ssh} method.)
627 621
628Two other variants, @option{ssh1_old} and @option{ssh2_old}, use the
629@command{ssh1} and @command{ssh2} commands explicitly. If you don't
630know what these are, you do not need these options.
631
632All the methods based on @command{ssh} have an additional feature: you 622All the methods based on @command{ssh} have an additional feature: you
633can specify a host name which looks like @file{host#42} (the real host 623can specify a host name which looks like @file{host#42} (the real host
634name, then a hash sign, then a port number). This means to connect to 624name, then a hash sign, then a port number). This means to connect to
@@ -737,19 +727,6 @@ expects PuTTY session names, calling @samp{plink -load @var{session}
737hasn't defined a user name. Different port numbers must be defined in 727hasn't defined a user name. Different port numbers must be defined in
738the session. 728the session.
739 729
740
741@item @option{fish}
742@cindex method fish
743@cindex fish method
744
745This is an experimental implementation of the fish protocol, known from
746the GNU Midnight Commander or the KDE Konqueror. @value{tramp} expects
747the fish server implementation from the KDE kioslave. That means, the
748file @file{~/.fishsrv.pl} is expected to reside on the remote host.
749
750The implementation lacks good performance. The code is offered anyway,
751maybe somebody can improve the performance.
752
753@end table 730@end table
754 731
755 732
@@ -809,10 +786,6 @@ or 2 to connect to the remote host. (You can also specify in
809@file{~/.ssh/config}, the SSH configuration file, which protocol 786@file{~/.ssh/config}, the SSH configuration file, which protocol
810should be used, and use the regular @option{scp} method.) 787should be used, and use the regular @option{scp} method.)
811 788
812Two other variants, @option{scp1_old} and @option{scp2_old}, use the
813@command{ssh1} and @command{ssh2} commands explicitly. If you don't
814know what these are, you do not need these options.
815
816All the @command{ssh} based methods support the @samp{-p} feature 789All the @command{ssh} based methods support the @samp{-p} feature
817where you can specify a port number to connect to in the host name. 790where you can specify a port number to connect to in the host name.
818For example, the host name @file{host#42} tells @value{tramp} to 791For example, the host name @file{host#42} tells @value{tramp} to
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 25fa4908143..107e4d70aa3 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -9,7 +9,7 @@
9@c In the Tramp CVS, the version number is auto-frobbed from 9@c In the Tramp CVS, the version number is auto-frobbed from
10@c configure.ac, so you should edit that file and run 10@c configure.ac, so you should edit that file and run
11@c "autoconf && ./configure" to change the version number. 11@c "autoconf && ./configure" to change the version number.
12@set trampver 2.1.19 12@set trampver 2.2.0-pre
13 13
14@c Other flags from configuration 14@c Other flags from configuration
15@set instprefix /usr/local 15@set instprefix /usr/local
@@ -56,7 +56,6 @@
56@set emacsothername XEmacs 56@set emacsothername XEmacs
57@set emacsotherdir xemacs 57@set emacsotherdir xemacs
58@set emacsotherfilename tramp-xemacs.html 58@set emacsotherfilename tramp-xemacs.html
59@set japanesemanual tramp_ja-emacs.html
60@end ifset 59@end ifset
61 60
62@c XEmacs counterparts. 61@c XEmacs counterparts.
@@ -73,7 +72,6 @@
73@set emacsothername GNU Emacs 72@set emacsothername GNU Emacs
74@set emacsotherdir emacs 73@set emacsotherdir emacs
75@set emacsotherfilename tramp-emacs.html 74@set emacsotherfilename tramp-emacs.html
76@set japanesemanual tramp_ja-xemacs.html
77@end ifset 75@end ifset
78 76
79@ignore 77@ignore
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 70e002f0f9e..84754efb148 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,16 @@
12010-09-13 Michael Albinus <michael.albinus@gmx.de>
2
3 * NEWS: Some Tramp methods are discontinued.
4
52010-09-11 Glenn Morris <rgm@gnu.org>
6
7 * emacs.bash, emacs.csh, ms-kermit: Remove obsolete files (use
8 emacsclient -a instead of the first two).
9
102010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
11
12 * NEWS: Mention the new libxml2 functions.
13
12010-08-25 Kenichi Handa <handa@m17n.org> 142010-08-25 Kenichi Handa <handa@m17n.org>
2 15
3 * HELLO: Change designation sequences for Arabic text. 16 * HELLO: Change designation sequences for Arabic text.
diff --git a/etc/NEWS b/etc/NEWS
index 72075945f62..6689bbb4bd6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -113,21 +113,17 @@ The frame-parameter tool-bar-position controls this. It takes the values
113top, left, right or bottom. The Options => Show/Hide menu has entries 113top, left, right or bottom. The Options => Show/Hide menu has entries
114for this. 114for this.
115 115
116** ImageMagick support 116** ImageMagick support.
117It is now possible to use the Imagemagick library to load many new 117It is now possible to use the Imagemagick library to load many new
118image formats in Emacs. 118image formats in Emacs. To enable this, use the configure option
119`--with-imagemagick'.
119 120
120To enable, use the following configure option: 121The new function `imagemagick-types' returns a list of image file
121--with-imagemagick 122extensions that your installation of ImageMagick supports. The
123function `imagemagick-register-types' enables ImageMagick support for
124these imaeg types, minus those listed in `imagemagick-types-inhibit'.
122 125
123The new function (imagemagick-types) returns a list of image file 126See the Emacs Lisp Reference Manual for more information.
124extensions that your installation of imagemagick supports.
125
126The function (imagemagick-register-types) will enable the imagemagick
127support for the extensions in imagemagick-types minus the types listed
128in imagemagick-types-inhibit.
129
130See the Emacs Manual for more information.
131 127
132** The colors for selected text (the region face) are taken from the GTK 128** The colors for selected text (the region face) are taken from the GTK
133theme when Emacs is built with GTK. 129theme when Emacs is built with GTK.
@@ -321,10 +317,24 @@ For example, adding "(diff-mode . ((mode . whitespace)))" to your
321variables `sql-product', `sql-user', `sql-server', `sql-database' and 317variables `sql-product', `sql-user', `sql-server', `sql-database' and
322`sql-port' can now be safely used as local variables. 318`sql-port' can now be safely used as local variables.
323 319
320*** `sql-dialect' is a synonym for `sql-product'.
321
324*** Added ability to login with a port on MySQL. 322*** Added ability to login with a port on MySQL.
325The custom variable `sql-port' can be specified for connection to 323The custom variable `sql-port' can be specified for connection to
326MySQL servers. 324MySQL servers.
327 325
326*** Dynamic selection of product in an SQL interactive session.
327If you use `sql-product-interactive' to start an SQL interactive
328session it uses the current value of `sql-product'. Preceding the
329invocation with C-u will force it to ask for the product before
330creating the session.
331
332*** Renaming a SQL interactive buffer when it is created.
333Prefixing the SQL interactive commands (`sql-sqlite', `sql-postgres',
334`sql-mysql', etc.) with C-u will force a new interactive session to be
335started and will prompt for the new name. This will reduce the need
336for `sql-rename-buffer' is most common use cases.
337
328*** Command continuation prompts in SQL interactive mode are suppressed. 338*** Command continuation prompts in SQL interactive mode are suppressed.
329Multiple line commands in SQL interactive mode, generate command 339Multiple line commands in SQL interactive mode, generate command
330continuation prompts which needlessly confuse the output. These 340continuation prompts which needlessly confuse the output. These
@@ -424,6 +434,11 @@ threads simultaneously.
424*** It is possible now, to access alternative buses than the default 434*** It is possible now, to access alternative buses than the default
425system or session bus. 435system or session bus.
426 436
437** Tramp
438
439*** The following access methods are discontinued: "ssh1_old",
440"ssh2_old", "scp1_old", "scp2_old" and "fish".
441
427 442
428* New Modes and Packages in Emacs 24.1 443* New Modes and Packages in Emacs 24.1
429 444
@@ -470,8 +485,19 @@ has now been removed.
470 485
471* Lisp changes in Emacs 24.1 486* Lisp changes in Emacs 24.1
472 487
488** New variable syntax-propertize-function to set syntax-table properties.
489Replaces font-lock-syntactic-keywords which are now obsolete.
490This allows syntax-table properties to be set independently from font-lock:
491just call syntax-propertize to make sure the text is propertized.
492Together with this new variable come a new hook
493syntax-propertize-extend-region-functions, as well as two helper functions:
494syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords
495as-is; and syntax-propertize-rules which provides a new way to specify
496syntactic rules.
497
473** New hook post-self-insert-hook run at the end of self-insert-command. 498** New hook post-self-insert-hook run at the end of self-insert-command.
474 499
500+++
475** Syntax tables support a new "comment style c" additionally to style b. 501** Syntax tables support a new "comment style c" additionally to style b.
476** frame-local variables cannot be let-bound any more. 502** frame-local variables cannot be let-bound any more.
477** prog-mode is a new major-mode meant to be the parent of programming mode. 503** prog-mode is a new major-mode meant to be the parent of programming mode.
@@ -497,6 +523,14 @@ by the Graphic Control Extension of the image.
497 523
498*** `image-extension-data' is renamed to `image-metadata'. 524*** `image-extension-data' is renamed to `image-metadata'.
499 525
526** XML and HTML parsing
527
528*** If Emacs is compiled with libxml2 support (which is the default),
529two new Emacs Lisp-level functions are defined: `html-parse-string'
530(which will parse "real world" HTML) and `xml-parse-string' (which
531parses XML). Both return an Emacs Lisp parse tree. See the Emacs
532Lisp Reference Manual for details.
533
500** Isearch 534** Isearch
501 535
502*** New hook `isearch-update-post-hook' that runs in `isearch-update'. 536*** New hook `isearch-update-post-hook' that runs in `isearch-update'.
diff --git a/etc/NEWS.23 b/etc/NEWS.23
index 74291bab8ab..e63767d891c 100644
--- a/etc/NEWS.23
+++ b/etc/NEWS.23
@@ -40,6 +40,8 @@ This can be used in place of the default appt-message-warning-time.
40 40
41* Lisp changes in Emacs 23.3 41* Lisp changes in Emacs 23.3
42 42
43** The use of unintern without an obarray arg is declared obsolete.
44
43** New function byte-to-string, like char-to-string but for bytes. 45** New function byte-to-string, like char-to-string but for bytes.
44 46
45 47
diff --git a/etc/TODO b/etc/TODO
index d58eb8be3d8..966d3eb6976 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -625,6 +625,508 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html
625 the window associated with that modeline. 625 the window associated with that modeline.
626 http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html 626 http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html
627 627
628* Things to be done for specific packages or features
629
630** ImageMagick support
631
632*** image-type-header-regexps priorities the jpeg loader over the
633ImageMagick one. This is not wrong, but how should a user go about
634prefering the ImageMagick loader? The user might like zooming etc in jpegs.
635
636Try (setq image-type-header-regexps nil) for a quick hack to prefer
637ImageMagick over the jpg loader.
638
639*** For some reason its unbearably slow to look at a page in a large
640image bundle using the :index feature. The ImageMagick "display"
641command is also a bit slow, but nowhere near as slow as the Emacs
642code. It seems ImageMagick tries to unpack every page when loading the
643bundle. This feature is not the primary usecase in Emacs though.
644
645ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load. It
646is now much faster to use the :index feature, but still not very fast.
647
648*** Try to cache the num pages calculation. It can take a while to
649calculate the number of pages, and if you need to do it for each page
650view, page-flipping becomes uselessly slow.
651
652*** Integrate with image-dired.
653
654*** Integrate with docview.
655
656*** Integrate with image-mode.
657Some work has been done, e.g. M-x image-transform-fit-to-height will
658fit the image to the height of the Emacs window.
659
660*** Look for optimizations for handling images with low depth.
661Currently the code seems to default to 24 bit RGB which is costly for
662images with lower bit depth.
663
664*** Decide what to do with some uncommitted imagemagick support
665functions for image size etc.
666
667*** Test with more systems.
668Tested on Fedora 12, 14, and the libmagick that ships with it.
669I also tried using an ImageMagick compiled from their SVN, in
670parallel with the one packaged by Fedora, it worked well.
671Ubuntu 8.04 was tested, but it seems it ships a broken ImageMagick.
672
673** nxml mode
674
675*** High priority
676
677**** Command to insert an element template, including all required
678attributes and child elements. When there's a choice of elements
679possible, we could insert a comment, and put an overlay on that
680comment that makes it behave like a button with a pop-up menu to
681select the appropriate choice.
682
683**** Command to tag a region. With a schema should complete using legal
684tags, but should work without a schema as well.
685
686**** Provide a way to conveniently rename an element. With a schema should
687complete using legal tags, but should work without a schema as well.
688
689*** Outlining
690
691**** Implement C-c C-o C-q.
692
693**** Install pre/post command hook for moving out of invisible section.
694
695**** Put a modify hook on invisible sections that expands them.
696
697**** Integrate dumb folding somehow.
698
699**** An element should be able to be its own heading.
700
701**** Optimize to avoid complete buffer scan on each command.
702
703**** Make it work with HTML-style headings (i.e. level indicated by
704name of heading element rather than depth of section nesting).
705
706**** Recognize root element as a section provided it has a title, even
707if it doesn't match section-element-name-regex.
708
709**** Support for incremental search automatically making hidden text visible.
710
711**** Allow title to be an attribute.
712
713**** Command that says to recognize the tag at point as a section/heading.
714
715**** Explore better ways to determine when an element is a section
716or a heading.
717
718**** rng-next-error needs to either ignore invisible portion or reveal it
719(maybe use isearch oriented text properties).
720
721**** Errors within hidden section should be highlighted by underlining the
722ellipsis.
723
724**** Make indirect buffers work.
725
726**** How should nxml-refresh outline recover from non well-formed tags?
727
728**** Hide tags in title elements?
729
730**** Use overlays instead of text properties for holding outline state?
731Necessary for indirect buffers to work?
732
733**** Allow an outline to go in the speedbar.
734
735**** Split up outlining manual section into subsections.
736
737**** More detail in the manual about each outlining command.
738
739**** More menu entries for hiding/showing?
740
741**** Indication of many lines have been hidden?
742
743*** Locating schemas
744
745**** Should rng-validate-mode give the user an opportunity to specify a
746schema if there is currently none? Or should it at least give a hint
747to the user how to specify a non-vacuous schema?
748
749**** Support for adding new schemas to schema-locating files.
750Add documentElement and namespace elements.
751
752**** C-c C-w should be able to report current type id.
753
754**** Implement doctypePublicId.
755
756**** Implement typeIdBase.
757
758**** Implement typeIdProcessingInstruction.
759
760**** Support xml:base.
761
762**** Implement group.
763
764**** Find preferred prefix from schema-locating files. Get rid of
765rng-preferred-prefix-alist.
766
767**** Inserting document element with vacuous schema should complete using
768document elements declared in schema locating files, and set schema
769appropriately.
770
771**** Add a ruleType attribute to the <include> element?
772
773**** Allow processing instruction in prolog to contain the compact syntax
774schema directly.
775
776**** Use RDDL to locate a schema based on the namespace URI.
777
778**** Should not prompt to add redundant association to schema locating file.
779
780**** Command to reload current schema.
781
782*** Schema-sensitive features
783
784**** Should filter dynamic markup possibilities using schema validity, by
785adding hook to nxml-mode.
786
787**** Dynamic markup word should (at least optionally) be able to look in
788other buffers that are using nxml-mode.
789
790**** Should clicking on Invalid move to next error if already on an error?
791
792**** Take advantage of a:documentation. Needs change to schema format.
793
794**** Provide feasible validation (as in Jing) toggle.
795
796**** Save the validation state as a property on the error overlay to enable
797more detailed diagnosis.
798
799**** Provide an Error Summary buffer showing all the validation errors.
800
801**** Pop-up menu. What is useful? Tag a region (should be greyed out if
802the region is not balanced). Suggestions based on error messages.
803
804**** Have configurable list of namespace URIs so that we can provide
805namespace URI completion on extension elements or with schema-less documents.
806
807**** Allow validation to handle XInclude.
808
809**** ID/IDREF support.
810
811*** Completion
812
813**** Make it work with icomplete. Only use a function to complete when
814some of the possible names have undeclared namespaces.
815
816**** How should C-return in mixed text work?
817
818**** When there's a vacuous schema, C-return after < will insert the end-tag.
819Is this a bug or a feature?
820
821**** After completing start-tag, ensure we don't get unhelpful message
822from validation
823
824**** Syntax table for completion.
825
826**** Should complete start-tag name with a space if namespace attributes
827are required.
828
829**** When completing start-tag name with no prefix and it doesn't match
830should try to infer namespace from local name.
831
832**** Should completion pay attention to characters after point? If so, how?
833
834**** When completing start-tag name, add required atts if only one required
835attribute.
836
837**** When completing attribute name, add attribute value if only one value
838is possible.
839
840**** After attribute-value completion, insert space after close delimiter
841if more attributes are required.
842
843**** Complete on enumerated data values in elements.
844
845**** When in context that allows only elements, should get tag
846completion without having to type < first.
847
848**** When immediately after start-tag name, and name is valid and not
849prefix of any other name, should C-return complete on attribute names?
850
851**** When completing attributes, more consistent to ignore all attributes
852after point.
853
854**** Inserting attribute value completions needs to be sensitive to what
855delimiter is used so that it quotes the correct character.
856
857**** Complete on encoding-names in XML decl.
858
859**** Complete namespace declarations by searching for all namespaces
860mentioned in the schema.
861
862*** Well-formed XML support
863
864**** Deal better with Mule-UCS
865
866**** Deal with UTF-8 BOM when reading.
867
868**** Complete entity names.
869
870**** Provide some support for entity names for MathML.
871
872**** Command to repeat the last tag.
873
874**** Support for changing between character references and characters.
875Need to check that context is one in which character references are
876allowed. xmltok prolog parsing will need to distinguish parameter
877literals from other kinds of literal.
878
879**** Provide a comment command to bind to M-; that works better than the
880normal one.
881
882**** Make indenting in a multi-line comment work.
883
884**** Structure view. Separate buffer displaying element tree.
885Be able to navigate from structure view to document and vice-versa.
886
887**** Flash matching >.
888
889**** Smart selection command that selects increasingly large syntactically
890coherent chunks of XML. If point is in an attribute value, first
891select complete value; then if command is repeated, select value plus
892delimiters, then select attribute name as well, then complete
893start-tag, then complete element, then enclosing element, etc.
894
895**** ispell integration.
896
897**** Block-level items in mixed content should be indented, e.g:
898 <para>This is list:
899 <ul>
900 <li>item</li>
901
902**** Provide option to indent like this:
903 <para>This is a paragraph
904 occupying multiple lines.</para>
905
906**** Option to add make a / that closes a start-tag electrically insert a
907space for the XHTML guys.
908
909**** C-M-q should work.
910
911*** Datatypes
912
913**** Figure out workaround for CJK characters with regexps.
914
915**** Does category C contain Cn?
916
917**** Do ENTITY datatype properly.
918
919*** XML Parsing Library
920
921**** Parameter entity parsing option, nil (never), t (always),
922unless-standalone (unless standalone="yes" in XML declaration).
923
924**** When a file is currently being edited, there should be an option to
925use its buffer instead of the on-disk copy.
926
927*** Handling all XML features
928
929**** Provide better support for editing external general parsed entities.
930Perhaps provide a way to force ignoring undefined entities; maybe turn
931this on automatically with <?xml encoding=""?> (with no version
932pseudo-att).
933
934**** Handle internal general entity declarations containing elements.
935
936**** Handle external general entity declarations.
937
938**** Handle default attribute declarations in internal subset.
939
940**** Handle parameter entities (including DTD).
941
942*** RELAX NG
943
944**** Do complete schema checking, at least optionally.
945
946**** Detect include/external loops during schema parse.
947
948**** Coding system detection for schemas. Should use utf-8/utf-16 per the
949spec. But also need to allow encodings other than UTF-8/16 to support
950CJK charsets that Emacs cannot represent in Unicode.
951
952*** Catching XML errors
953
954**** Check public identifiers.
955
956**** Check default attribute values.
957
958*** Performance
959
960**** Explore whether overlay-recenter can cure overlays performance problems.
961
962**** Cache schemas. Need to have list of files and mtimes.
963
964**** Make it possible to reduce rng-validate-chunk-size significantly,
965perhaps to 500 bytes, without bad performance impact: don't do
966redisplay on every chunk; pass continue functions on other uses of
967rng-do-some-validation.
968
969**** Cache after first tag.
970
971**** Introduce a new name class that is a choice between names (so that
972we can use member)
973
974**** intern-choice should simplify after patterns with same 1st/2nd args
975
976**** Large numbers of overlays slow things down dramatically. Represent
977errors using text properties. This implies we cannot incrementally
978keep track of the number of errors, in order to determine validity.
979Instead, when validation completes, scan for any characters with an
980error text property; this seems to be fast enough even with large
981buffers. Problem with error at end of buffer, where there's no
982character; need special variable for this. Need to merge face from
983font-lock with the error face: use :inherit attribute with list of two
984faces. How do we avoid making rng-valid depend on nxml-mode?
985
986*** Error recovery
987
988**** Don't stop at newline in looking for close of start-tag.
989
990**** Use indentation to guide recovery from mismatched end-tags
991
992**** Don't keep parsing when currently not well-formed but previously
993well-formed
994
995**** Try to recover from a bad start-tag by popping an open element if
996there was a mismatched end-tag unaccounted for.
997
998**** Try to recover from a bad start-tag open on the hypothesis that there
999was an error in the namespace URI.
1000
1001**** Better recovery from ill-formed XML declarations.
1002
1003*** Useability improvements
1004
1005**** Should print a "Parsing..." message during long movements.
1006
1007**** Provide better position for reference to undefined pattern error.
1008
1009**** Put Well-formed in the mode-line when validating against any-content.
1010
1011**** Trim marking of illegal data for leading and trailing whitespace.
1012
1013**** Show Invalid status as soon as we are sure it's invalid, rather than
1014waiting for everything to be completely up to date.
1015
1016**** When narrowed, Valid or Invalid status should probably consider only
1017validity of narrowed region.
1018
1019*** Bug fixes
1020
1021**** Need to give an error for a document like: <foo/><![CDATA[ ]]>
1022
1023**** Make nxml-forward-balanced-item work better for the prolog.
1024
1025**** Make filling and indenting comments work in the prolog.
1026
1027**** Should delete RNC Input buffers.
1028
1029**** Figure out what regex use for NCName and use it consistently,
1030
1031**** Should have not-well-formed tokens in ref.
1032
1033**** Require version in XML declaration? Probably not because prevents
1034use for external parsed entities. At least forbid standalone without version.
1035
1036**** Reject schema that compiles to rng-not-allowed-ipattern.
1037
1038**** Move point backwards on schema parse error so that it's on the right token.
1039
1040*** Internal
1041
1042**** Use rng-quote-string consistently.
1043
1044**** Use parsing library for XML to texinfo conversion.
1045
1046**** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of
1047xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to
1048nxml-t-token-start.
1049
1050**** Can we set fill-prefix to nil and rely on indenting?
1051
1052**** xmltok should make available replacement text of entities containing
1053elements
1054
1055**** In rng-valid, instead of using modification-hooks and
1056insert-behind-hooks on dependent overlays, use same technique as nxml-mode.
1057
1058**** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on
1059Mule-UCS); overlays/text properties vs extents; absence of
1060fontification-functions hook.
1061
1062*** Fontification
1063
1064**** Allow face to depend on element qname, attribute qname, attribute
1065value. Use list with pairs of (R . F), where R specifies regexps and
1066F specifies faces. How can this list be made to depend on the document type?
1067
1068*** Other
1069
1070**** Support RELAX NG XML syntax (use XML parsing library).
1071
1072**** Support W3C XML Schema (use XML parsing library).
1073
1074**** Command to infer schema from current document (like trang).
1075
1076*** Schemas
1077
1078**** XSLT schema should take advantage of RELAX NG to express cooccurrence
1079constraints on attributes (e.g. xsl:template).
1080
1081*** Documentation
1082
1083**** Move material from README to manual.
1084
1085**** Document encodings.
1086
1087*** Notes
1088
1089**** How can we allow an error to be displayed on a different token from
1090where it is detected? In particular, for a missing closing ">" we
1091will need to display it at the beginning of the following token. At the
1092moment, when we parse the following token the error overlay will get cleared.
1093
1094**** How should rng-goto-next-error deal with narrowing?
1095
1096**** Perhaps should merge errors having same start position even if they
1097have different ends.
1098
1099**** How to handle surrogates? One possibility is to be compatible with
1100utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible
1101with this.
1102
1103**** Should we distinguish well-formedness errors from invalidity errors?
1104(I think not: we may want to recover from a bad start-tag by implying
1105an end-tag.)
1106
1107**** Seems to be a bug with Emacs, where a mouse movement that causes
1108help-echo text to appear counts as pending input but does not cause
1109idle timer to be restarted.
1110
1111**** Use XML to represent this file.
1112
1113**** I had a TODO which said simply "split-string". What did I mean?
1114
1115**** Investigate performance on large files all on one line.
1116
1117*** Issues for Emacs versions >= 22
1118
1119**** Take advantage of UTF-8 CJK support.
1120
1121**** Supply a next-error-function.
1122
1123**** Investigate this NEWS item "Emacs now tries to set up buffer coding
1124systems for HTML/XML files automatically."
1125
1126**** Take advantage of the pointer text property.
1127
1128**** Leverage char-displayable-p.
1129
628* Internal changes 1130* Internal changes
629 1131
630** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction 1132** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction
diff --git a/etc/emacs.bash b/etc/emacs.bash
deleted file mode 100644
index 5cebee1227d..00000000000
--- a/etc/emacs.bash
+++ /dev/null
@@ -1,71 +0,0 @@
1### emacs.bash --- contact/resume an existing Emacs, or start a new one
2
3## Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4## Free Software Foundation, Inc.
5
6## Author: Noah Friedman
7
8## This file is part of GNU Emacs.
9
10## GNU Emacs is free software: you can redistribute it and/or modify
11## it under the terms of the GNU General Public License as published by
12## the Free Software Foundation, either version 3 of the License, or
13## (at your option) any later version.
14
15## GNU Emacs is distributed in the hope that it will be useful,
16## but WITHOUT ANY WARRANTY; without even the implied warranty of
17## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18## GNU General Public License for more details.
19
20## You should have received a copy of the GNU General Public License
21## along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23### Commentary:
24
25## This file is obsolete. Use emacsclient -a instead.
26
27## This defines a bash command named `edit' which contacts/resumes an
28## existing emacs or starts a new one if none exists.
29
30## One way or another, any arguments are passed to emacs to specify files
31## (provided you have loaded `resume.el').
32
33## This function assumes the emacs program is named `emacs' and is somewhere
34## in your load path. If either of these is not true, the most portable
35## (and convenient) thing to do is to make an alias called emacs which
36## refers to the real program, e.g.
37##
38## alias emacs=/usr/local/bin/gemacs
39
40function edit ()
41{
42 local windowsys="${WINDOW_PARENT+sun}"
43
44 windowsys="${windowsys:-${DISPLAY+x}}"
45
46 if [ -n "${windowsys:+set}" ]; then
47 # Do not just test if these files are sockets. On some systems
48 # ordinary files or fifos are used instead. Just see if they exist.
49 if [ -e "${HOME}/.emacs_server" -o -e "/tmp/emacs${UID}/server" ]; then
50 emacsclient "$@"
51 return $?
52 else
53 echo "edit: starting emacs in background..." 1>&2
54 fi
55
56 case "${windowsys}" in
57 x ) (emacs "$@" &) ;;
58 sun ) echo "unsupported window system"; return 1 ;;
59 esac
60 else
61 if jobs %emacs 2> /dev/null ; then
62 echo "$(pwd)" "$@" >| ${HOME}/.emacs_args && fg %emacs
63 else
64 emacs "$@"
65 fi
66 fi
67}
68
69
70# arch-tag: 1e1b74b9-bf2c-4b23-870f-9eebff7515cb
71### emacs.bash ends here
diff --git a/etc/emacs.csh b/etc/emacs.csh
deleted file mode 100644
index ef860727284..00000000000
--- a/etc/emacs.csh
+++ /dev/null
@@ -1,31 +0,0 @@
1### emacs.csh
2
3## Add legal notice if non-trivial amounts of code are added.
4
5## Author: Michael DeCorte
6
7### Commentary:
8
9## This file is obsolete. Use emacsclient -a instead.
10
11## This defines a csh command named `edit' which resumes an
12## existing Emacs or starts a new one if none exists.
13## One way or another, any arguments are passed to Emacs to specify files
14## (provided you have loaded `resume.el').
15
16## These are the possible values of $whichjob
17## 1 = new ordinary emacs (the -nw is so that it doesn't try to do X)
18## 2 = resume emacs
19## 3 = new emacs under X (-i is so that you get a reasonable icon)
20## 4 = resume emacs under X
21set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS"
22
23alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\
24 "emacsclient \!* &") ; \
25 jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \
26 @ isjob = ! $status; \
27 @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \
28 test -S ~/.emacs_server && emacsclient \!* \
29 || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]'
30
31# arch-tag: 433d58df-15b9-446f-ad37-f0393e3a23d4
diff --git a/etc/ms-kermit b/etc/ms-kermit
deleted file mode 100644
index ba53add6a78..00000000000
--- a/etc/ms-kermit
+++ /dev/null
@@ -1,172 +0,0 @@
1;;; The code here is forced by the interface, and is not subject to
2;;; copyright, constituting the only possible expression of the algorithm
3;;; in this format.
4
5;;; This file is designed for an 8-bit connection.
6;;; Use the file ms-7bkermit if you have a 7-bit connection.
7
8;; Meta key mappings for EMACS
9;; By Robert Earl (rearl@watnxt3.ucr.edu)
10;; May 13, 1990
11;;
12;; WARNING:
13;; requires an 8-bit path to host. many dialups and lans won't pass the
14;; eighth bit by default and may require a special command to turn this
15;; off. `screen' is known to mask the eighth bit of input as well.
16
17set term controls 8-bit
18set translation key off
19
20;; control keys
21set key \3449 \128 ;; m-c-@
22set key \3358 \129 ;; m-c-a
23set key \3376 \130 ;; m-c-b
24set key \3374 \131 ;; m-c-c
25set key \3360 \132 ;; m-c-d
26set key \3346 \133 ;; m-c-e
27set key \3361 \134 ;; m-c-f
28set key \3362 \135 ;; m-c-g
29set key \3342 \136 ;; m-bs
30set key \3363 \136 ;; m-c-h (sends same code as above)
31set key \2469 \137 ;; m-tab
32set key \3351 \137 ;; m-c-i (same as above)
33set key \3364 \138 ;; m-c-j
34set key \3365 \139 ;; m-c-k
35set key \3366 \140 ;; m-c-l
36;set key \3378 \141 ;; m-c-m
37set key \2332 \141 ;; m-ret (sends same code as above)
38set key \3377 \142 ;; m-c-n
39set key \3352 \143 ;; m-c-o
40set key \3353 \144 ;; m-c-p
41set key \3344 \145 ;; m-c-q
42set key \3347 \146 ;; m-c-r
43set key \3359 \147 ;; m-c-s
44set key \3348 \148 ;; m-c-t
45set key \3350 \149 ;; m-c-u
46set key \3375 \150 ;; m-c-v
47set key \3345 \151 ;; m-c-w
48set key \3373 \152 ;; m-c-x
49set key \3349 \153 ;; m-c-y
50set key \3372 \154 ;; m-c-z
51
52;; misc keys
53;set key \3354 \155 ;; m-c-[
54set key \2305 \155 ;; m-esc (sends same as above)
55set key \3371 \156 ;; m-c-\
56set key \3355 \157 ;; m-c-]
57set key \3453 \158 ;; m-c-^
58set key \3458 \159 ;; m-c-_
59
60;; \160 is conspicuously missing here--
61;; alt-spc doesn't generate a distinct scan code...
62;; neither do shift-spc and ctrl-spc.
63;; no idea why.
64
65set key \2936 \161 ;; m-!
66set key \2856 \162 ;; m-"
67set key \2938 \163 ;; m-#
68set key \2939 \164 ;; m-$
69set key \2940 \165 ;; m-%
70set key \2942 \166 ;; m-&
71set key \2344 \167 ;; m-'
72set key \2944 \168 ;; m-(
73set key \2945 \169 ;; m-)
74set key \2943 \170 ;; m-*
75set key \2947 \171 ;; m-+
76set key \2355 \172 ;; m-,
77set key \2434 \173 ;; m--
78set key \2356 \174 ;; m-.
79set key \2357 \175 ;; m-/
80
81;; number keys
82set key \2433 \176 ;; m-0
83set key \2424 \177 ;; m-1
84set key \2425 \178
85set key \2426 \179
86set key \2427 \180
87set key \2428 \181
88set key \2429 \182
89set key \2430 \183
90set key \2431 \184
91set key \2432 \185 ;; m-9
92
93set key \2855 \186 ;; m-:
94set key \2343 \187 ;; m-;
95set key \2867 \188 ;; m-<
96set key \2435 \189 ;; m-=
97set key \2868 \190 ;; m->
98set key \2869 \191 ;; m-?
99set key \2937 \192 ;; m-@
100
101;; shifted A-Z
102set key \2846 \193 ;; m-A
103set key \2864 \194
104set key \2862 \195
105set key \2848 \196
106set key \2834 \197
107set key \2849 \198
108set key \2850 \199
109set key \2851 \200
110set key \2839 \201
111set key \2852 \202
112set key \2853 \203
113set key \2854 \204
114set key \2866 \205
115set key \2865 \206
116set key \2840 \207
117set key \2841 \208
118set key \2832 \209
119set key \2835 \210
120set key \2847 \211
121set key \2836 \212
122set key \2838 \213
123set key \2863 \214
124set key \2833 \215
125set key \2861 \216
126set key \2837 \217
127set key \2860 \218 ;; m-Z
128
129set key \2330 \219 ;; m-[
130set key \2347 \220 ;; m-\
131set key \2331 \221 ;; m-]
132set key \2941 \222 ;; m-^
133set key \2946 \223 ;; m-_
134set key \2345 \224 ;; m-`
135
136;; lowercase a-z
137set key \2334 \225 ;; m-a
138set key \2352 \226
139set key \2350 \227
140set key \2336 \228
141set key \2322 \229
142set key \2337 \230
143set key \2338 \231
144set key \2339 \232
145set key \2327 \233
146set key \2340 \234
147set key \2341 \235
148set key \2342 \236
149set key \2354 \237
150set key \2353 \238
151set key \2328 \239
152set key \2329 \240
153set key \2320 \241
154set key \2323 \242
155set key \2335 \243
156set key \2324 \244
157set key \2326 \245
158set key \2351 \246
159set key \2321 \247
160set key \2349 \248
161set key \2325 \249
162set key \2348 \250 ;; m-z
163
164;; more shifted misc. keys
165set key \2842 \251 ;; m-{
166set key \2859 \252 ;; m-|
167set key \2843 \253 ;; m-}
168set key \2857 \254 ;; m-~
169set key \2318 \255 ;; m-del
170
171
172;;; arch-tag: 93cefb0a-2b07-4d09-ae78-4d807b15645d
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bfe3534eeb7..48b5581d8a9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,663 @@
12010-09-15 Michael Albinus <michael.albinus@gmx.de>
2
3 * net/tramp-compat.el (tramp-compat-with-temp-message)
4 (tramp-compat-font-lock-add-keywords, tramp-compat-process-get)
5 (tramp-compat-process-put): New defuns.
6
7 * net/tramp.el (top):
8 * net/tramp-gvfs.el (top):
9 * net/tramp-cache.el (top): Use `tramp-compat-font-lock-add-keywords'.
10
11 * net/tramp.el (tramp-progress-reporter-update): Use
12 `tramp-compat-funcall.
13
14 * net/tramp.el (tramp-process-actions):
15 * net/tramp-gvfs.el (tramp-handle-vc-registered):
16 * net/tramp-sh.el (tramp-gvfs-handler-askquestion)
17 (tramp-get-remote-stat, tramp-get-remote-readlink): Use
18 `tramp-compat-with-temp-message'.
19
20 * net/tramp-sh.el (top): Require 'cl.
21 (tramp-handle-start-file-process): Use `tramp-compat-process-get'.
22 (tramp-open-connection-setup-interactive-shell): Use
23 `tramp-compat-process-put'.
24
252010-09-15 Alan Mackenzie <acm@muc.de>
26
27 * progmodes/cc-engine.el (c-forward-<>-arglist-recur): Correct the
28 indentation.
29 (c-forward-<>-arglist-recur): Fix an infinite recursion.
30
312010-09-15 Stefan Monnier <monnier@iro.umontreal.ca>
32
33 * emacs-lisp/bytecomp.el (byte-compile-warning-types): New type
34 `lexical' for warnings related to lexical scoping.
35 (byte-compile-file-form-defvar, byte-compile-defvar): Warn about
36 global vars which don't have a prefix and could hence affect lexical
37 scoping in unrelated files.
38
392010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
40
41 * net/imap.el: Revert back to version
42 cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
43 seem problematic.
44
452010-09-14 Juanma Barranquero <lekktu@gmail.com>
46
47 * obsolete/old-whitespace.el (whitespace-unload-function):
48 Explicitly pass `obarray' to `unintern' to avoid a warning.
49
502010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
51
52 * emacs-lisp/byte-run.el (set-advertised-calling-convention):
53 Add `when' argument. Update callers.
54
55 * subr.el (unintern): Declare the obarray arg mandatory.
56
572010-09-14 Glenn Morris <rgm@gnu.org>
58
59 * calendar/diary-lib.el (diary-list-entries-hook, diary-sort-entries):
60 Doc fixes.
61
62 * calendar/diary-lib.el (diary-included-files): New variable.
63 (diary-list-entries): Maybe initialize diary-included-files.
64 (diary-include-other-diary-files): Append to diary-included-files.
65 * calendar/appt.el (appt-update-list): Also check the members of
66 diary-included-files. (Bug#6999)
67 (appt-check): Doc fix.
68
692010-09-14 David Reitter <david.reitter@gmail.com>
70
71 * simple.el (line-move-visual): Do not truncate goal column to
72 integer size. (Bug#7020)
73
742010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
75
76 * repeat.el (repeat): Allow repeating when the last event is a click.
77 Suggested by Drew Adams (bug#6256).
78
792010-09-14 Sascha Wilde <wilde@sha-bang.de>
80
81 * vc/vc-hg.el (vc-hg-state,vc-hg-working-revision):
82 Replace setting HGRCPATH to "" by some less invasive --config options.
83
842010-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
85
86 * font-lock.el (font-lock-beginning-of-syntax-function):
87 Mark as obsolete.
88
892010-09-14 Glenn Morris <rgm@gnu.org>
90
91 * menu-bar.el (menu-bar-options-save): Fix handling of menu-bar
92 and tool-bar modes. (Bug#6211)
93 (menu-bar-mode): Move setting of standard-value after the
94 minor-mode definition, otherwise it seems to have no effect.
95
962010-09-14 Masatake YAMATO <yamato@redhat.com>
97
98 * progmodes/antlr-mode.el (antlr-font-lock-additional-keywords):
99 Fix typo. (Bug#6976)
100
1012010-09-14 Vinicius Jose Latorre <viniciusjl@ig.com.br>
102
103 * whitespace.el: Allow cleaning up blanks without blank
104 visualization (Bug#6651). Adjust help window for
105 whitespace-toggle-options (Bug#6479). Allow to use fill-column
106 instead of whitespace-line-column (from EmacsWiki). New version 13.1.
107 (whitespace-style): Add new value 'face. Adjust docstring.
108 (whitespace-space, whitespace-hspace, whitespace-tab):
109 Adjust foreground property face.
110 (whitespace-line-column): Adjust docstring and type declaration.
111 (whitespace-style-value-list, whitespace-toggle-option-alist)
112 (whitespace-help-text): Adjust const initialization.
113 (whitespace-toggle-options, global-whitespace-toggle-options):
114 Adjust docstring.
115 (whitespace-display-window, whitespace-interactive-char)
116 (whitespace-style-face-p, whitespace-color-on): Adjust code.
117 (whitespace-help-scroll): New fun.
118
1192010-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
120
121 * calendar/time-date.el (format-seconds): Comment fix.
122
1232010-09-13 Michael R. Mauger <mmaug@yahoo.com>
124
125 * progmodes/sql.el: Version 2.7.
126 (sql-buffer-live-p): Improve detection.
127 (sql-find-sqli-buffer, sql-set-sqli-buffer-generally)
128 (sql-set-sqli-buffer): Use it.
129 (sql-product-interactive): Run `sql-set-sqli-hook'.
130 (sql-rename-buffer): Code cleanup.
131 (sql-redirect, sql-redirect-value): New functions. More to come.
132
1332010-09-13 Juanma Barranquero <lekktu@gmail.com>
134
135 Port tramp-related Makefile changes of 2010-09-08T14:42:54Z!michael.albinus@gmx.de, 2010-09-13T15:17:01Z!michael.albinus@gmx.de to Windows.
136 * makefile.w32-in (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el.
137 (TRAMP_SRC): New macro.
138 ($(lisp)/net/tramp-loaddefs.el): New target.
139
1402010-09-13 Michael Albinus <michael.albinus@gmx.de>
141
142 Major code cleanup. Split tramp.el into tramp.el and tramp-sh.el.
143
144 * Makefile.in (TRAMP_SRC): Remove tramp-fish.el. Add tramp-sh.el.
145
146 * net/tramp.el (top): Don't show loading message. Require just
147 'tramp-compat, everything else is required there.
148 Use `ignore-errors' where appropriate.
149 (tramp-inline-compress-start-size, tramp-copy-size-limit)
150 (tramp-terminal-type, tramp-end-of-output)
151 (tramp-initial-end-of-output, tramp-completion-function-alist-rsh)
152 (tramp-completion-function-alist-ssh)
153 (tramp-completion-function-alist-telnet)
154 (tramp-completion-function-alist-su)
155 (tramp-completion-function-alist-putty, tramp-remote-path)
156 (tramp-remote-process-environment, tramp-sh-extra-args)
157 (tramp-actions-before-shell, tramp-uudecode)
158 (tramp-perl-file-truename, tramp-perl-file-name-all-completions)
159 (tramp-perl-file-attributes)
160 (tramp-perl-directory-files-and-attributes)
161 (tramp-perl-encode-with-module, tramp-perl-decode-with-module)
162 (tramp-perl-encode, tramp-perl-decode)
163 (tramp-vc-registered-read-file-names, tramp-file-mode-type-map)
164 (tramp-file-name-handler-alist, tramp-make-tramp-temp-file)
165 (tramp-handle-make-symbolic-link, tramp-handle-load)
166 (tramp-handle-file-name-as-directory)
167 (tramp-handle-file-name-directory)
168 (tramp-handle-file-name-nondirectory, tramp-handle-file-truename)
169 (tramp-handle-file-exists-p, tramp-handle-file-attributes)
170 (tramp-do-file-attributes-with-ls)
171 (tramp-do-file-attributes-with-perl)
172 (tramp-do-file-attributes-with-stat)
173 (tramp-handle-set-visited-file-modtime)
174 (tramp-handle-verify-visited-file-modtime)
175 (tramp-handle-set-file-modes, tramp-handle-set-file-times)
176 (tramp-set-file-uid-gid, tramp-remote-selinux-p)
177 (tramp-handle-file-selinux-context)
178 (tramp-handle-set-file-selinux-context)
179 (tramp-handle-file-executable-p, tramp-handle-file-readable-p)
180 (tramp-handle-file-newer-than-file-p, tramp-handle-file-modes)
181 (tramp-handle-file-directory-p, tramp-handle-file-regular-p)
182 (tramp-handle-file-symlink-p, tramp-handle-file-writable-p)
183 (tramp-handle-file-ownership-preserved-p)
184 (tramp-handle-directory-file-name, tramp-handle-directory-files)
185 (tramp-handle-directory-files-and-attributes)
186 (tramp-do-directory-files-and-attributes-with-perl)
187 (tramp-do-directory-files-and-attributes-with-stat)
188 (tramp-handle-file-name-all-completions)
189 (tramp-handle-file-name-completion, tramp-handle-add-name-to-file)
190 (tramp-handle-copy-file, tramp-handle-copy-directory)
191 (tramp-handle-rename-file, tramp-do-copy-or-rename-file)
192 (tramp-do-copy-or-rename-file-via-buffer)
193 (tramp-do-copy-or-rename-file-directly)
194 (tramp-do-copy-or-rename-file-out-of-band)
195 (tramp-handle-make-directory, tramp-handle-delete-directory)
196 (tramp-handle-delete-file)
197 (tramp-handle-dired-recursive-delete-directory)
198 (tramp-handle-dired-compress-file, tramp-handle-dired-uncache)
199 (tramp-handle-insert-directory)
200 (tramp-handle-unhandled-file-name-directory)
201 (tramp-handle-expand-file-name)
202 (tramp-handle-substitute-in-file-name)
203 (tramp-handle-executable-find, tramp-process-sentinel)
204 (tramp-handle-start-file-process, tramp-handle-process-file)
205 (tramp-handle-call-process-region, tramp-handle-shell-command)
206 (tramp-handle-file-local-copy, tramp-handle-file-remote-p)
207 (tramp-handle-insert-file-contents)
208 (tramp-handle-insert-file-contents-literally)
209 (tramp-handle-find-backup-file-name)
210 (tramp-handle-make-auto-save-file-name, tramp-handle-write-region)
211 (tramp-vc-registered-file-names, tramp-handle-vc-registered)
212 (tramp-sh-file-name-handler, tramp-vc-file-name-handler)
213 (tramp-maybe-send-script, tramp-set-auto-save, tramp-run-test)
214 (tramp-run-test2, tramp-find-executable, tramp-set-remote-path)
215 (tramp-find-file-exists-command, tramp-open-shell)
216 (tramp-find-shell, tramp-barf-if-no-shell-prompt)
217 (tramp-open-connection-setup-interactive-shell)
218 (tramp-local-coding-commands, tramp-remote-coding-commands)
219 (tramp-find-inline-encoding, tramp-call-local-coding-command)
220 (tramp-inline-compress-commands, tramp-find-inline-compress)
221 (tramp-compute-multi-hops, tramp-maybe-open-connection)
222 (tramp-send-command , tramp-wait-for-output)
223 (tramp-send-command-and-check, tramp-barf-unless-okay)
224 (tramp-send-command-and-read, tramp-mode-string-to-int)
225 (tramp-convert-file-attributes, tramp-check-cached-permissions)
226 (tramp-file-mode-from-int, tramp-file-mode-permissions)
227 (tramp-shell-case-fold, tramp-make-copy-program-file-name)
228 (tramp-method-out-of-band-p, tramp-local-host-p)
229 (tramp-get-remote-path, tramp-get-remote-tmpdir)
230 (tramp-get-ls-command, tramp-get-ls-command-with-dired)
231 (tramp-get-test-command, tramp-get-test-nt-command)
232 (tramp-get-file-exists-command, tramp-get-remote-ln)
233 (tramp-get-remote-perl, tramp-get-remote-stat)
234 (tramp-get-remote-readlink, tramp-get-remote-trash)
235 (tramp-get-remote-id, tramp-get-remote-uid, tramp-get-remote-gid)
236 (tramp-get-local-uid, tramp-get-local-gid)
237 (tramp-get-inline-compress, tramp-get-inline-coding): Move to
238 tramp-sh.el.
239 (tramp-methods, tramp-default-method-alist)
240 (tramp-default-user-alist, tramp-foreign-file-name-handler-alist):
241 Move initialization to tramp-sh.el.
242 (tramp-temp-name-prefix): Make it a defconst.
243 (tramp-dissect-file-name): Don't check anymore for multi-hop
244 methods.
245 (tramp-debug-outline-regexp): Add a docstring.
246 (tramp-debug-outline-level): Renamed from `tramp-outline-level'.
247 (tramp-get-debug-buffer): Use it.
248
249 * net/tramp-cache.el (top): Set tramp-autoload cookie for
250 initialization forms.
251 (tramp-set-connection-property): Don't protect `tramp-message'
252 call, it isn't necessary any longer.
253 (tramp-dump-connection-properties): Use `ignore-errors'.
254
255 * net/tramp-compat.el (top): Require 'advice, 'format-spec,
256 'password-cache and 'auth-source.
257
258 * net/tramp-gvfs.el (top):
259 * net/tramp-smb.el (top): Require 'tramp-sh.
260
261 * net/tramp-gw.el (tramp-gw-open-network-stream): Use `ignore-errors'.
262
263 * net/tramp-sh.el: New file, derived from tramp.el.
264 (top): Initialize `tramp-methods', `tramp-default-method-alist',
265 `tramp-default-user-alist', `tramp-foreign-file-name-handler-alist'.
266 Remove "scp1_old", "scp2_old", "ssh1_old", "ssh2_old". Use
267 `ignore-errors' where appropriate.
268 (tramp-sh-file-name-handler-alist): Renamed from
269 `tramp-file-name-handler-alist'.
270 (tramp-send-command-and-check): Return t or nil. Remove all
271 `zerop' checks, where called.
272 (tramp-handle-set-file-modes)
273 (tramp-do-copy-or-rename-file-directly)
274 (tramp-handle-delete-directory, tramp-handle-delete-file)
275 (tramp-maybe-send-script, ): Use `tramp-barf-unless-okay'.
276 (tramp-sh-file-name-handler, tramp-send-command-and-check)
277 (tramp-get-remote-ln): Set tramp-autoload cookie.
278
279 * net/tramp-fish.el: Remove file.
280
2812010-09-13 Daiki Ueno <ueno@unixuser.org>
282
283 * epa-file.el (epa-file-insert-file-contents): If visiting, bind
284 buffer-file-name to avoid file-locking. (Bug#7026)
285
2862010-09-13 Julien Danjou <julien@danjou.info>
287
288 * notifications.el (notifications-notify): Add support for
289 image-path and sound-name.
290 (notifications-specification-version): Add this variable.
291
2922010-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
293
294 * subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key.
295
2962010-09-12 Leo <sdl.web@gmail.com>
297
298 * net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
299 (rcirc-completion-start): New variables.
300 (rcirc-nick-completions): Rename to rcirc-completions.
301 (rcirc-nick-completion-start-offset): Delete.
302 (rcirc-completion-at-point): New function for constructing
303 completion data for both nicks and irc commands. Add to
304 completion-at-point-functions in rcirc mode.
305 (rcirc-complete): Rename from rcirc-nick-complete; use
306 rcirc-completion-at-point.
307 (defun-rcirc-command): Update rcirc-client-commands.
308
3092010-09-11 Glenn Morris <rgm@gnu.org>
310
311 * emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files
312 atomically, to avoid parallel build errors. (Bug#4196)
313
3142010-09-11 Michael R. Mauger <mmaug@yahoo.com>
315
316 * progmodes/sql.el: Version 2.6
317 (sql-dialect): Synonym for "sql-product".
318 (sql-find-sqli-buffer, sql-set-sqli-buffer-generally)
319 (sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode):
320 Set "sql-buffer" to buffer name not buffer object so multiple sql
321 interactive buffers work properly. Reverts misguided changes in
322 earlier work.
323 (sql-comint): Make sure different buffer name is used if "*SQL*"
324 buffer is for a different product.
325 (sql-make-alternate-buffer-name): Fix bug with "sql-database"
326 login param.
327 (sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql)
328 (sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase)
329 (sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer):
330 Accept new buffer name or prompt for one.
331 (sql-port): Default to zero.
332 (sql-comint-mysql): Handle "sql-port" as a numeric.
333 (sql-port-history): Delete unused variable.
334 (sql-get-login): Default "sql-port" to a number.
335 (sql-product-alist): Correct Postgres prompt and terminator
336 regexp.
337 (sql-sqlite-program): Dynamically detect presence of "sqlite" or
338 "sqlite3" executables.
339 (sql-sqlite-login-params): Add "*.sqlite[23]?" database name
340 pattern.
341 (sql-buffer-live-p): New function.
342 (sql-mode-menu, sql-send-string): Use it.
343 (sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK
344 syntax pattern.
345 (sql-mode-postgres-font-lock-keywords): Support Postgres V9.
346 (sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands.
347
3482010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
349
350 * net/netrc.el (netrc-credentials): New conveniency function.
351
3522010-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
353
354 * textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun
355 to replace texinfo-font-lock-syntactic-keywords.
356 (texinfo-mode): Use it.
357
358 * textmodes/tex-mode.el (tex-common-initialization, doctex-mode):
359 Use syntax-propertize-function.
360
361 * textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to
362 replace sgml-font-lock-syntactic-keywords.
363 (sgml-mode): Use it.
364
365 * textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare
366 since we don't use it.
367
368 * textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function.
369
370 * progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function
371 if available.
372 (vhdl-fontify-buffer): Adjust.
373
374 * progmodes/tcl.el (tcl-syntax-propertize-function): New var to
375 replace tcl-font-lock-syntactic-keywords.
376 (tcl-mode): Use it.
377
378 * progmodes/simula.el (simula-syntax-propertize-function): New var to
379 replace simula-font-lock-syntactic-keywords.
380 (simula-mode): Use it.
381
382 * progmodes/sh-script.el (sh-st-symbol): Remove.
383 (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg.
384 (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove.
385 (sh-font-lock-quoted-subshell): Assume we've already matched $(.
386 (sh-font-lock-paren): Set syntax-multiline.
387 (sh-font-lock-syntactic-keywords): Remove.
388 (sh-syntax-propertize-function): New function to replace it.
389 (sh-mode): Use it.
390
391 * progmodes/ruby-mode.el (ruby-here-doc-beg-re):
392 Define while compiling.
393 (ruby-here-doc-end-re, ruby-here-doc-beg-match)
394 (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax)
395 (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p)
396 (ruby-here-doc-find-end, ruby-here-doc-beg-syntax)
397 (ruby-here-doc-end-syntax): Only define when
398 syntax-propertize is not available.
399 (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc):
400 New functions.
401 (ruby-in-ppss-context-p): Update to new syntax of heredocs.
402 (electric-indent-chars): Silence bytecompiler.
403 (ruby-mode): Use prog-mode, syntax-propertize-function, and
404 electric-indent-chars.
405
406 * progmodes/python.el (python-syntax-propertize-function): New var to
407 replace python-font-lock-syntactic-keywords.
408 (python-mode): Use it.
409 (python-quote-syntax): Simplify and adjust to new use.
410
411 * progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to
412 replace perl-font-lock-syntactic-keywords.
413 (perl-syntax-propertize-special-constructs): New fun to replace
414 perl-font-lock-special-syntactic-constructs.
415 (perl-font-lock-syntactic-face-function): New fun.
416 (perl-mode): Use it.
417
418 * progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function
419 to replace octave-font-lock-close-quotes.
420 (octave-syntax-propertize-function): New function to replace
421 octave-font-lock-syntactic-keywords.
422 (octave-mode): Use it.
423
424 * progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var;
425 replaces mixal-font-lock-syntactic-keywords.
426 (mixal-mode): Use it.
427
428 * progmodes/make-mode.el (makefile-syntax-propertize-function):
429 New var; replaces makefile-font-lock-syntactic-keywords.
430 (makefile-mode): Use it.
431 (makefile-imake-mode): Adjust.
432
433 * progmodes/js.el (js--regexp-literal): Define while compiling.
434 (js-syntax-propertize-function): New var; replaces
435 js-font-lock-syntactic-keywords.
436 (js-mode): Use it.
437
438 * progmodes/gud.el (gdb-script-syntax-propertize-function): New var;
439 replaces gdb-script-font-lock-syntactic-keywords.
440 (gdb-script-mode): Use it.
441
442 * progmodes/fortran.el (fortran-mode): Use syntax-propertize-function.
443 (fortran--font-lock-syntactic-keywords): New var.
444 (fortran-line-length): Update syntax-propertize-function and
445 fortran--font-lock-syntactic-keywords.
446
447 * progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function.
448
449 * progmodes/cfengine.el (cfengine-mode):
450 Use syntax-propertize-function.
451 (cfengine-font-lock-syntactic-keywords): Remove.
452
453 * progmodes/autoconf.el (autoconf-mode):
454 Use syntax-propertize-function.
455 (autoconf-font-lock-syntactic-keywords): Remove.
456
457 * progmodes/ada-mode.el (ada-set-syntax-table-properties)
458 (ada-after-change-function, ada-initialize-syntax-table-properties)
459 (ada-handle-syntax-table-properties): Only define when
460 syntax-propertize is not available.
461 (ada-mode): Use syntax-propertize-function.
462
463 * font-lock.el (font-lock-syntactic-keywords): Make obsolete.
464 (font-lock-fontify-syntactic-keywords-region): Move handling of
465 font-lock-syntactically-fontified to...
466 (font-lock-default-fontify-region): ...here.
467 Let syntax-propertize-function take precedence.
468 (font-lock-fontify-syntactically-region): Cal syntax-propertize.
469
470 * emacs-lisp/syntax.el (syntax-propertize-function)
471 (syntax-propertize-chunk-size, syntax-propertize--done)
472 (syntax-propertize-extend-region-functions): New vars.
473 (syntax-propertize-wholelines, syntax-propertize-multiline)
474 (syntax-propertize--shift-groups, syntax-propertize-via-font-lock)
475 (syntax-propertize): New functions.
476 (syntax-propertize-rules): New macro.
477 (syntax-ppss-flush-cache): Set syntax-propertize--done.
478 (syntax-ppss): Call syntax-propertize.
479
480 * emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups.
481
4822010-09-10 Agustín Martín <agustin.martin@hispalinux.es>
483
484 * textmodes/ispell.el (ispell-init-process): Improve comments.
485 XEmacs compatibility changes regarding (add-hook) 'local option
486 and (set-process-query-on-exit-flag).
487
4882010-09-09 Michael Albinus <michael.albinus@gmx.de>
489
490 * net/tramp-cache.el (tramp-parse-connection-properties):
491 Set tramp-autoload cookie.
492
4932010-09-09 Glenn Morris <rgm@gnu.org>
494
495 * image.el (imagemagick-types-inhibit): Add :type, :version, :group.
496 (imagemagick-register-types): Doc fix.
497
4982010-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
499
500 * progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp.
501
502 * progmodes/js.el (require): Require is already "eval-and-compile".
503 (js--re-search-forward): Avoid `eval'. Preserve the error data.
504 (js--re-search-backward): Use js--re-search-forward.
505
506 * progmodes/fortran.el (fortran-line-length): Don't recompute
507 syntactic keywords redundantly a second time.
508
509 * progmodes/ada-mode.el: Replace "(set '" with setq.
510 (ada-mode): Simplify.
511 (ada-create-case-exception, ada-adjust-case-interactive)
512 (ada-adjust-case-region, ada-format-paramlist, ada-indent-current)
513 (ada-search-ignore-string-comment, ada-move-to-start)
514 (ada-move-to-end): Use with-syntax-table.
515
516 * font-lock.el (save-buffer-state): Remove `varlist' arg.
517 (font-lock-unfontify-region, font-lock-default-fontify-region):
518 Update usage correspondingly.
519 (font-lock-fontify-syntactic-keywords-region):
520 Set parse-sexp-lookup-properties buffer-locally here.
521 (font-lock-fontify-syntactically-region): Remove unused `ppss' arg.
522
523 * simple.el (blink-matching-open): Don't burp if we can't find a match.
524
5252010-09-08 Glenn Morris <rgm@gnu.org>
526
527 * emacs-lisp/bytecomp.el (byte-compile-report-ops):
528 Error if not compiled with -DBYTE_CODE_METER.
529
530 * emacs-lisp/bytecomp.el (byte-recompile-directory):
531 Ignore dir-locals-file.
532
5332010-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
534
535 * progmodes/compile.el (compilation-error-regexp-alist-alist):
536 Not a const.
537 (compilation-error-regexp-alist-alist): Rule out ": " in file names
538 for the `gnu' messages.
539 (compilation-set-skip-threshold): New command.
540 (compilation-start): Use \' rather than $.
541 (compilation-forget-errors): Use clrhash.
542
5432010-09-08 Agustín Martín <agustin.martin@hispalinux.es>
544
545 * textmodes/ispell.el (ispell-valid-dictionary-list):
546 Simplify logic.
547
5482010-09-08 Michael Albinus <michael.albinus@gmx.de>
549
550 Migrate to Tramp 2.2. Rearrange load dependencies.
551 (Bug#1529, Bug#5448, Bug#5705)
552
553 * Makefile.in (TRAMP_DIR, TRAMP_SRC): New variables.
554 ($(TRAMP_DIR)/tramp-loaddefs.el): New target.
555 (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el.
556
557 * net/tramp.el (top): Remove all other tramp-* loads except
558 tramp-compat.el. Remove all changes to tramp-unload-hook for
559 other tramp-* packages. Rearrange defun order. Change calls of
560 `tramp-compat-call-process', `tramp-compat-decimal-to-octal',
561 `tramp-compat-octal-to-decimal' to new function names.
562 (tramp-terminal-type, tramp-initial-end-of-output)
563 (tramp-methods, tramp-foreign-file-name-handler-alist)
564 (tramp-tramp-file-p, tramp-completion-mode-p)
565 (tramp-send-command-and-check, tramp-get-remote-path)
566 (tramp-get-remote-tmpdir, tramp-get-remote-ln)
567 (tramp-shell-quote-argument): Set tramp-autoload cookie.
568 (with-file-property, with-connection-property): Move to
569 tramp-cache.el.
570 (tramp-local-call-process, tramp-decimal-to-octal)
571 (tramp-octal-to-decimal): Move to tramp-compat.el.
572 (tramp-handle-shell-command): Do not require 'shell.
573 (tramp-compute-multi-hops): No special handling for tramp-gw-*
574 symbols.
575 (tramp-unload-tramp): Do not call `tramp-unload-file-name-handlers'.
576
577 * net/tramp-cache.el (top): Require 'tramp. Add to
578 `tramp-unload-hook'.
579 (tramp-cache-data, tramp-get-file-property)
580 (tramp-set-file-property, tramp-flush-file-property)
581 (tramp-flush-directory-property, tramp-get-connection-property)
582 (tramp-set-connection-property, tramp-flush-connection-property)
583 (tramp-cache-print, tramp-list-connections): Set tramp-autoload
584 cookie.
585 (with-file-property, with-connection-property): New defuns, moved
586 from tramp.el.
587 (tramp-flush-file-function): Use `with-parsed-tramp-file-name'
588 macro.
589
590 * net/tramp-cmds.el (top): Add to `tramp-unload-hook'.
591 (tramp-version): Set tramp-autoload cookie.
592
593 * net/tramp-compat.el (top): Require 'tramp-loaddefs. Remove all
594 changes to tramp-unload-hook for other tramp-* packages. Add to
595 `tramp-unload-hook'.
596 (tramp-compat-decimal-to-octal, tramp-compat-octal-to-decimal)
597 (tramp-compat-call-process): New defuns, moved from tramp.el.
598
599 * net/tramp-fish.el (top) Require just 'tramp. Add objects to
600 `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
601 to `tramp-unload-hook'. Change call of
602 `tramp-compat-decimal-to-octal' to new function name.
603 (tramp-fish-method): Make it a defconst.
604 (tramp-fish-file-name-p): Make it a defsubst.
605 (tramp-fish-method, tramp-fish-file-name-handler)
606 (tramp-fish-file-name-p): Set tramp-autoload cookie.
607
608 * net/tramp-ftp.el (top) Add objects to `tramp-methods' and
609 `tramp-foreign-file-name-handler-alist'. Add to
610 `tramp-unload-hook'.
611 (tramp-ftp-method): Make it a defconst.
612 (tramp-ftp-file-name-p): Make it a defsubst.
613 (tramp-ftp-method, tramp-ftp-file-name-handler)
614 (tramp-ftp-file-name-p): Set tramp-autoload cookie.
615
616 * net/tramp-gvfs.el (top) Add objects to `tramp-methods' and
617 `tramp-foreign-file-name-handler-alist'. Add to
618 `tramp-unload-hook'. Change checks, whether package can be
619 loaded.
620 (tramp-gvfs-file-name-p): Make it a defsubst.
621 (tramp-gvfs-methods, tramp-gvfs-file-name-handler)
622 (tramp-gvfs-file-name-p): Set tramp-autoload cookie.
623 (tramp-gvfs-handle-file-directory-p): New defun.
624 (tramp-gvfs-file-name-handler-alist): Use it.
625
626 * net/tramp-gw.el (top) Add objects to `tramp-methods' and
627 `tramp-foreign-file-name-handler-alist'. Add to
628 `tramp-unload-hook'.
629 (tramp-gw-tunnel-method, tramp-gw-default-tunnel-port)
630 (tramp-gw-socks-method, tramp-gw-default-socks-port): Make it a
631 defconst.
632 (tramp-gw-tunnel-method, tramp-gw-socks-method)
633 (tramp-gw-open-connection): Set tramp-autoload cookie.
634
635 * net/tramp-imap.el (top) Require just 'tramp. Add objects to
636 `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
637 to `tramp-unload-hook'. Change checks, whether package can be
638 loaded.
639 (tramp-imap-file-name-p): Make it a defsubst.
640 (tramp-imap-method, tramp-imaps-method)
641 (tramp-imap-file-name-handler)
642 (tramp-imap-file-name-p): Set tramp-autoload cookie.
643
644 * net/tramp-smb.el (top) Require just 'tramp. Add objects to
645 `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
646 to `tramp-unload-hook'. Change checks, whether package can be
647 loaded. Change call of `tramp-compat-decimal-to-octal' to new
648 function name.
649 (tramp-smb-tunnel-method): Make it a defconst.
650 (tramp-smb-file-name-p): Make it a defsubst.
651 (tramp-smb-method, tramp-smb-file-name-handler)
652 (tramp-smb-file-name-p): Set tramp-autoload cookie.
653
654 * net/tramp-uu.el (top) Add to `tramp-unload-hook'.
655 (tramp-uuencode-region): Set tramp-autoload cookie.
656
657 * net/trampver.el (top) Add to `tramp-unload-hook'.
658 (tramp-version, tramp-bug-report-address): Set tramp-autoload
659 cookie. Update release number.
660
12010-09-07 Agustín Martín <agustin.martin@hispalinux.es> 6612010-09-07 Agustín Martín <agustin.martin@hispalinux.es>
2 662
3 * textmodes/ispell.el (ispell-start-process): Make sure original 663 * textmodes/ispell.el (ispell-start-process): Make sure original
@@ -22,7 +682,7 @@
22 682
232010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> 6832010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
24 684
25 * net/imap.el (imap-message-map): Removed optional buffer parameter, 685 * net/imap.el (imap-message-map): Remove optional buffer parameter,
26 since no callers use it. 686 since no callers use it.
27 (imap-message-get): Ditto. 687 (imap-message-get): Ditto.
28 (imap-message-put): Ditto. 688 (imap-message-put): Ditto.
@@ -33,11 +693,11 @@
33 693
342010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> 6942010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
35 695
36 * net/imap.el (imap-fetch-safe): Removed function, and altered all 696 * net/imap.el (imap-fetch-safe): Remove function, and alter all
37 callers to use `imap-fetch' instead. According to the comments, this 697 callers to use `imap-fetch' instead. According to the comments, this
38 should be safe, since all other IMAP clients use the 1:* syntax. 698 should be safe, since all other IMAP clients use the 1:* syntax.
39 (imap-enable-exchange-bug-workaround): Removed. 699 (imap-enable-exchange-bug-workaround): Remove.
40 (imap-debug): Removed -- doesn't seem very useful. 700 (imap-debug): Remove -- doesn't seem very useful.
41 701
422010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> 7022010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
43 703
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 8d681b4f673..1e2a7c4d48b 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -56,7 +56,8 @@ ETAGS = ../lib-src/etags
56LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ 56LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
57 $(lisp)/calendar/diary-loaddefs.el \ 57 $(lisp)/calendar/diary-loaddefs.el \
58 $(lisp)/calendar/hol-loaddefs.el \ 58 $(lisp)/calendar/hol-loaddefs.el \
59 $(lisp)/mh-e/mh-loaddefs.el 59 $(lisp)/mh-e/mh-loaddefs.el \
60 $(lisp)/net/tramp-loaddefs.el
60 61
61# Elisp files auto-generated. 62# Elisp files auto-generated.
62AUTOGENEL = loaddefs.el \ 63AUTOGENEL = loaddefs.el \
@@ -329,6 +330,24 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
329 --eval "(setq make-backup-files nil)" \ 330 --eval "(setq make-backup-files nil)" \
330 -f batch-update-autoloads $(MH_E_DIR) 331 -f batch-update-autoloads $(MH_E_DIR)
331 332
333# Update TRAMP internal autoloads. Maybe we could move trmp*.el into
334# an own subdirectory. OTOH, it does not hurt to keep them in
335# lisp/net.
336TRAMP_DIR = $(lisp)/net
337TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
338 $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
339 $(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \
340 $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \
341 $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
342 $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
343
344$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
345 $(emacs) -l autoload \
346 --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
347 --eval "(setq generated-autoload-file \"$@\")" \
348 --eval "(setq make-backup-files nil)" \
349 -f batch-update-autoloads $(TRAMP_DIR)
350
332CAL_DIR = $(lisp)/calendar 351CAL_DIR = $(lisp)/calendar
333## Those files that may contain internal calendar autoload cookies. 352## Those files that may contain internal calendar autoload cookies.
334## Avoids circular dependency warning for *-loaddefs.el. 353## Avoids circular dependency warning for *-loaddefs.el.
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 00162c99219..6bc95fa8d94 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -244,9 +244,9 @@ A possible way to install this would be:
244 (when (boundp 'font-lock-syntactic-keywords) 244 (when (boundp 'font-lock-syntactic-keywords)
245 (remove-text-properties beg end '(syntax-table nil))) 245 (remove-text-properties beg end '(syntax-table nil)))
246 ;; instead of just using (remove-text-properties beg end '(face 246 ;; instead of just using (remove-text-properties beg end '(face
247 ;; nil)), we find regions with a non-nil face test-property, skip 247 ;; nil)), we find regions with a non-nil face text-property, skip
248 ;; positions with the ansi-color property set, and remove the 248 ;; positions with the ansi-color property set, and remove the
249 ;; remaining face test-properties. 249 ;; remaining face text-properties.
250 (while (setq beg (text-property-not-all beg end 'face nil)) 250 (while (setq beg (text-property-not-all beg end 'face nil))
251 (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) 251 (setq beg (or (text-property-not-all beg end 'ansi-color t) end))
252 (when (get-text-property beg 'face) 252 (when (get-text-property beg 'face)
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index ad36531bb40..ea419aee52d 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -48,8 +48,9 @@
48;; package is activated. Additionally, the appointments list is 48;; package is activated. Additionally, the appointments list is
49;; recreated automatically at 12:01am for those who do not logout 49;; recreated automatically at 12:01am for those who do not logout
50;; every day or are programming late. It is also updated when the 50;; every day or are programming late. It is also updated when the
51;; `diary-file' is saved. Calling `appt-check' with an argument (or 51;; `diary-file' (or a file it includes) is saved. Calling
52;; re-enabling the package) forces a re-initialization at any time. 52;; `appt-check' with an argument (or re-enabling the package) forces a
53;; re-initialization at any time.
53;; 54;;
54;; In order to add or delete items from today's list, without 55;; In order to add or delete items from today's list, without
55;; changing the diary file, use `appt-add' and `appt-delete'. 56;; changing the diary file, use `appt-add' and `appt-delete'.
@@ -262,7 +263,7 @@ The variable `appt-audible' controls the audible reminder."
262 "Check for an appointment and update any reminder display. 263 "Check for an appointment and update any reminder display.
263If optional argument FORCE is non-nil, reparse the diary file for 264If optional argument FORCE is non-nil, reparse the diary file for
264appointments. Otherwise the diary file is only parsed once per day, 265appointments. Otherwise the diary file is only parsed once per day,
265and when saved. 266or when it (or a file it includes) is saved.
266 267
267Note: the time must be the first thing in the line in the diary 268Note: the time must be the first thing in the line in the diary
268for a warning to be issued. The format of the time can be either 269for a warning to be issued. The format of the time can be either
@@ -346,6 +347,8 @@ displayed in a window:
346 (if d-buff ; diary buffer exists 347 (if d-buff ; diary buffer exists
347 (with-current-buffer d-buff 348 (with-current-buffer d-buff
348 diary-selective-display)))) 349 diary-selective-display))))
350 ;; FIXME why not using diary-list-entries with
351 ;; non-nil LIST-ONLY?
349 (diary) 352 (diary)
350 ;; If the diary buffer existed before this command, 353 ;; If the diary buffer existed before this command,
351 ;; restore its display state. Otherwise, kill it. 354 ;; restore its display state. Otherwise, kill it.
@@ -643,8 +646,10 @@ hour and minute parts."
643 646
644(defun appt-update-list () 647(defun appt-update-list ()
645 "If the current buffer is visiting the diary, update appointments. 648 "If the current buffer is visiting the diary, update appointments.
646This function is intended for use with `write-file-functions'." 649This function also acts on any file listed in `diary-included-files'.
647 (and (string-equal buffer-file-name (expand-file-name diary-file)) 650It is intended for use with `write-file-functions'."
651 (and (member buffer-file-name (append diary-included-files
652 (list (expand-file-name diary-file))))
648 appt-timer 653 appt-timer
649 (let ((appt-display-diary nil)) 654 (let ((appt-display-diary nil))
650 (appt-check t))) 655 (appt-check t)))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 39354bd31e3..46926050362 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -187,11 +187,12 @@ you will probably also want to add `diary-mark-included-diary-files' to
187 187
188 (setq diary-display-function 'diary-fancy-display) 188 (setq diary-display-function 'diary-fancy-display)
189 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files) 189 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
190 (add-hook 'diary-list-entries-hook 'diary-sort-entries) 190 (add-hook 'diary-list-entries-hook 'diary-sort-entries t)
191 191
192in your `.emacs' file to cause the fancy diary buffer to be displayed with 192in your `.emacs' file to cause the fancy diary buffer to be displayed with
193diary entries from various included files, each day's entries sorted into 193diary entries from various included files, each day's entries sorted into
194lexicographic order." 194lexicographic order. Note how the sort function is placed last,
195so that it can sort the entries included from other files."
195 :type 'hook 196 :type 'hook
196 :options '(diary-include-other-diary-files diary-sort-entries) 197 :options '(diary-include-other-diary-files diary-sort-entries)
197 :group 'diary) 198 :group 'diary)
@@ -699,6 +700,10 @@ of the appropriate type."
699 (1+ (calendar-absolute-from-gregorian gdate)))))) 700 (1+ (calendar-absolute-from-gregorian gdate))))))
700 (goto-char (point-min))) 701 (goto-char (point-min)))
701 702
703(defvar diary-including) ; dynamically bound in diary-include-other-diary-files
704(defvar diary-included-files nil
705 "List of any diary files included in the last call to `diary-list-entries'.")
706
702;; FIXME non-greg and list hooks run same number of times? 707;; FIXME non-greg and list hooks run same number of times?
703(defun diary-list-entries (date number &optional list-only) 708(defun diary-list-entries (date number &optional list-only)
704 "Create and display a buffer containing the relevant lines in `diary-file'. 709 "Create and display a buffer containing the relevant lines in `diary-file'.
@@ -743,6 +748,8 @@ LIST-ONLY is non-nil, in which case it just returns the list."
743 (date-string (calendar-date-string date)) 748 (date-string (calendar-date-string date))
744 (diary-buffer (find-buffer-visiting diary-file)) 749 (diary-buffer (find-buffer-visiting diary-file))
745 diary-entries-list file-glob-attrs) 750 diary-entries-list file-glob-attrs)
751 (or (bound-and-true-p diary-including)
752 (setq diary-included-files nil))
746 (message "Preparing diary...") 753 (message "Preparing diary...")
747 (save-current-buffer 754 (save-current-buffer
748 (if (not diary-buffer) 755 (if (not diary-buffer)
@@ -828,11 +835,15 @@ the variable `diary-include-string'."
828 (let ((diary-file (match-string-no-properties 1)) 835 (let ((diary-file (match-string-no-properties 1))
829 (diary-list-entries-hook 'diary-include-other-diary-files) 836 (diary-list-entries-hook 'diary-include-other-diary-files)
830 (diary-display-function 'ignore) 837 (diary-display-function 'ignore)
838 (diary-including t)
831 diary-hook diary-list-include-blanks) 839 diary-hook diary-list-include-blanks)
832 (if (file-exists-p diary-file) 840 (if (file-exists-p diary-file)
833 (if (file-readable-p diary-file) 841 (if (file-readable-p diary-file)
834 (unwind-protect 842 (unwind-protect
835 (setq diary-entries-list 843 (setq diary-included-files
844 (append diary-included-files
845 (list (expand-file-name diary-file)))
846 diary-entries-list
836 (append diary-entries-list 847 (append diary-entries-list
837 (diary-list-entries original-date number))) 848 (diary-list-entries original-date number)))
838 (with-current-buffer (find-buffer-visiting diary-file) 849 (with-current-buffer (find-buffer-visiting diary-file)
@@ -1574,7 +1585,10 @@ be used instead of a colon (:) to separate the hour and minute parts."
1574 (string-lessp ts1 ts2))))))) 1585 (string-lessp ts1 ts2)))))))
1575 1586
1576(defun diary-sort-entries () 1587(defun diary-sort-entries ()
1577 "Sort the list of diary entries by time of day." 1588 "Sort the list of diary entries by time of day.
1589If you add this function to `diary-list-entries-hook', it should
1590be the last item in the hook, in case earlier items add diary
1591entries, or change the order."
1578 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) 1592 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
1579 1593
1580(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1") 1594(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1")
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index d99d13e431d..bfb85e2cd73 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -317,10 +317,10 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
317 (setq start (match-end 0) 317 (setq start (match-end 0)
318 spec (match-string 1 string)) 318 spec (match-string 1 string))
319 (unless (string-equal spec "%") 319 (unless (string-equal spec "%")
320 ;; `assoc-string' is not available in Emacs 21. So when compiling 320 ;; `assoc-string' is not available in XEmacs or Emacs 21. So when
321 ;; Gnus (`time-date.el' is part of Gnus) with Emacs 21, we get a 321 ;; compiling Gnus (`time-date.el' is part of Gnus) with XEmacs or
322 ;; warning here. But `format-seconds' is not used anywhere in Gnus so 322 ;; Emacs 21, we get a warning here. But `format-seconds' is not
323 ;; it's not a real problem. --rsteib 323 ;; used anywhere in Gnus so it's not a real problem. --rsteib
324 (or (setq match (assoc-string spec units t)) 324 (or (setq match (assoc-string spec units t))
325 (error "Bad format specifier: `%s'" spec)) 325 (error "Bad format specifier: `%s'" spec))
326 (if (assoc-string spec usedunits t) 326 (if (assoc-string spec usedunits t)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 6ce141eb8e6..0388435dbc2 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -108,10 +108,11 @@ The return value of this function is not used."
108 108
109(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key)) 109(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
110 110
111(defun set-advertised-calling-convention (function signature) 111(defun set-advertised-calling-convention (function signature when)
112 "Set the advertised SIGNATURE of FUNCTION. 112 "Set the advertised SIGNATURE of FUNCTION.
113This will allow the byte-compiler to warn the programmer when she uses 113This will allow the byte-compiler to warn the programmer when she uses
114an obsolete calling convention." 114an obsolete calling convention. WHEN specifies since when the calling
115convention was modified."
115 (puthash (indirect-function function) signature 116 (puthash (indirect-function function) signature
116 advertised-signature-table)) 117 advertised-signature-table))
117 118
@@ -132,7 +133,7 @@ was first made obsolete, for example a date or a release number."
132 obsolete-name) 133 obsolete-name)
133(set-advertised-calling-convention 134(set-advertised-calling-convention
134 ;; New code should always provide the `when' argument. 135 ;; New code should always provide the `when' argument.
135 'make-obsolete '(obsolete-name current-name when)) 136 'make-obsolete '(obsolete-name current-name when) "23.1")
136 137
137(defmacro define-obsolete-function-alias (obsolete-name current-name 138(defmacro define-obsolete-function-alias (obsolete-name current-name
138 &optional when docstring) 139 &optional when docstring)
@@ -153,7 +154,7 @@ See the docstrings of `defalias' and `make-obsolete' for more details."
153(set-advertised-calling-convention 154(set-advertised-calling-convention
154 ;; New code should always provide the `when' argument. 155 ;; New code should always provide the `when' argument.
155 'define-obsolete-function-alias 156 'define-obsolete-function-alias
156 '(obsolete-name current-name when &optional docstring)) 157 '(obsolete-name current-name when &optional docstring) "23.1")
157 158
158(defun make-obsolete-variable (obsolete-name current-name &optional when) 159(defun make-obsolete-variable (obsolete-name current-name &optional when)
159 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. 160 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
@@ -175,7 +176,7 @@ was first made obsolete, for example a date or a release number."
175 obsolete-name) 176 obsolete-name)
176(set-advertised-calling-convention 177(set-advertised-calling-convention
177 ;; New code should always provide the `when' argument. 178 ;; New code should always provide the `when' argument.
178 'make-obsolete-variable '(obsolete-name current-name when)) 179 'make-obsolete-variable '(obsolete-name current-name when) "23.1")
179 180
180(defmacro define-obsolete-variable-alias (obsolete-name current-name 181(defmacro define-obsolete-variable-alias (obsolete-name current-name
181 &optional when docstring) 182 &optional when docstring)
@@ -210,7 +211,7 @@ CURRENT-NAME, if it does not already have them:
210(set-advertised-calling-convention 211(set-advertised-calling-convention
211 ;; New code should always provide the `when' argument. 212 ;; New code should always provide the `when' argument.
212 'define-obsolete-variable-alias 213 'define-obsolete-variable-alias
213 '(obsolete-name current-name when &optional docstring)) 214 '(obsolete-name current-name when &optional docstring) "23.1")
214 215
215;; FIXME This is only defined in this file because the variable- and 216;; FIXME This is only defined in this file because the variable- and
216;; function- versions are too. Unlike those two, this one is not used 217;; function- versions are too. Unlike those two, this one is not used
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c42292a2787..cf12847d093 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,7 +1,8 @@
1;;; bytecomp.el --- compilation of Lisp code into byte code 1;;; bytecomp.el --- compilation of Lisp code into byte code
2 2
3;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, 3;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5;; Free Software Foundation, Inc.
5 6
6;; Author: Jamie Zawinski <jwz@lucid.com> 7;; Author: Jamie Zawinski <jwz@lucid.com>
7;; Hallvard Furuseth <hbf@ulrik.uio.no> 8;; Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -264,7 +265,7 @@ If it is 'byte, then only byte-level optimizations will be logged."
264(defconst byte-compile-warning-types 265(defconst byte-compile-warning-types
265 '(redefine callargs free-vars unresolved 266 '(redefine callargs free-vars unresolved
266 obsolete noruntime cl-functions interactive-only 267 obsolete noruntime cl-functions interactive-only
267 make-local mapcar constants suspicious) 268 make-local mapcar constants suspicious lexical)
268 "The list of warning types used when `byte-compile-warnings' is t.") 269 "The list of warning types used when `byte-compile-warnings' is t.")
269(defcustom byte-compile-warnings t 270(defcustom byte-compile-warnings t
270 "List of warnings that the byte-compiler should issue (t for all). 271 "List of warnings that the byte-compiler should issue (t for all).
@@ -1548,6 +1549,9 @@ that already has a `.elc' file."
1548 (if (and (string-match emacs-lisp-file-regexp bytecomp-source) 1549 (if (and (string-match emacs-lisp-file-regexp bytecomp-source)
1549 (file-readable-p bytecomp-source) 1550 (file-readable-p bytecomp-source)
1550 (not (auto-save-file-name-p bytecomp-source)) 1551 (not (auto-save-file-name-p bytecomp-source))
1552 (not (string-equal dir-locals-file
1553 (file-name-nondirectory
1554 bytecomp-source)))
1551 (setq bytecomp-dest 1555 (setq bytecomp-dest
1552 (byte-compile-dest-file bytecomp-source)) 1556 (byte-compile-dest-file bytecomp-source))
1553 (if (file-exists-p bytecomp-dest) 1557 (if (file-exists-p bytecomp-dest)
@@ -1694,17 +1698,25 @@ The value is non-nil if there were no errors, nil if errors."
1694 (insert "\n") ; aaah, unix. 1698 (insert "\n") ; aaah, unix.
1695 (if (file-writable-p target-file) 1699 (if (file-writable-p target-file)
1696 ;; We must disable any code conversion here. 1700 ;; We must disable any code conversion here.
1697 (let ((coding-system-for-write 'no-conversion)) 1701 (let ((coding-system-for-write 'no-conversion)
1702 ;; Write to a tempfile so that if another Emacs
1703 ;; process is trying to load target-file (eg in a
1704 ;; parallel bootstrap), it does not risk getting a
1705 ;; half-finished file. (Bug#4196)
1706 (tempfile (make-temp-name target-file)))
1698 (if (memq system-type '(ms-dos 'windows-nt)) 1707 (if (memq system-type '(ms-dos 'windows-nt))
1699 (setq buffer-file-type t)) 1708 (setq buffer-file-type t))
1700 (when (file-exists-p target-file) 1709 (write-region (point-min) (point-max) tempfile nil 1)
1701 ;; Remove the target before writing it, so that any 1710 ;; This has the intentional side effect that any
1702 ;; hard-links continue to point to the old file (this makes 1711 ;; hard-links to target-file continue to
1703 ;; it possible for installed files to share disk space with 1712 ;; point to the old file (this makes it possible
1704 ;; the build tree, without causing problems when emacs-lisp 1713 ;; for installed files to share disk space with
1705 ;; files in the build tree are recompiled). 1714 ;; the build tree, without causing problems when
1706 (delete-file target-file)) 1715 ;; emacs-lisp files in the build tree are
1707 (write-region (point-min) (point-max) target-file)) 1716 ;; recompiled). Previously this was accomplished by
1717 ;; deleting target-file before writing it.
1718 (rename-file tempfile target-file t)
1719 (message "Wrote %s" target-file))
1708 ;; This is just to give a better error message than write-region 1720 ;; This is just to give a better error message than write-region
1709 (signal 'file-error 1721 (signal 'file-error
1710 (list "Opening output file" 1722 (list "Opening output file"
@@ -2141,6 +2153,11 @@ list that represents a doc string reference.
2141 ;; Since there is no doc string, we can compile this as a normal form, 2153 ;; Since there is no doc string, we can compile this as a normal form,
2142 ;; and not do a file-boundary. 2154 ;; and not do a file-boundary.
2143 (byte-compile-keep-pending form) 2155 (byte-compile-keep-pending form)
2156 (when (and (symbolp (nth 1 form))
2157 (not (string-match "[-*:$]" (symbol-name (nth 1 form))))
2158 (byte-compile-warning-enabled-p 'lexical))
2159 (byte-compile-warn "Global/dynamic var `%s' lacks a prefix"
2160 (nth 1 form)))
2144 (push (nth 1 form) byte-compile-bound-variables) 2161 (push (nth 1 form) byte-compile-bound-variables)
2145 (if (eq (car form) 'defconst) 2162 (if (eq (car form) 'defconst)
2146 (push (nth 1 form) byte-compile-const-variables)) 2163 (push (nth 1 form) byte-compile-const-variables))
@@ -3792,6 +3809,11 @@ that suppresses all warnings during execution of BODY."
3792 3809
3793(defun byte-compile-defvar (form) 3810(defun byte-compile-defvar (form)
3794 ;; This is not used for file-level defvar/consts with doc strings. 3811 ;; This is not used for file-level defvar/consts with doc strings.
3812 (when (and (symbolp (nth 1 form))
3813 (not (string-match "[-*:$]" (symbol-name (nth 1 form))))
3814 (byte-compile-warning-enabled-p 'lexical))
3815 (byte-compile-warn "Global/dynamic var `%s' lacks a prefix"
3816 (nth 1 form)))
3795 (let ((fun (nth 0 form)) 3817 (let ((fun (nth 0 form))
3796 (var (nth 1 form)) 3818 (var (nth 1 form))
3797 (value (nth 2 form)) 3819 (value (nth 2 form))
@@ -4240,6 +4262,8 @@ and corresponding effects."
4240 4262
4241(defvar byte-code-meter) 4263(defvar byte-code-meter)
4242(defun byte-compile-report-ops () 4264(defun byte-compile-report-ops ()
4265 (or (boundp 'byte-metering-on)
4266 (error "You must build Emacs with -DBYTE_CODE_METER to use this"))
4243 (with-output-to-temp-buffer "*Meter*" 4267 (with-output-to-temp-buffer "*Meter*"
4244 (set-buffer "*Meter*") 4268 (set-buffer "*Meter*")
4245 (let ((i 0) n op off) 4269 (let ((i 0) n op off)
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 78eba19a253..a1494741572 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -120,7 +120,7 @@ This means the number of non-shy regexp grouping constructs
120 (string-match regexp "") 120 (string-match regexp "")
121 ;; Count the number of open parentheses in REGEXP. 121 ;; Count the number of open parentheses in REGEXP.
122 (let ((count 0) start last) 122 (let ((count 0) start last)
123 (while (string-match "\\\\(\\(\\?:\\)?" regexp start) 123 (while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start)
124 (setq start (match-end 0)) ; Start of next search. 124 (setq start (match-end 0)) ; Start of next search.
125 (when (and (not (match-beginning 1)) 125 (when (and (not (match-beginning 1))
126 (subregexp-context-p regexp (match-beginning 0) last)) 126 (subregexp-context-p regexp (match-beginning 0) last))
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 1ac6e266f0f..ad0166e7af0 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -34,7 +34,6 @@
34 34
35;; - do something about the case where the syntax-table is changed. 35;; - do something about the case where the syntax-table is changed.
36;; This typically happens with tex-mode and its `$' operator. 36;; This typically happens with tex-mode and its `$' operator.
37;; - move font-lock-syntactic-keywords in here. Then again, maybe not.
38;; - new functions `syntax-state', ... to replace uses of parse-partial-state 37;; - new functions `syntax-state', ... to replace uses of parse-partial-state
39;; with something higher-level (similar to syntax-ppss-context). 38;; with something higher-level (similar to syntax-ppss-context).
40;; - interaction with mmm-mode. 39;; - interaction with mmm-mode.
@@ -47,6 +46,249 @@
47 46
48(defvar font-lock-beginning-of-syntax-function) 47(defvar font-lock-beginning-of-syntax-function)
49 48
49;;; Applying syntax-table properties where needed.
50
51(defvar syntax-propertize-function nil
52 ;; Rather than a -functions hook, this is a -function because it's easier
53 ;; to do a single scan than several scans: with multiple scans, one cannot
54 ;; assume that the text before point has been propertized, so syntax-ppss
55 ;; gives unreliable results (and stores them in its cache to boot, so we'd
56 ;; have to flush that cache between each function, and we couldn't use
57 ;; syntax-ppss-flush-cache since that would not only flush the cache but also
58 ;; reset syntax-propertize--done which should not be done in this case).
59 "Mode-specific function to apply the syntax-table properties.
60Called with 2 arguments: START and END.")
61
62(defvar syntax-propertize-chunk-size 500)
63
64(defvar syntax-propertize-extend-region-functions
65 '(syntax-propertize-wholelines)
66 "Special hook run just before proceeding to propertize a region.
67This is used to allow major modes to help `syntax-propertize' find safe buffer
68positions as beginning and end of the propertized region. Its most common use
69is to solve the problem of /identification/ of multiline elements by providing
70a function that tries to find such elements and move the boundaries such that
71they do not fall in the middle of one.
72Each function is called with two arguments (START and END) and it should return
73either a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
74These functions are run in turn repeatedly until they all return nil.
75Put first the functions more likely to cause a change and cheaper to compute.")
76;; Mark it as a special hook which doesn't use any global setting
77;; (i.e. doesn't obey the element t in the buffer-local value).
78(make-variable-buffer-local 'syntax-propertize-extend-region-functions)
79
80(defun syntax-propertize-wholelines (start end)
81 (goto-char start)
82 (cons (line-beginning-position)
83 (progn (goto-char end)
84 (if (bolp) (point) (line-beginning-position 2)))))
85
86(defun syntax-propertize-multiline (beg end)
87 "Let `syntax-propertize' pay attention to the syntax-multiline property."
88 (when (and (> beg (point-min))
89 (get-text-property (1- beg) 'syntax-multiline))
90 (setq beg (or (previous-single-property-change beg 'syntax-multiline)
91 (point-min))))
92 ;;
93 (when (get-text-property end 'font-lock-multiline)
94 (setq end (or (text-property-any end (point-max)
95 'syntax-multiline nil)
96 (point-max))))
97 (cons beg end))
98
99(defvar syntax-propertize--done -1
100 "Position upto which syntax-table properties have been set.")
101(make-variable-buffer-local 'syntax-propertize--done)
102
103(defun syntax-propertize--shift-groups (re n)
104 (replace-regexp-in-string
105 "\\\\(\\?\\([0-9]+\\):"
106 (lambda (s)
107 (replace-match
108 (number-to-string (+ n (string-to-number (match-string 1 s))))
109 t t s 1))
110 re t t))
111
112(defmacro syntax-propertize-rules (&rest rules)
113 "Make a function that applies RULES for use in `syntax-propertize-function'.
114The function will scan the buffer, applying the rules where they match.
115The buffer is scanned a single time, like \"lex\" would, rather than once
116per rule.
117
118Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP
119is an expression (evaluated at time of macro-expansion) that returns a regexp,
120and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to
121apply the property SYNTAX to the chars matched by the subgroup NUMBER
122of the regular expression, if NUMBER did match.
123SYNTAX is an expression that returns a value to apply as `syntax-table'
124property. Some expressions are handled specially:
125- if SYNTAX is a string, then it is converted with `string-to-syntax';
126- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP
127 will be applied to the buffer before running EXPS and if EXP is a string it
128 is also converted with `string-to-syntax'.
129The SYNTAX expression is responsible to save the `match-data' if needed
130for subsequent HIGHLIGHTs.
131Also SYNTAX is free to move point, in which case RULES may not be applied to
132some parts of the text or may be applied several times to other parts.
133
134Note: back-references in REGEXPs do not work."
135 (declare (debug (&rest (form &rest
136 (numberp
137 [&or stringp
138 ("prog1" [&or stringp def-form] def-body)
139 def-form])))))
140 (let* ((offset 0)
141 (branches '())
142 ;; We'd like to use a real DFA-based lexer, usually, but since Emacs
143 ;; doesn't have one yet, we fallback on building one large regexp
144 ;; and use groups to determine which branch of the regexp matched.
145 (re
146 (mapconcat
147 (lambda (rule)
148 (let ((re (eval (car rule))))
149 (when (and (assq 0 rule) (cdr rules))
150 ;; If there's more than 1 rule, and the rule want to apply
151 ;; highlight to match 0, create an extra group to be able to
152 ;; tell when *this* match 0 has succeeded.
153 (incf offset)
154 (setq re (concat "\\(" re "\\)")))
155 (setq re (syntax-propertize--shift-groups re offset))
156 (let ((code '())
157 (condition
158 (cond
159 ((assq 0 rule) (if (zerop offset) t
160 `(match-beginning ,offset)))
161 ((null (cddr rule))
162 `(match-beginning ,(+ offset (car (cadr rule)))))
163 (t
164 `(or ,@(mapcar
165 (lambda (case)
166 `(match-beginning ,(+ offset (car case))))
167 (cdr rule))))))
168 (nocode t)
169 (offset offset))
170 ;; If some of the subgroup rules include Elisp code, then we
171 ;; need to set the match-data so it's consistent with what the
172 ;; code expects. If not, then we can simply use shifted
173 ;; offset in our own code.
174 (unless (zerop offset)
175 (dolist (case (cdr rule))
176 (unless (stringp (cadr case))
177 (setq nocode nil)))
178 (unless nocode
179 (push `(let ((md (match-data 'ints)))
180 ;; Keep match 0 as is, but shift everything else.
181 (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md))
182 (set-match-data md))
183 code)
184 (setq offset 0)))
185 ;; Now construct the code for each subgroup rules.
186 (dolist (case (cdr rule))
187 (assert (null (cddr case)))
188 (let* ((gn (+ offset (car case)))
189 (action (nth 1 case))
190 (thiscode
191 (cond
192 ((stringp action)
193 `((put-text-property
194 (match-beginning ,gn) (match-end ,gn)
195 'syntax-table
196 ',(string-to-syntax action))))
197 ((eq (car-safe action) 'ignore)
198 (cdr action))
199 ((eq (car-safe action) 'prog1)
200 (if (stringp (nth 1 action))
201 `((put-text-property
202 (match-beginning ,gn) (match-end ,gn)
203 'syntax-table
204 ',(string-to-syntax (nth 1 action)))
205 ,@(nthcdr 2 action))
206 `((let ((mb (match-beginning ,gn))
207 (me (match-end ,gn))
208 (syntax ,(nth 1 action)))
209 (if syntax
210 (put-text-property
211 mb me 'syntax-table syntax))
212 ,@(nthcdr 2 action)))))
213 (t
214 `((let ((mb (match-beginning ,gn))
215 (me (match-end ,gn))
216 (syntax ,action))
217 (if syntax
218 (put-text-property
219 mb me 'syntax-table syntax))))))))
220
221 (if (or (not (cddr rule)) (zerop gn))
222 (setq code (nconc (nreverse thiscode) code))
223 (push `(if (match-beginning ,gn)
224 ;; Try and generate clean code with no
225 ;; extraneous progn.
226 ,(if (null (cdr thiscode))
227 (car thiscode)
228 `(progn ,@thiscode)))
229 code))))
230 (push (cons condition (nreverse code))
231 branches))
232 (incf offset (regexp-opt-depth re))
233 re))
234 rules
235 "\\|")))
236 `(lambda (start end)
237 (goto-char start)
238 (while (and (< (point) end)
239 (re-search-forward ,re end t))
240 (cond ,@(nreverse branches))))))
241
242(defun syntax-propertize-via-font-lock (keywords)
243 "Propertize for syntax in START..END using font-lock syntax.
244KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
245The return value is a function suitable for `syntax-propertize-function'."
246 (lexical-let ((keywords keywords))
247 (lambda (start end)
248 (with-no-warnings
249 (let ((font-lock-syntactic-keywords keywords))
250 (font-lock-fontify-syntactic-keywords-region start end)
251 ;; In case it was eval'd/compiled.
252 (setq keywords font-lock-syntactic-keywords))))))
253
254(defun syntax-propertize (pos)
255 "Ensure that syntax-table properties are set upto POS."
256 (when (and syntax-propertize-function
257 (< syntax-propertize--done pos))
258 ;; (message "Needs to syntax-propertize from %s to %s"
259 ;; syntax-propertize--done pos)
260 (set (make-local-variable 'parse-sexp-lookup-properties) t)
261 (save-excursion
262 (with-silent-modifications
263 (let* ((start (max syntax-propertize--done (point-min)))
264 (end (max pos
265 (min (point-max)
266 (+ start syntax-propertize-chunk-size))))
267 (funs syntax-propertize-extend-region-functions))
268 (while funs
269 (let ((new (funcall (pop funs) start end)))
270 (if (or (null new)
271 (and (>= (car new) start) (<= (cdr new) end)))
272 nil
273 (setq start (car new))
274 (setq end (cdr new))
275 ;; If there's been a change, we should go through the
276 ;; list again since this new position may
277 ;; warrant a different answer from one of the funs we've
278 ;; already seen.
279 (unless (eq funs
280 (cdr syntax-propertize-extend-region-functions))
281 (setq funs syntax-propertize-extend-region-functions)))))
282 ;; Move the limit before calling the function, so the function
283 ;; can use syntax-ppss.
284 (setq syntax-propertize--done end)
285 ;; (message "syntax-propertizing from %s to %s" start end)
286 (remove-text-properties start end
287 '(syntax-table nil syntax-multiline nil))
288 (funcall syntax-propertize-function start end))))))
289
290;;; Incrementally compute and memoize parser state.
291
50(defsubst syntax-ppss-depth (ppss) 292(defsubst syntax-ppss-depth (ppss)
51 (nth 0 ppss)) 293 (nth 0 ppss))
52 294
@@ -92,6 +334,8 @@ point (where the PPSS is equivalent to nil).")
92(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) 334(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
93(defun syntax-ppss-flush-cache (beg &rest ignored) 335(defun syntax-ppss-flush-cache (beg &rest ignored)
94 "Flush the cache of `syntax-ppss' starting at position BEG." 336 "Flush the cache of `syntax-ppss' starting at position BEG."
337 ;; Set syntax-propertize to refontify anything past beg.
338 (setq syntax-propertize--done (min beg syntax-propertize--done))
95 ;; Flush invalid cache entries. 339 ;; Flush invalid cache entries.
96 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) 340 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
97 (setq syntax-ppss-cache (cdr syntax-ppss-cache))) 341 (setq syntax-ppss-cache (cdr syntax-ppss-cache)))
@@ -128,6 +372,7 @@ the 2nd and 6th values of the returned state cannot be relied upon.
128Point is at POS when this function returns." 372Point is at POS when this function returns."
129 ;; Default values. 373 ;; Default values.
130 (unless pos (setq pos (point))) 374 (unless pos (setq pos (point)))
375 (syntax-propertize pos)
131 ;; 376 ;;
132 (let ((old-ppss (cdr syntax-ppss-last)) 377 (let ((old-ppss (cdr syntax-ppss-last))
133 (old-pos (car syntax-ppss-last)) 378 (old-pos (car syntax-ppss-last))
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index 24480ce3c76..3c6cf07ea1b 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -158,12 +158,17 @@ way."
158 (if (or beg end) 158 (if (or beg end)
159 (setq string (substring string (or beg 0) end))) 159 (setq string (substring string (or beg 0) end)))
160 (save-excursion 160 (save-excursion
161 (save-restriction 161 ;; If visiting, bind off buffer-file-name so that
162 (narrow-to-region (point) (point)) 162 ;; file-locking will not ask whether we should
163 (epa-file-decode-and-insert string file visit beg end replace) 163 ;; really edit the buffer.
164 (setq length (- (point-max) (point-min)))) 164 (let ((buffer-file-name
165 (if replace 165 (if visit nil buffer-file-name)))
166 (delete-region (point) (point-max))) 166 (save-restriction
167 (narrow-to-region (point) (point))
168 (epa-file-decode-and-insert string file visit beg end replace)
169 (setq length (- (point-max) (point-min))))
170 (if replace
171 (delete-region (point) (point-max))))
167 (if visit 172 (if visit
168 (set-visited-file-modtime)))) 173 (set-visited-file-modtime))))
169 (if (and local-copy 174 (if (and local-copy
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index bfea0dabfe2..6c316f5f958 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -544,6 +544,8 @@ and what they do:
544 contexts will not be affected. 544 contexts will not be affected.
545 545
546This is normally set via `font-lock-defaults'.") 546This is normally set via `font-lock-defaults'.")
547(make-obsolete-variable 'font-lock-syntactic-keywords
548 'syntax-propertize-function "24.1")
547 549
548(defvar font-lock-syntax-table nil 550(defvar font-lock-syntax-table nil
549 "Non-nil means use this syntax table for fontifying. 551 "Non-nil means use this syntax table for fontifying.
@@ -562,6 +564,8 @@ outside of any comment, string, or sexp. This variable is semi-obsolete;
562we recommend setting `syntax-begin-function' instead. 564we recommend setting `syntax-begin-function' instead.
563 565
564This is normally set via `font-lock-defaults'.") 566This is normally set via `font-lock-defaults'.")
567(make-obsolete-variable 'font-lock-beginning-of-syntax-function
568 'syntax-begin-function "23.3")
565 569
566(defvar font-lock-mark-block-function nil 570(defvar font-lock-mark-block-function nil
567 "*Non-nil means use this function to mark a block of text. 571 "*Non-nil means use this function to mark a block of text.
@@ -612,11 +616,10 @@ Major/minor modes can set this variable if they know which option applies.")
612 ;; 616 ;;
613 ;; Borrowed from lazy-lock.el. 617 ;; Borrowed from lazy-lock.el.
614 ;; We use this to preserve or protect things when modifying text properties. 618 ;; We use this to preserve or protect things when modifying text properties.
615 (defmacro save-buffer-state (varlist &rest body) 619 (defmacro save-buffer-state (&rest body)
616 "Bind variables according to VARLIST and eval BODY restoring buffer state." 620 "Bind variables according to VARLIST and eval BODY restoring buffer state."
617 (declare (indent 1) (debug let)) 621 (declare (indent 0) (debug t))
618 `(let* ,(append varlist 622 `(let ((inhibit-point-motion-hooks t))
619 `((inhibit-point-motion-hooks t)))
620 (with-silent-modifications 623 (with-silent-modifications
621 ,@body))) 624 ,@body)))
622 ;; 625 ;;
@@ -1020,7 +1023,7 @@ The region it returns may start or end in the middle of a line.")
1020 (funcall font-lock-fontify-region-function beg end loudly)) 1023 (funcall font-lock-fontify-region-function beg end loudly))
1021 1024
1022(defun font-lock-unfontify-region (beg end) 1025(defun font-lock-unfontify-region (beg end)
1023 (save-buffer-state nil 1026 (save-buffer-state
1024 (funcall font-lock-unfontify-region-function beg end))) 1027 (funcall font-lock-unfontify-region-function beg end)))
1025 1028
1026(defun font-lock-default-fontify-buffer () 1029(defun font-lock-default-fontify-buffer ()
@@ -1113,8 +1116,6 @@ Put first the functions more likely to cause a change and cheaper to compute.")
1113 1116
1114(defun font-lock-default-fontify-region (beg end loudly) 1117(defun font-lock-default-fontify-region (beg end loudly)
1115 (save-buffer-state 1118 (save-buffer-state
1116 ((parse-sexp-lookup-properties
1117 (or parse-sexp-lookup-properties font-lock-syntactic-keywords)))
1118 ;; Use the fontification syntax table, if any. 1119 ;; Use the fontification syntax table, if any.
1119 (with-syntax-table (or font-lock-syntax-table (syntax-table)) 1120 (with-syntax-table (or font-lock-syntax-table (syntax-table))
1120 (save-restriction 1121 (save-restriction
@@ -1136,8 +1137,14 @@ Put first the functions more likely to cause a change and cheaper to compute.")
1136 (setq beg font-lock-beg end font-lock-end)) 1137 (setq beg font-lock-beg end font-lock-end))
1137 ;; Now do the fontification. 1138 ;; Now do the fontification.
1138 (font-lock-unfontify-region beg end) 1139 (font-lock-unfontify-region beg end)
1139 (when font-lock-syntactic-keywords 1140 (when (and font-lock-syntactic-keywords
1140 (font-lock-fontify-syntactic-keywords-region beg end)) 1141 (null syntax-propertize-function))
1142 ;; Ensure the beginning of the file is properly syntactic-fontified.
1143 (let ((start beg))
1144 (when (< font-lock-syntactically-fontified start)
1145 (setq start (max font-lock-syntactically-fontified (point-min)))
1146 (setq font-lock-syntactically-fontified end))
1147 (font-lock-fontify-syntactic-keywords-region start end)))
1141 (unless font-lock-keywords-only 1148 (unless font-lock-keywords-only
1142 (font-lock-fontify-syntactically-region beg end loudly)) 1149 (font-lock-fontify-syntactically-region beg end loudly))
1143 (font-lock-fontify-keywords-region beg end loudly))))) 1150 (font-lock-fontify-keywords-region beg end loudly)))))
@@ -1436,11 +1443,10 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
1436(defun font-lock-fontify-syntactic-keywords-region (start end) 1443(defun font-lock-fontify-syntactic-keywords-region (start end)
1437 "Fontify according to `font-lock-syntactic-keywords' between START and END. 1444 "Fontify according to `font-lock-syntactic-keywords' between START and END.
1438START should be at the beginning of a line." 1445START should be at the beginning of a line."
1439 ;; Ensure the beginning of the file is properly syntactic-fontified. 1446 (unless parse-sexp-lookup-properties
1440 (when (and font-lock-syntactically-fontified 1447 ;; We wouldn't go through so much trouble if we didn't intend to use those
1441 (< font-lock-syntactically-fontified start)) 1448 ;; properties, would we?
1442 (setq start (max font-lock-syntactically-fontified (point-min))) 1449 (set (make-local-variable 'parse-sexp-lookup-properties) t))
1443 (setq font-lock-syntactically-fontified end))
1444 ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords. 1450 ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
1445 (when (symbolp font-lock-syntactic-keywords) 1451 (when (symbolp font-lock-syntactic-keywords)
1446 (setq font-lock-syntactic-keywords (font-lock-eval-keywords 1452 (setq font-lock-syntactic-keywords (font-lock-eval-keywords
@@ -1483,19 +1489,18 @@ START should be at the beginning of a line."
1483(defvar font-lock-comment-end-skip nil 1489(defvar font-lock-comment-end-skip nil
1484 "If non-nil, Font Lock mode uses this instead of `comment-end'.") 1490 "If non-nil, Font Lock mode uses this instead of `comment-end'.")
1485 1491
1486(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss) 1492(defun font-lock-fontify-syntactically-region (start end &optional loudly)
1487 "Put proper face on each string and comment between START and END. 1493 "Put proper face on each string and comment between START and END.
1488START should be at the beginning of a line." 1494START should be at the beginning of a line."
1495 (syntax-propertize end) ; Apply any needed syntax-table properties.
1489 (let ((comment-end-regexp 1496 (let ((comment-end-regexp
1490 (or font-lock-comment-end-skip 1497 (or font-lock-comment-end-skip
1491 (regexp-quote 1498 (regexp-quote
1492 (replace-regexp-in-string "^ *" "" comment-end)))) 1499 (replace-regexp-in-string "^ *" "" comment-end))))
1493 state face beg) 1500 ;; Find the `start' state.
1501 (state (syntax-ppss start))
1502 face beg)
1494 (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) 1503 (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
1495 (goto-char start)
1496 ;;
1497 ;; Find the `start' state.
1498 (setq state (or ppss (syntax-ppss start)))
1499 ;; 1504 ;;
1500 ;; Find each interesting place between here and `end'. 1505 ;; Find each interesting place between here and `end'.
1501 (while 1506 (while
diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el
index 45abc391e62..fb968e13a36 100644
--- a/lisp/gnus/.dir-locals.el
+++ b/lisp/gnus/.dir-locals.el
@@ -1 +1,4 @@
1((emacs-lisp-mode . ((show-trailing-whitespace . t)))) 1((emacs-lisp-mode . ((show-trailing-whitespace . t))))
2;; Local Variables:
3;; no-byte-compile: t
4;; End:
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ba3f335e381..8e2309f43a8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,91 @@
12010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * gnus-html.el (gnus-html-schedule-image-fetching)
4 (gnus-html-prefetch-images): Check for curl before using it.
5
6 * mm-decode.el (mm-text-html-renderer): Don't have gnus-article-html
7 depend on curl, which isn't essential.
8
9 * imap.el: Revert back to version
10 cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
11 seem problematic.
12
132010-09-14 Juanma Barranquero <lekktu@gmail.com>
14
15 * gnus-registry.el (gnus-registry-install-shortcuts):
16 Explicitly pass `obarray' to `unintern' to avoid a warning.
17
182010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
19
20 * gnus-start.el (gnus-read-active-for-groups): Reverted the previous
21 change.
22
23 * nnrss.el (nnrss-request-list): Removed this function and related
24 functions, including the moreover stuff.
25
262010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
27
28 * nnrss.el (nnrss-retrieve-groups): New function.
29
302010-09-14 Juanma Barranquero <lekktu@gmail.com>
31
32 * .dir-locals.el: Add no-byte-compile cookie.
33
342010-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
35
36 * gnus-start.el (gnus-read-active-for-groups): Run gnus-activate-group
37 for back end that doesn't support request-scan.
38
392010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
40
41 * gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set,
42 then do request scans from the backends.
43
44 * gnus-sum.el (gnus-summary-update-hook): Change default to nil, to
45 avoid running a hook per line, since this takes a lot of time,
46 profiling shows.
47 (gnus-summary-prepare-threads): Call `gnus-summary-highlight-line'
48 directly if gnus-visual-p is true.
49
502010-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
51
52 * gnus-start.el (gnus-read-active-for-groups): Check only subscribed
53 groups; replace mapcar with dolist which is a bit faster; pass groups
54 info to gnus-read-active-file-1.
55 (gnus-read-active-file-1): Scan only specified groups if the new
56 optional arg `infos' is given.
57
582010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
59
60 * mail-source.el (mail-source-fetch-pop): Use pop3-movemail again.
61
62 * pop3.el (pop3-movemail): Removed.
63 (pop3-streaming-movemail): Renamed to pop3-movemail.
64
65 * gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and
66 don't restrict end-tag searches to the end of the line.
67
682010-09-09 Katsumi Yamaoka <yamaoka@jpl.org>
69
70 * gnus-start.el (gnus-get-unread-articles): Set the number of unread
71 articles of every unchecked group to t, which means unknown since the
72 server has never been opened.
73
742010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
75
76 * gnus-html.el (gnus-html-show-alt-text): New command.
77 (gnus-html-browse-image): Ditto.
78 (gnus-html-wash-tags): Add the data to allow showing the ALT text and
79 to browse the image directly.
80 (gnus-html-wash-tags): Search for images first, so that <a><img> works
81 better.
82
83 * gnus-async.el (gnus-async-article-callback): Call
84 `gnus-html-prefetch-images' unconditionally.
85
86 * gnus-html.el (gnus-html-schedule-image-fetching): Decode entities
87 before feeding URLs to curl.
88
12010-09-07 Katsumi Yamaoka <yamaoka@jpl.org> 892010-09-07 Katsumi Yamaoka <yamaoka@jpl.org>
2 90
3 * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and 91 * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index 5b19adc2054..979e67120d1 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -237,13 +237,13 @@ that was fetched."
237 (setq gnus-async-current-prefetch-article nil) 237 (setq gnus-async-current-prefetch-article nil)
238 (when arg 238 (when arg
239 (gnus-async-set-buffer) 239 (gnus-async-set-buffer)
240 (when gnus-async-post-fetch-function 240 (save-excursion
241 (save-excursion 241 (save-restriction
242 (save-restriction 242 (narrow-to-region mark (point-max))
243 (narrow-to-region mark (point-max)) 243 ;; Prefetch images for the groups that want that.
244 ;; Prefetch images for the groups that want that. 244 (when (fboundp 'gnus-html-prefetch-images)
245 (when (fboundp 'gnus-html-prefetch-images) 245 (gnus-html-prefetch-images summary))
246 (gnus-html-prefetch-images summary)) 246 (when gnus-async-post-fetch-function
247 (funcall gnus-async-post-fetch-function summary)))) 247 (funcall gnus-async-post-fetch-function summary))))
248 (gnus-async-with-semaphore 248 (gnus-async-with-semaphore
249 (setq 249 (setq
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index bf9f0cd6b8d..ffa5ff1acdd 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -72,6 +72,15 @@ fit these criteria."
72 (define-key map "i" 'gnus-html-insert-image) 72 (define-key map "i" 'gnus-html-insert-image)
73 map)) 73 map))
74 74
75(defvar gnus-html-displayed-image-map
76 (let ((map (make-sparse-keymap)))
77 (define-key map "a" 'gnus-html-show-alt-text)
78 (define-key map "i" 'gnus-html-browse-image)
79 (define-key map "\r" 'gnus-html-browse-url)
80 (define-key map "u" 'gnus-article-copy-string)
81 (define-key map [tab] 'widget-forward)
82 map))
83
75;;;###autoload 84;;;###autoload
76(defun gnus-article-html (&optional handle) 85(defun gnus-article-html (&optional handle)
77 (let ((article-buffer (current-buffer))) 86 (let ((article-buffer (current-buffer)))
@@ -111,15 +120,104 @@ fit these criteria."
111 120
112(defvar gnus-article-mouse-face) 121(defvar gnus-article-mouse-face)
113 122
114(defun gnus-html-wash-tags () 123(defun gnus-html-pre-wash ()
124 (goto-char (point-min))
125 (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t)
126 (replace-match "" t t))
127 (goto-char (point-min))
128 (while (re-search-forward "<a name[^\n>]+>" nil t)
129 (replace-match "" t t)))
130
131(defun gnus-html-wash-images ()
115 (let (tag parameters string start end images url) 132 (let (tag parameters string start end images url)
116 (goto-char (point-min)) 133 (goto-char (point-min))
117 (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t) 134 ;; Search for all the images first.
118 (replace-match "" t t)) 135 (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t)
119 (goto-char (point-min)) 136 (setq parameters (match-string 1)
120 (while (re-search-forward "<a name[^\n>]+>" nil t) 137 start (match-beginning 0))
121 (replace-match "" t t)) 138 (delete-region start (point))
139 (when (search-forward "</img_alt>" (line-end-position) t)
140 (delete-region (match-beginning 0) (match-end 0)))
141 (setq end (point))
142 (when (string-match "src=\"\\([^\"]+\\)" parameters)
143 (setq url (match-string 1 parameters))
144 (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
145 (if (string-match "^cid:\\(.*\\)" url)
146 ;; URLs with cid: have their content stashed in other
147 ;; parts of the MIME structure, so just insert them
148 ;; immediately.
149 (let ((handle (mm-get-content-id
150 (setq url (match-string 1 url))))
151 image)
152 (when handle
153 (mm-with-part handle
154 (setq image (gnus-create-image (buffer-string)
155 nil t))))
156 (when image
157 (let ((string (buffer-substring start end)))
158 (delete-region start end)
159 (gnus-put-image image (gnus-string-or string "*") 'cid)
160 (gnus-add-image 'cid image))))
161 ;; Normal, external URL.
162 (if (gnus-html-image-url-blocked-p
163 url
164 (if (buffer-live-p gnus-summary-buffer)
165 (with-current-buffer gnus-summary-buffer
166 gnus-blocked-images)
167 gnus-blocked-images))
168 (progn
169 (widget-convert-button
170 'link start end
171 :action 'gnus-html-insert-image
172 :help-echo url
173 :keymap gnus-html-image-map
174 :button-keymap gnus-html-image-map)
175 (let ((overlay (gnus-make-overlay start end))
176 (spec (list url
177 (set-marker (make-marker) start)
178 (set-marker (make-marker) end))))
179 (gnus-overlay-put overlay 'local-map gnus-html-image-map)
180 (gnus-overlay-put overlay 'gnus-image spec)
181 (gnus-put-text-property
182 start end
183 'gnus-image spec)))
184 (let ((file (gnus-html-image-id url))
185 width height alt-text)
186 (when (string-match "height=\"?\\([0-9]+\\)" parameters)
187 (setq height (string-to-number (match-string 1 parameters))))
188 (when (string-match "width=\"?\\([0-9]+\\)" parameters)
189 (setq width (string-to-number (match-string 1 parameters))))
190 (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
191 parameters)
192 (setq alt-text (match-string 2 parameters)))
193 ;; Don't fetch images that are really small. They're
194 ;; probably tracking pictures.
195 (when (and (or (null height)
196 (> height 4))
197 (or (null width)
198 (> width 4)))
199 (if (file-exists-p file)
200 ;; It's already cached, so just insert it.
201 (let ((string (buffer-substring start end)))
202 ;; Delete the IMG text.
203 (delete-region start end)
204 (gnus-html-put-image file (point) string url alt-text))
205 ;; We don't have it, so schedule it for fetching
206 ;; asynchronously.
207 (push (list url
208 (set-marker (make-marker) start)
209 (point-marker))
210 images))))))))
211 (when images
212 (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
213
214(defun gnus-html-wash-tags ()
215 (let (tag parameters string start end images url)
216 (gnus-html-pre-wash)
217 (gnus-html-wash-images)
218
122 (goto-char (point-min)) 219 (goto-char (point-min))
220 ;; Then do the other tags.
123 (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) 221 (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t)
124 (setq tag (match-string 1) 222 (setq tag (match-string 1)
125 parameters (match-string 2) 223 parameters (match-string 2)
@@ -127,78 +225,12 @@ fit these criteria."
127 (when (plusp (length parameters)) 225 (when (plusp (length parameters))
128 (set-text-properties 0 (1- (length parameters)) nil parameters)) 226 (set-text-properties 0 (1- (length parameters)) nil parameters))
129 (delete-region start (point)) 227 (delete-region start (point))
130 (when (search-forward (concat "</" tag ">") (line-end-position) t) 228 (when (search-forward (concat "</" tag ">") nil t)
131 (delete-region (match-beginning 0) (match-end 0))) 229 (delete-region (match-beginning 0) (match-end 0)))
132 (setq end (point)) 230 (setq end (point))
133 (cond 231 (cond
134 ;; Fetch and insert a picture. 232 ;; Fetch and insert a picture.
135 ((equal tag "img_alt") 233 ((equal tag "img_alt"))
136 (when (string-match "src=\"\\([^\"]+\\)" parameters)
137 (setq url (match-string 1 parameters))
138 (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
139 (if (string-match "^cid:\\(.*\\)" url)
140 ;; URLs with cid: have their content stashed in other
141 ;; parts of the MIME structure, so just insert them
142 ;; immediately.
143 (let ((handle (mm-get-content-id
144 (setq url (match-string 1 url))))
145 image)
146 (when handle
147 (mm-with-part handle
148 (setq image (gnus-create-image (buffer-string)
149 nil t))))
150 (when image
151 (let ((string (buffer-substring start end)))
152 (delete-region start end)
153 (gnus-put-image image (gnus-string-or string "*") 'cid)
154 (gnus-add-image 'cid image))))
155 ;; Normal, external URL.
156 (if (gnus-html-image-url-blocked-p
157 url
158 (if (buffer-live-p gnus-summary-buffer)
159 (with-current-buffer gnus-summary-buffer
160 gnus-blocked-images)
161 gnus-blocked-images))
162 (progn
163 (widget-convert-button
164 'link start end
165 :action 'gnus-html-insert-image
166 :help-echo url
167 :keymap gnus-html-image-map
168 :button-keymap gnus-html-image-map)
169 (let ((overlay (gnus-make-overlay start end))
170 (spec (list url
171 (set-marker (make-marker) start)
172 (set-marker (make-marker) end))))
173 (gnus-overlay-put overlay 'local-map gnus-html-image-map)
174 (gnus-overlay-put overlay 'gnus-image spec)
175 (gnus-put-text-property
176 start end
177 'gnus-image spec)))
178 (let ((file (gnus-html-image-id url))
179 width height)
180 (when (string-match "height=\"?\\([0-9]+\\)" parameters)
181 (setq height (string-to-number (match-string 1 parameters))))
182 (when (string-match "width=\"?\\([0-9]+\\)" parameters)
183 (setq width (string-to-number (match-string 1 parameters))))
184 ;; Don't fetch images that are really small. They're
185 ;; probably tracking pictures.
186 (when (and (or (null height)
187 (> height 4))
188 (or (null width)
189 (> width 4)))
190 (if (file-exists-p file)
191 ;; It's already cached, so just insert it.
192 (let ((string (buffer-substring start end)))
193 ;; Delete the ALT text.
194 (delete-region start end)
195 (gnus-html-put-image file (point) string))
196 ;; We don't have it, so schedule it for fetching
197 ;; asynchronously.
198 (push (list url
199 (set-marker (make-marker) start)
200 (point-marker))
201 images))))))))
202 ;; Add a link. 234 ;; Add a link.
203 ((or (equal tag "a") 235 ((or (equal tag "a")
204 (equal tag "A")) 236 (equal tag "A"))
@@ -227,8 +259,6 @@ fit these criteria."
227 ;; off any </pre_int>s that were left over. 259 ;; off any </pre_int>s that were left over.
228 (while (re-search-forward "</pre_int>\\|</internal>" nil t) 260 (while (re-search-forward "</pre_int>\\|</internal>" nil t)
229 (replace-match "" t t)) 261 (replace-match "" t t))
230 (when images
231 (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))
232 (mm-url-decode-entities))) 262 (mm-url-decode-entities)))
233 263
234(defun gnus-html-insert-image () 264(defun gnus-html-insert-image ()
@@ -237,21 +267,40 @@ fit these criteria."
237 (gnus-html-schedule-image-fetching 267 (gnus-html-schedule-image-fetching
238 (current-buffer) (list (get-text-property (point) 'gnus-image)))) 268 (current-buffer) (list (get-text-property (point) 'gnus-image))))
239 269
270(defun gnus-html-show-alt-text ()
271 "Show the ALT text of the image under point."
272 (interactive)
273 (message "%s" (get-text-property (point) 'gnus-alt-text)))
274
275(defun gnus-html-browse-image ()
276 "Browse the image under point."
277 (interactive)
278 (browse-url (get-text-property (point) 'gnus-image)))
279
280(defun gnus-html-browse-url ()
281 "Browse the image under point."
282 (interactive)
283 (let ((url (get-text-property (point) 'gnus-string)))
284 (if (not url)
285 (message "No URL at point")
286 (browse-url url))))
287
240(defun gnus-html-schedule-image-fetching (buffer images) 288(defun gnus-html-schedule-image-fetching (buffer images)
241 (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" 289 (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
242 buffer images) 290 buffer images)
243 (let* ((url (caar images)) 291 (when (executable-find "curl")
244 (process (start-process 292 (let* ((url (caar images))
245 "images" nil "curl" 293 (process (start-process
246 "-s" "--create-dirs" 294 "images" nil "curl"
247 "--location" 295 "-s" "--create-dirs"
248 "--max-time" "60" 296 "--location"
249 "-o" (gnus-html-image-id url) 297 "--max-time" "60"
250 url))) 298 "-o" (gnus-html-image-id url)
251 (process-kill-without-query process) 299 (mm-url-decode-entities-string url))))
252 (set-process-sentinel process 'gnus-html-curl-sentinel) 300 (process-kill-without-query process)
253 (gnus-set-process-plist process (list 'images images 301 (set-process-sentinel process 'gnus-html-curl-sentinel)
254 'buffer buffer)))) 302 (gnus-set-process-plist process (list 'images images
303 'buffer buffer)))))
255 304
256(defun gnus-html-image-id (url) 305(defun gnus-html-image-id (url)
257 (expand-file-name (sha1 url) gnus-html-cache-directory)) 306 (expand-file-name (sha1 url) gnus-html-cache-directory))
@@ -276,7 +325,7 @@ fit these criteria."
276 (when images 325 (when images
277 (gnus-html-schedule-image-fetching buffer images))))) 326 (gnus-html-schedule-image-fetching buffer images)))))
278 327
279(defun gnus-html-put-image (file point string) 328(defun gnus-html-put-image (file point string &optional url alt-text)
280 (when (gnus-graphic-display-p) 329 (when (gnus-graphic-display-p)
281 (let* ((image (ignore-errors 330 (let* ((image (ignore-errors
282 (gnus-create-image file))) 331 (gnus-create-image file)))
@@ -301,11 +350,17 @@ fit these criteria."
301 'gif) 350 'gif)
302 (= (car size) 30) 351 (= (car size) 30)
303 (= (cdr size) 30)))) 352 (= (cdr size) 30))))
304 (progn 353 (let ((start (point)))
305 (setq image (gnus-html-rescale-image image file size)) 354 (setq image (gnus-html-rescale-image image file size))
306 (gnus-put-image image 355 (gnus-put-image image
307 (gnus-string-or string "*") 356 (gnus-string-or string "*")
308 'external) 357 'external)
358 (let ((overlay (gnus-make-overlay start (point))))
359 (gnus-overlay-put overlay 'local-map
360 gnus-html-displayed-image-map)
361 (gnus-put-text-property start (point) 'gnus-alt-text alt-text)
362 (when url
363 (gnus-put-text-property start (point) 'gnus-image url)))
309 (gnus-add-image 'external image) 364 (gnus-add-image 'external image)
310 t) 365 t)
311 (insert string) 366 (insert string)
@@ -360,7 +415,7 @@ fit these criteria."
360 (delete-file (nth 2 file))))))) 415 (delete-file (nth 2 file)))))))
361 416
362(defun gnus-html-image-url-blocked-p (url blocked-images) 417(defun gnus-html-image-url-blocked-p (url blocked-images)
363"Find out if URL is blocked by BLOCKED-IMAGES." 418 "Find out if URL is blocked by BLOCKED-IMAGES."
364 (let ((ret (and blocked-images 419 (let ((ret (and blocked-images
365 (string-match blocked-images url)))) 420 (string-match blocked-images url))))
366 (if ret 421 (if ret
@@ -387,7 +442,8 @@ This only works if the article in question is HTML."
387;;;###autoload 442;;;###autoload
388(defun gnus-html-prefetch-images (summary) 443(defun gnus-html-prefetch-images (summary)
389 (let (blocked-images urls) 444 (let (blocked-images urls)
390 (when (buffer-live-p summary) 445 (when (and (buffer-live-p summary)
446 (executable-find "curl"))
391 (with-current-buffer summary 447 (with-current-buffer summary
392 (setq blocked-images gnus-blocked-images)) 448 (setq blocked-images gnus-blocked-images))
393 (save-match-data 449 (save-match-data
@@ -395,7 +451,7 @@ This only works if the article in question is HTML."
395 (let ((url (match-string 1))) 451 (let ((url (match-string 1)))
396 (unless (gnus-html-image-url-blocked-p url blocked-images) 452 (unless (gnus-html-image-url-blocked-p url blocked-images)
397 (unless (file-exists-p (gnus-html-image-id url)) 453 (unless (file-exists-p (gnus-html-image-id url))
398 (push url urls) 454 (push (mm-url-decode-entities-string url) urls)
399 (push (gnus-html-image-id url) urls) 455 (push (gnus-html-image-id url) urls)
400 (push "-o" urls))))) 456 (push "-o" urls)))))
401 (let ((process 457 (let ((process
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 5f945826941..8ba6c169bc4 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -783,7 +783,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
783 (function-name (format function-format variant-name)) 783 (function-name (format function-format variant-name))
784 (shortcut (format "%c" data)) 784 (shortcut (format "%c" data))
785 (shortcut (if remove (upcase shortcut) shortcut))) 785 (shortcut (if remove (upcase shortcut) shortcut)))
786 (unintern function-name) 786 (unintern function-name obarray)
787 (eval 787 (eval
788 `(defun 788 `(defun
789 ;; function name 789 ;; function name
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 2af55fc7a86..1c06a774203 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1692,7 +1692,7 @@ If SCAN, request a scan of that group as well."
1692 (gnus-agent-article-local-times 0) 1692 (gnus-agent-article-local-times 0)
1693 (archive-method (gnus-server-to-method "archive")) 1693 (archive-method (gnus-server-to-method "archive"))
1694 infos info group active method cmethod 1694 infos info group active method cmethod
1695 method-type method-group-list) 1695 method-type method-group-list entry)
1696 (gnus-message 6 "Checking new news...") 1696 (gnus-message 6 "Checking new news...")
1697 1697
1698 (while newsrc 1698 (while newsrc
@@ -1737,12 +1737,18 @@ If SCAN, request a scan of that group as well."
1737 (push (setq method-group-list (list method method-type nil)) 1737 (push (setq method-group-list (list method method-type nil))
1738 type-cache)) 1738 type-cache))
1739 ;; Only add groups that need updating. 1739 ;; Only add groups that need updating.
1740 (when (<= (gnus-info-level info) 1740 (if (<= (gnus-info-level info)
1741 (if (eq (cadr method-group-list) 'foreign) 1741 (if (eq (cadr method-group-list) 'foreign)
1742 foreign-level 1742 foreign-level
1743 alevel)) 1743 alevel))
1744 (setcar (nthcdr 2 method-group-list) 1744 (setcar (nthcdr 2 method-group-list)
1745 (cons info (nth 2 method-group-list))))) 1745 (cons info (nth 2 method-group-list)))
1746 ;; The group is inactive, so we nix out the number of unread articles.
1747 ;; It leads `(gnus-group-unread group)' to return t. See also
1748 ;; `gnus-group-prepare-flat'.
1749 (unless active
1750 (when (setq entry (gnus-group-entry group))
1751 (setcar entry t)))))
1746 1752
1747 ;; Sort the methods based so that the primary and secondary 1753 ;; Sort the methods based so that the primary and secondary
1748 ;; methods come first. This is done for legacy reasons to try to 1754 ;; methods come first. This is done for legacy reasons to try to
@@ -1795,14 +1801,15 @@ If SCAN, request a scan of that group as well."
1795 (cond 1801 (cond
1796 ((gnus-check-backend-function 'retrieve-groups (car method)) 1802 ((gnus-check-backend-function 'retrieve-groups (car method))
1797 (when (gnus-check-backend-function 'request-scan (car method)) 1803 (when (gnus-check-backend-function 'request-scan (car method))
1798 (gnus-request-scan nil method)) 1804 (dolist (info infos)
1799 (gnus-read-active-file-2 1805 (gnus-request-scan (gnus-info-group info) method)))
1800 (mapcar (lambda (info) 1806 (let (groups)
1801 (gnus-group-real-name (gnus-info-group info))) 1807 (gnus-read-active-file-2
1802 infos) 1808 (dolist (info infos (nreverse groups))
1803 method)) 1809 (push (gnus-group-real-name (gnus-info-group info)) groups))
1810 method)))
1804 ((gnus-check-backend-function 'request-list (car method)) 1811 ((gnus-check-backend-function 'request-list (car method))
1805 (gnus-read-active-file-1 method nil)) 1812 (gnus-read-active-file-1 method nil infos))
1806 (t 1813 (t
1807 (dolist (info infos) 1814 (dolist (info infos)
1808 (gnus-activate-group (gnus-info-group info) nil nil method t)))))) 1815 (gnus-activate-group (gnus-info-group info) nil nil method t))))))
@@ -2031,7 +2038,7 @@ If SCAN, request a scan of that group as well."
2031 (message "Quit reading the active file") 2038 (message "Quit reading the active file")
2032 nil)))))))) 2039 nil))))))))
2033 2040
2034(defun gnus-read-active-file-1 (method force) 2041(defun gnus-read-active-file-1 (method force &optional infos)
2035 (let (where mesg) 2042 (let (where mesg)
2036 (setq where (nth 1 method) 2043 (setq where (nth 1 method)
2037 mesg (format "Reading active file%s via %s..." 2044 mesg (format "Reading active file%s via %s..."
@@ -2041,10 +2048,14 @@ If SCAN, request a scan of that group as well."
2041 (gnus-message 5 mesg) 2048 (gnus-message 5 mesg)
2042 (when (gnus-check-server method) 2049 (when (gnus-check-server method)
2043 ;; Request that the backend scan its incoming messages. 2050 ;; Request that the backend scan its incoming messages.
2044 (when (and gnus-agent 2051 (when (and (or (and gnus-agent
2045 (gnus-online method) 2052 (gnus-online method))
2053 (not gnus-agent))
2046 (gnus-check-backend-function 'request-scan (car method))) 2054 (gnus-check-backend-function 'request-scan (car method)))
2047 (gnus-request-scan nil method)) 2055 (if infos
2056 (dolist (info infos)
2057 (gnus-request-scan (gnus-info-group info) method))
2058 (gnus-request-scan nil method)))
2048 (cond 2059 (cond
2049 ((and (eq gnus-read-active-file 'some) 2060 ((and (eq gnus-read-active-file 'some)
2050 (gnus-check-backend-function 'retrieve-groups (car method)) 2061 (gnus-check-backend-function 'retrieve-groups (car method))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a99426ad83f..df20456b278 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -985,8 +985,7 @@ This hook is not called from the non-updating exit commands like `Q'."
985 :group 'gnus-various 985 :group 'gnus-various
986 :type 'hook) 986 :type 'hook)
987 987
988(defcustom gnus-summary-update-hook 988(defcustom gnus-summary-update-hook nil
989 (list 'gnus-summary-highlight-line)
990 "*A hook called when a summary line is changed. 989 "*A hook called when a summary line is changed.
991The hook will not be called if `gnus-visual' is nil. 990The hook will not be called if `gnus-visual' is nil.
992 991
@@ -3753,6 +3752,7 @@ buffer that was in action when the last article was fetched."
3753 (error (gnus-message 5 "Error updating the summary line"))) 3752 (error (gnus-message 5 "Error updating the summary line")))
3754 (when (gnus-visual-p 'summary-highlight 'highlight) 3753 (when (gnus-visual-p 'summary-highlight 'highlight)
3755 (forward-line -1) 3754 (forward-line -1)
3755 (gnus-summary-highlight-line)
3756 (gnus-run-hooks 'gnus-summary-update-hook) 3756 (gnus-run-hooks 'gnus-summary-update-hook)
3757 (forward-line 1)))) 3757 (forward-line 1))))
3758 3758
@@ -3785,6 +3785,7 @@ buffer that was in action when the last article was fetched."
3785 'score)) 3785 'score))
3786 ;; Do visual highlighting. 3786 ;; Do visual highlighting.
3787 (when (gnus-visual-p 'summary-highlight 'highlight) 3787 (when (gnus-visual-p 'summary-highlight 'highlight)
3788 (gnus-summary-highlight-line)
3788 (gnus-run-hooks 'gnus-summary-update-hook))))) 3789 (gnus-run-hooks 'gnus-summary-update-hook)))))
3789 3790
3790(defvar gnus-tmp-new-adopts nil) 3791(defvar gnus-tmp-new-adopts nil)
@@ -5363,7 +5364,9 @@ or a straight list of headers."
5363 'gnus-number number) 5364 'gnus-number number)
5364 (when gnus-visual-p 5365 (when gnus-visual-p
5365 (forward-line -1) 5366 (forward-line -1)
5366 (gnus-run-hooks 'gnus-summary-update-hook) 5367 (gnus-summary-highlight-line)
5368 (when gnus-summary-update-hook
5369 (gnus-run-hooks 'gnus-summary-update-hook))
5367 (forward-line 1)) 5370 (forward-line 1))
5368 5371
5369 (setq gnus-tmp-prev-subject simp-subject))) 5372 (setq gnus-tmp-prev-subject simp-subject)))
@@ -10734,6 +10737,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
10734 (t gnus-no-mark)) 10737 (t gnus-no-mark))
10735 'replied) 10738 'replied)
10736 (when (gnus-visual-p 'summary-highlight 'highlight) 10739 (when (gnus-visual-p 'summary-highlight 'highlight)
10740 (gnus-summary-highlight-line)
10737 (gnus-run-hooks 'gnus-summary-update-hook)) 10741 (gnus-run-hooks 'gnus-summary-update-hook))
10738 t) 10742 t)
10739 10743
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index d3ceb6dfd07..662b999c288 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -34,7 +34,7 @@
34 (require 'cl) 34 (require 'cl)
35 (require 'imap)) 35 (require 'imap))
36(autoload 'auth-source-user-or-password "auth-source") 36(autoload 'auth-source-user-or-password "auth-source")
37(autoload 'pop3-streaming-movemail "pop3") 37(autoload 'pop3-movemail "pop3")
38(autoload 'pop3-get-message-count "pop3") 38(autoload 'pop3-get-message-count "pop3")
39(autoload 'nnheader-cancel-timer "nnheader") 39(autoload 'nnheader-cancel-timer "nnheader")
40(require 'mm-util) 40(require 'mm-util)
@@ -839,11 +839,9 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
839 (if (eq authentication 'apop) 'apop 'pass)) 839 (if (eq authentication 'apop) 'apop 'pass))
840 (pop3-stream-type stream)) 840 (pop3-stream-type stream))
841 (if (or debug-on-quit debug-on-error) 841 (if (or debug-on-quit debug-on-error)
842 (save-excursion (pop3-streaming-movemail 842 (save-excursion (pop3-movemail mail-source-crash-box))
843 mail-source-crash-box))
844 (condition-case err 843 (condition-case err
845 (save-excursion (pop3-streaming-movemail 844 (save-excursion (pop3-movemail mail-source-crash-box))
846 mail-source-crash-box))
847 (error 845 (error
848 ;; We nix out the password in case the error 846 ;; We nix out the password in case the error
849 ;; was because of a wrong password being given. 847 ;; was because of a wrong password being given.
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 725adcf559c..c4cbce4abaf 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -105,9 +105,7 @@
105 ,disposition ,description ,cache ,id)) 105 ,disposition ,description ,cache ,id))
106 106
107(defcustom mm-text-html-renderer 107(defcustom mm-text-html-renderer
108 (cond ((and (executable-find "w3m") 108 (cond ((executable-find "w3m") 'gnus-article-html)
109 (executable-find "curl"))
110 'gnus-article-html)
111 ((executable-find "links") 'links) 109 ((executable-find "links") 'links)
112 ((executable-find "lynx") 'lynx) 110 ((executable-find "lynx") 'lynx)
113 ((locate-library "w3") 'w3) 111 ((locate-library "w3") 'w3)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 8d8a40d002a..555c2c3a77a 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -342,11 +342,6 @@ used to render text. If it is nil, text will simply be folded.")
342 ;; we return the article number. 342 ;; we return the article number.
343 (cons nnrss-group (car e)))))) 343 (cons nnrss-group (car e))))))
344 344
345(deffoo nnrss-request-list (&optional server)
346 (nnrss-possibly-change-group nil server)
347 (nnrss-generate-active)
348 t)
349
350(deffoo nnrss-open-server (server &optional defs connectionless) 345(deffoo nnrss-open-server (server &optional defs connectionless)
351 (nnrss-read-server-data server) 346 (nnrss-read-server-data server)
352 (nnoo-change-server 'nnrss server defs) 347 (nnoo-change-server 'nnrss server defs)
@@ -397,6 +392,18 @@ used to render text. If it is nil, text will simply be folded.")
397 (insert (car elem) "\t" (third elem) "\n")))) 392 (insert (car elem) "\t" (third elem) "\n"))))
398 t) 393 t)
399 394
395(deffoo nnrss-retrieve-groups (groups &optional server)
396 (nnrss-possibly-change-group nil server)
397 (dolist (group groups)
398 (nnrss-check-group group server))
399 (save-excursion
400 (set-buffer nntp-server-buffer)
401 (erase-buffer)
402 (dolist (group groups)
403 (let ((elem (assoc group nnrss-server-data)))
404 (insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
405 'active))
406
400(nnoo-define-skeleton nnrss) 407(nnoo-define-skeleton nnrss)
401 408
402;;; Internal functions 409;;; Internal functions
@@ -479,20 +486,6 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
479 (nnrss-read-group-data group server) 486 (nnrss-read-group-data group server)
480 (setq nnrss-group group))) 487 (setq nnrss-group group)))
481 488
482(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
483
484(defun nnrss-generate-active ()
485 (when (y-or-n-p "Fetch extra categories? ")
486 (mapc 'funcall nnrss-extra-categories))
487 (save-excursion
488 (set-buffer nntp-server-buffer)
489 (erase-buffer)
490 (dolist (elem nnrss-group-alist)
491 (insert (prin1-to-string (car elem)) " 0 1 y\n"))
492 (dolist (elem nnrss-server-data)
493 (unless (assoc (car elem) nnrss-group-alist)
494 (insert (prin1-to-string (car elem)) " 0 1 y\n")))))
495
496(autoload 'timezone-parse-date "timezone") 489(autoload 'timezone-parse-date "timezone")
497 490
498(defun nnrss-normalize-date (date) 491(defun nnrss-normalize-date (date)
@@ -868,33 +861,6 @@ It is useful when `(setq nnrss-use-local t)'."
868 (append nnheader-file-name-translation-alist '((?' . ?_))))) 861 (append nnheader-file-name-translation-alist '((?' . ?_)))))
869 (nnheader-translate-file-chars name))) 862 (nnheader-translate-file-chars name)))
870 863
871(defvar nnrss-moreover-url
872 "http://w.moreover.com/categories/category_list_rss.html"
873 "The url of moreover.com categories.")
874
875(defun nnrss-snarf-moreover-categories ()
876 "Snarf RSS links from moreover.com."
877 (interactive)
878 (let (category name url changed)
879 (with-temp-buffer
880 (nnrss-insert nnrss-moreover-url)
881 (goto-char (point-min))
882 (while (re-search-forward
883 "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
884 (if (match-string 1)
885 (setq category (match-string 1))
886 (setq url (match-string 2)
887 name (mm-url-decode-entities-string
888 (rfc2231-decode-encoded-string
889 (match-string 3))))
890 (if category
891 (setq name (concat category "." name)))
892 (unless (assoc name nnrss-server-data)
893 (setq changed t)
894 (push (list name 0 url) nnrss-server-data)))))
895 (if changed
896 (nnrss-save-server-data ""))))
897
898(defun nnrss-node-text (namespace local-name element) 864(defun nnrss-node-text (namespace local-name element)
899 (let* ((node (assq (intern (concat namespace (symbol-name local-name))) 865 (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
900 element)) 866 element))
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index a5470d7d818..4f28dcdca46 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -129,7 +129,8 @@ Shorter values mean quicker response, but are more CPU intensive.")
129 (truncate pop3-read-timeout)) 129 (truncate pop3-read-timeout))
130 1000)))))) 130 1000))))))
131 131
132(defun pop3-streaming-movemail (file) 132;;;###autoload
133(defun pop3-movemail (file)
133 "Transfer contents of a maildrop to the specified FILE. 134 "Transfer contents of a maildrop to the specified FILE.
134Use streaming commands." 135Use streaming commands."
135 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 136 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
@@ -227,44 +228,6 @@ Use streaming commands."
227 (pop3-pass process)) 228 (pop3-pass process))
228 (t (error "Invalid POP3 authentication scheme"))))) 229 (t (error "Invalid POP3 authentication scheme")))))
229 230
230(defun pop3-movemail (&optional crashbox)
231 "Transfer contents of a maildrop to the specified CRASHBOX."
232 (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
233 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
234 (crashbuf (get-buffer-create " *pop3-retr*"))
235 (n 1)
236 message-count
237 message-sizes)
238 (pop3-logon process)
239 (setq message-count (car (pop3-stat process)))
240 (when (> message-count 0)
241 (setq message-sizes (pop3-list process)))
242 (unwind-protect
243 (while (<= n message-count)
244 (message "Retrieving message %d of %d from %s... (%.1fk)"
245 n message-count pop3-mailhost
246 (/ (cdr (assoc n message-sizes))
247 1024.0))
248 (pop3-retr process n crashbuf)
249 (save-excursion
250 (set-buffer crashbuf)
251 (let ((coding-system-for-write 'binary))
252 (write-region (point-min) (point-max) crashbox t 'nomesg))
253 (set-buffer (process-buffer process))
254 (erase-buffer))
255 (unless pop3-leave-mail-on-server
256 (pop3-dele process n))
257 (setq n (+ 1 n))
258 (pop3-accept-process-output process))
259 (when (and pop3-leave-mail-on-server
260 (> n 1))
261 (message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server'
262to %s might not give the result you'd expect." pop3-leave-mail-on-server)
263 (sit-for 1))
264 (pop3-quit process))
265 (kill-buffer crashbuf))
266 t)
267
268(defun pop3-get-message-count () 231(defun pop3-get-message-count ()
269 "Return the number of messages in the maildrop." 232 "Return the number of messages in the maildrop."
270 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 233 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
diff --git a/lisp/image.el b/lisp/image.el
index 20e3d5f85aa..2ca2971b4aa 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -697,21 +697,28 @@ shall be displayed."
697 697
698(defcustom imagemagick-types-inhibit 698(defcustom imagemagick-types-inhibit
699 '(C HTML HTM TXT PDF) 699 '(C HTML HTM TXT PDF)
700 "Types the imagemagick loader should not try to handle.") 700 ;; FIXME what are the possible options?
701 ;; Are these actually file-name extensions?
702 ;; Why are these upper-case when eg image-types is lower-case?
703 "Types the ImageMagick loader should not try to handle."
704 :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil)
705 (repeat symbol))
706 :version "24.1"
707 :group 'image)
701 708
702;;;###autoload 709;;;###autoload
703(defun imagemagick-register-types () 710(defun imagemagick-register-types ()
704 "Register file types that imagemagick is able to handle." 711 "Register the file types that ImageMagick is able to handle."
705 (let ((im-types (imagemagick-types))) 712 (let ((im-types (imagemagick-types)))
706 (dolist (im-inhibit imagemagick-types-inhibit) 713 (dolist (im-inhibit imagemagick-types-inhibit)
707 (setq im-types (remove im-inhibit im-types))) 714 (setq im-types (remove im-inhibit im-types)))
708 (dolist (im-type im-types) 715 (dolist (im-type im-types)
709 (let ((extension (downcase (symbol-name im-type)))) 716 (let ((extension (downcase (symbol-name im-type))))
710 (push 717 (push
711 (cons (concat "\\." extension "\\'") 'image-mode) 718 (cons (concat "\\." extension "\\'") 'image-mode)
712 auto-mode-alist) 719 auto-mode-alist)
713 (push 720 (push
714 (cons (concat "\\." extension "\\'") 'imagemagick) 721 (cons (concat "\\." extension "\\'") 'imagemagick)
715 image-type-file-name-regexps))))) 722 image-type-file-name-regexps)))))
716 723
717 724
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 5061e500587..59850621388 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -100,7 +100,7 @@
100;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars') 100;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars')
101;; 101;;
102;; The block will be split to multiple samller blocks by starter 102;; The block will be split to multiple samller blocks by starter
103;; charcters. Each block is sorted, and composed if necessary. 103;; characters. Each block is sorted, and composed if necessary.
104;; 104;;
105;; E. Composition of Entire Block (`ucs-normalize-compose-chars') 105;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
106;; 106;;
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 24ddfb2c11f..bcc3d625d68 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -88,14 +88,14 @@ Bidirectional editing is supported.")))
88;; corresponding glyph of FONT-OBJECT. 88;; corresponding glyph of FONT-OBJECT.
89(defun hebrew-font-get-precomposed (font-object) 89(defun hebrew-font-get-precomposed (font-object)
90 (let ((precomposed (font-get font-object 'hebrew-precomposed)) 90 (let ((precomposed (font-get font-object 'hebrew-precomposed))
91 ;; Vector of Hebrew precomposed charaters. 91 ;; Vector of Hebrew precomposed characters.
92 (chars [#xFB2A #xFB2B #xFB2C #xFB2D #xFB2E #xFB2F #xFB30 #xFB31 92 (chars [#xFB2A #xFB2B #xFB2C #xFB2D #xFB2E #xFB2F #xFB30 #xFB31
93 #xFB32 #xFB33 #xFB34 #xFB35 #xFB36 #xFB38 #xFB39 #xFB3A 93 #xFB32 #xFB33 #xFB34 #xFB35 #xFB36 #xFB38 #xFB39 #xFB3A
94 #xFB3B #xFB3C #xFB3E #xFB40 #xFB41 #xFB43 #xFB44 #xFB46 94 #xFB3B #xFB3C #xFB3E #xFB40 #xFB41 #xFB43 #xFB44 #xFB46
95 #xFB47 #xFB48 #xFB49 #xFB4A #xFB4B #xFB4C #xFB4D #xFB4E]) 95 #xFB47 #xFB48 #xFB49 #xFB4A #xFB4B #xFB4C #xFB4D #xFB4E])
96 ;; Vector of decomposition character sequences corresponding 96 ;; Vector of decomposition character sequences corresponding
97 ;; to the above vector. 97 ;; to the above vector.
98 (decomposed 98 (decomposed
99 [[#x05E9 #x05C1] 99 [[#x05E9 #x05C1]
100 [#x05E9 #x05C2] 100 [#x05E9 #x05C2]
101 [#x05E9 #x05BC #x05C1] 101 [#x05E9 #x05BC #x05C1]
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index df997b76585..43328a9e46a 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -55,7 +55,7 @@ ETAGS = "../lib-src/$(BLD)/etags"
55# Automatically generated autoload files, apart from lisp/loaddefs.el. 55# Automatically generated autoload files, apart from lisp/loaddefs.el.
56LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ 56LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
57 $(lisp)/calendar/diary-loaddefs.el $(lisp)/calendar/hol-loaddefs.el \ 57 $(lisp)/calendar/diary-loaddefs.el $(lisp)/calendar/hol-loaddefs.el \
58 $(lisp)/mh-e/mh-loaddefs.el 58 $(lisp)/mh-e/mh-loaddefs.el $(lisp)/net/tramp-loaddefs.el
59 59
60AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ 60AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
61 $(lisp)/finder-inf.el $(lisp)/subdirs.el $(lisp)/eshell/esh-groups.el \ 61 $(lisp)/finder-inf.el $(lisp)/subdirs.el $(lisp)/eshell/esh-groups.el \
@@ -403,6 +403,25 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
403 -f w32-batch-update-autoloads \ 403 -f w32-batch-update-autoloads \
404 $(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e 404 $(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e
405 405
406# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
407# its own subdirectory. OTOH, it does not hurt to keep them in
408# lisp/net.
409TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \
410 $(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \
411 $(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \
412 $(lisp)/net/tramp-gw.el $(lisp)/net/tramp-imap.el \
413 $(lisp)/net/tramp-sh.el $(lisp)/net/tramp-smb.el \
414 $(lisp)/net/tramp-uu.el $(lisp)/net/trampver.el
415
416$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
417 "$(EMACS)" $(EMACSOPT) \
418 -l autoload \
419 --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \
420 --eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \
421 --eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \
422 -f w32-batch-update-autoloads \
423 $(ARGQUOTE)$(lisp)/net/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net
424
406# Prepare a bootstrap in the lisp subdirectory. 425# Prepare a bootstrap in the lisp subdirectory.
407# 426#
408# Build loaddefs.el to make sure it's up-to-date. If it's not, that 427# Build loaddefs.el to make sure it's up-to-date. If it's not, that
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 6149fea4769..d0a8653f95c 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -664,13 +664,23 @@ by \"Save Options\" in Custom buffers.")
664 ;; put on a customized-value property. 664 ;; put on a customized-value property.
665 (dolist (elt '(line-number-mode column-number-mode size-indication-mode 665 (dolist (elt '(line-number-mode column-number-mode size-indication-mode
666 cua-mode show-paren-mode transient-mark-mode 666 cua-mode show-paren-mode transient-mark-mode
667 blink-cursor-mode display-time-mode display-battery-mode)) 667 blink-cursor-mode display-time-mode display-battery-mode
668 ;; These are set by other functions that don't set
669 ;; the customized state. Having them here has the
670 ;; side-effect that turning them off via X
671 ;; resources acts like having customized them, but
672 ;; that seems harmless.
673 menu-bar-mode tool-bar-mode))
674 ;; FIXME ? It's a little annoying that running this command
675 ;; always loads cua-base, paren, time, and battery, even if they
676 ;; have not been customized in any way. (Due to custom-load-symbol.)
668 (and (customize-mark-to-save elt) 677 (and (customize-mark-to-save elt)
669 (setq need-save t))) 678 (setq need-save t)))
670 ;; These are set with `customize-set-variable'. 679 ;; These are set with `customize-set-variable'.
671 (dolist (elt '(scroll-bar-mode 680 (dolist (elt '(scroll-bar-mode
672 debug-on-quit debug-on-error 681 debug-on-quit debug-on-error
673 tooltip-mode menu-bar-mode tool-bar-mode 682 ;; Somehow this works, when tool-bar and menu-bar don't.
683 tooltip-mode
674 save-place uniquify-buffer-name-style fringe-mode 684 save-place uniquify-buffer-name-style fringe-mode
675 indicate-empty-lines indicate-buffer-boundaries 685 indicate-empty-lines indicate-buffer-boundaries
676 case-fold-search font-use-system-font 686 case-fold-search font-use-system-font
@@ -2037,6 +2047,16 @@ turn on menu bars; otherwise, turn off menu bars."
2037 (run-with-idle-timer 0 nil 'message 2047 (run-with-idle-timer 0 nil 'message
2038 "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear."))) 2048 "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear.")))
2039 2049
2050;;;###autoload
2051;; (This does not work right unless it comes after the above definition.)
2052;; This comment is taken from tool-bar.el near
2053;; (put 'tool-bar-mode ...)
2054;; We want to pretend the menu bar by standard is on, as this will make
2055;; customize consider disabling the menu bar a customization, and save
2056;; that. We could do this for real by setting :init-value above, but
2057;; that would overwrite disabling the menu bar from X resources.
2058(put 'menu-bar-mode 'standard-value '(t))
2059
2040(defun toggle-menu-bar-mode-from-frame (&optional arg) 2060(defun toggle-menu-bar-mode-from-frame (&optional arg)
2041 "Toggle menu bar on or off, based on the status of the current frame. 2061 "Toggle menu bar on or off, based on the status of the current frame.
2042See `menu-bar-mode' for more information." 2062See `menu-bar-mode' for more information."
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index e286a14a0e4..ed72d7b9ce0 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -448,6 +448,18 @@ The actual value is really the text on the continuation line.")
448The function should take two arguments, the first the IMAP tag and the 448The function should take two arguments, the first the IMAP tag and the
449second the status (OK, NO, BAD etc) of the command.") 449second the status (OK, NO, BAD etc) of the command.")
450 450
451(defvar imap-enable-exchange-bug-workaround nil
452 "Send FETCH UID commands as *:* instead of *.
453
454When non-nil, use an alternative UIDS form. Enabling appears to
455be required for some servers (e.g., Microsoft Exchange 2007)
456which otherwise would trigger a response 'BAD The specified
457message set is invalid.'. We don't unconditionally use this
458form, since this is said to be significantly inefficient.
459
460This variable is set to t automatically per server if the
461canonical form fails.")
462
451 463
452;; Utility functions: 464;; Utility functions:
453 465
@@ -1303,38 +1315,40 @@ If BUFFER is nil, the current buffer is assumed."
1303 1315
1304;; Mailbox functions: 1316;; Mailbox functions:
1305 1317
1306(defun imap-mailbox-put (propname value &optional mailbox) 1318(defun imap-mailbox-put (propname value &optional mailbox buffer)
1307 (if imap-mailbox-data 1319 (with-current-buffer (or buffer (current-buffer))
1308 (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) 1320 (if imap-mailbox-data
1309 propname value) 1321 (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
1310 (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" 1322 propname value)
1311 propname value mailbox (current-buffer))) 1323 (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
1312 t) 1324 propname value mailbox (current-buffer)))
1325 t))
1313 1326
1314(defsubst imap-mailbox-get-1 (propname &optional mailbox) 1327(defsubst imap-mailbox-get-1 (propname &optional mailbox)
1315 (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data) 1328 (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
1316 propname)) 1329 propname))
1317 1330
1318(defun imap-mailbox-get (propname &optional mailbox buffer) 1331(defun imap-mailbox-get (propname &optional mailbox buffer)
1332 (let ((mailbox (imap-utf7-encode mailbox)))
1333 (with-current-buffer (or buffer (current-buffer))
1334 (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
1335
1336(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
1319 (with-current-buffer (or buffer (current-buffer)) 1337 (with-current-buffer (or buffer (current-buffer))
1320 (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox) 1338 (let (result)
1321 imap-current-mailbox)))) 1339 (mapatoms
1322 1340 (lambda (s)
1323(defun imap-mailbox-map-1 (func &optional mailbox-decoder) 1341 (push (funcall func (if mailbox-decoder
1324 (let (result) 1342 (funcall mailbox-decoder (symbol-name s))
1325 (mapatoms 1343 (symbol-name s))) result))
1326 (lambda (s) 1344 imap-mailbox-data)
1327 (push (funcall func (if mailbox-decoder 1345 result)))
1328 (funcall mailbox-decoder (symbol-name s)) 1346
1329 (symbol-name s))) result)) 1347(defun imap-mailbox-map (func &optional buffer)
1330 imap-mailbox-data)
1331 result))
1332
1333(defun imap-mailbox-map (func)
1334 "Map a function across each mailbox in `imap-mailbox-data', returning a list. 1348 "Map a function across each mailbox in `imap-mailbox-data', returning a list.
1335Function should take a mailbox name (a string) as 1349Function should take a mailbox name (a string) as
1336the only argument." 1350the only argument."
1337 (imap-mailbox-map-1 func 'imap-utf7-decode)) 1351 (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
1338 1352
1339(defun imap-current-mailbox (&optional buffer) 1353(defun imap-current-mailbox (&optional buffer)
1340 (with-current-buffer (or buffer (current-buffer)) 1354 (with-current-buffer (or buffer (current-buffer))
@@ -1648,26 +1662,29 @@ is non-nil return these properties."
1648 uids) 1662 uids)
1649 (imap-message-get uids receive)))))) 1663 (imap-message-get uids receive))))))
1650 1664
1651(defun imap-message-put (uid propname value) 1665(defun imap-message-put (uid propname value &optional buffer)
1652 (if imap-message-data 1666 (with-current-buffer (or buffer (current-buffer))
1653 (put (intern (number-to-string uid) imap-message-data) 1667 (if imap-message-data
1654 propname value) 1668 (put (intern (number-to-string uid) imap-message-data)
1655 (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" 1669 propname value)
1656 uid propname value (current-buffer))) 1670 (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
1657 t) 1671 uid propname value (current-buffer)))
1672 t))
1658 1673
1659(defun imap-message-get (uid propname) 1674(defun imap-message-get (uid propname &optional buffer)
1660 (get (intern-soft (number-to-string uid) imap-message-data) 1675 (with-current-buffer (or buffer (current-buffer))
1661 propname)) 1676 (get (intern-soft (number-to-string uid) imap-message-data)
1677 propname)))
1662 1678
1663(defun imap-message-map (func propname) 1679(defun imap-message-map (func propname &optional buffer)
1664 "Map a function across each message in `imap-message-data', returning a list." 1680 "Map a function across each message in `imap-message-data', returning a list."
1665 (let (result) 1681 (with-current-buffer (or buffer (current-buffer))
1666 (mapatoms 1682 (let (result)
1667 (lambda (s) 1683 (mapatoms
1668 (push (funcall func (get s 'UID) (get s propname)) result)) 1684 (lambda (s)
1669 imap-message-data) 1685 (push (funcall func (get s 'UID) (get s propname)) result))
1670 result)) 1686 imap-message-data)
1687 result)))
1671 1688
1672(defmacro imap-message-envelope-date (uid &optional buffer) 1689(defmacro imap-message-envelope-date (uid &optional buffer)
1673 `(with-current-buffer (or ,buffer (current-buffer)) 1690 `(with-current-buffer (or ,buffer (current-buffer))
@@ -1763,6 +1780,48 @@ is non-nil return these properties."
1763 (format "String %s cannot be converted to a Lisp integer" number)) 1780 (format "String %s cannot be converted to a Lisp integer" number))
1764 number))) 1781 number)))
1765 1782
1783(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
1784 "Like `imap-fetch', but DTRT with Exchange 2007 bug.
1785However, UIDS here is a cons, where the car is the canonical form
1786of the UIDS specification, and the cdr is the one which works with
1787Exchange 2007 or, potentially, other buggy servers.
1788See `imap-enable-exchange-bug-workaround'."
1789 ;; The first time we get here for a given, we'll try the canonical
1790 ;; form. If we get the known error from the buggy server, set the
1791 ;; flag buffer-locally (to account for connections to multiple
1792 ;; servers), then re-try with the alternative UIDS spec. We don't
1793 ;; unconditionally use the alternative form, since the
1794 ;; currently-used alternatives are seriously inefficient with some
1795 ;; servers (although they are valid).
1796 ;;
1797 ;; FIXME: Maybe it would be cleaner to have a flag to not signal
1798 ;; the error (which otherwise gives a message), and test
1799 ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
1800 ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
1801 ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
1802 ;; to do the same?
1803 (condition-case data
1804 ;; Binding `debug-on-error' allows us to get the error from
1805 ;; `imap-parse-response' -- it's normally caught by Emacs around
1806 ;; execution of a process filter.
1807 (let ((debug-on-error t))
1808 (imap-fetch (if imap-enable-exchange-bug-workaround
1809 (cdr uids)
1810 (car uids))
1811 props receive nouidfetch buffer))
1812 (error
1813 (if (and (not imap-enable-exchange-bug-workaround)
1814 ;; This is the Exchange 2007 response. It may be more
1815 ;; robust just to check for a BAD response to the
1816 ;; attempted fetch.
1817 (string-match "The specified message set is invalid"
1818 (cadr data)))
1819 (with-current-buffer (or buffer (current-buffer))
1820 (set (make-local-variable 'imap-enable-exchange-bug-workaround)
1821 t)
1822 (imap-fetch (cdr uids) props receive nouidfetch))
1823 (signal (car data) (cdr data))))))
1824
1766(defun imap-message-copyuid-1 (mailbox) 1825(defun imap-message-copyuid-1 (mailbox)
1767 (if (imap-capability 'UIDPLUS) 1826 (if (imap-capability 'UIDPLUS)
1768 (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) 1827 (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
@@ -1772,7 +1831,7 @@ is non-nil return these properties."
1772 (imap-message-data (make-vector 2 0))) 1831 (imap-message-data (make-vector 2 0)))
1773 (when (imap-mailbox-examine-1 mailbox) 1832 (when (imap-mailbox-examine-1 mailbox)
1774 (prog1 1833 (prog1
1775 (and (imap-fetch "*:*" "UID") 1834 (and (imap-fetch-safe '("*" . "*:*") "UID")
1776 (list (imap-mailbox-get-1 'uidvalidity mailbox) 1835 (list (imap-mailbox-get-1 'uidvalidity mailbox)
1777 (apply 'max (imap-message-map 1836 (apply 'max (imap-message-map
1778 (lambda (uid prop) uid) 'UID)))) 1837 (lambda (uid prop) uid) 'UID))))
@@ -1818,7 +1877,7 @@ first element. The rest of list contains the saved articles' UIDs."
1818 (imap-message-data (make-vector 2 0))) 1877 (imap-message-data (make-vector 2 0)))
1819 (when (imap-mailbox-examine-1 mailbox) 1878 (when (imap-mailbox-examine-1 mailbox)
1820 (prog1 1879 (prog1
1821 (and (imap-fetch "*:*" "UID") 1880 (and (imap-fetch-safe '("*" . "*:*") "UID")
1822 (list (imap-mailbox-get-1 'uidvalidity mailbox) 1881 (list (imap-mailbox-get-1 'uidvalidity mailbox)
1823 (apply 'max (imap-message-map 1882 (apply 'max (imap-message-map
1824 (lambda (uid prop) uid) 'UID)))) 1883 (lambda (uid prop) uid) 'UID))))
@@ -2892,6 +2951,105 @@ Return nil if no complete line has arrived."
2892 (imap-forward) 2951 (imap-forward)
2893 (nreverse body))))) 2952 (nreverse body)))))
2894 2953
2954(when imap-debug ; (untrace-all)
2955 (require 'trace)
2956 (buffer-disable-undo (get-buffer-create imap-debug-buffer))
2957 (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
2958 '(
2959 imap-utf7-encode
2960 imap-utf7-decode
2961 imap-error-text
2962 imap-kerberos4s-p
2963 imap-kerberos4-open
2964 imap-ssl-p
2965 imap-ssl-open
2966 imap-network-p
2967 imap-network-open
2968 imap-interactive-login
2969 imap-kerberos4a-p
2970 imap-kerberos4-auth
2971 imap-cram-md5-p
2972 imap-cram-md5-auth
2973 imap-login-p
2974 imap-login-auth
2975 imap-anonymous-p
2976 imap-anonymous-auth
2977 imap-open-1
2978 imap-open
2979 imap-opened
2980 imap-ping-server
2981 imap-authenticate
2982 imap-close
2983 imap-capability
2984 imap-namespace
2985 imap-send-command-wait
2986 imap-mailbox-put
2987 imap-mailbox-get
2988 imap-mailbox-map-1
2989 imap-mailbox-map
2990 imap-current-mailbox
2991 imap-current-mailbox-p-1
2992 imap-current-mailbox-p
2993 imap-mailbox-select-1
2994 imap-mailbox-select
2995 imap-mailbox-examine-1
2996 imap-mailbox-examine
2997 imap-mailbox-unselect
2998 imap-mailbox-expunge
2999 imap-mailbox-close
3000 imap-mailbox-create-1
3001 imap-mailbox-create
3002 imap-mailbox-delete
3003 imap-mailbox-rename
3004 imap-mailbox-lsub
3005 imap-mailbox-list
3006 imap-mailbox-subscribe
3007 imap-mailbox-unsubscribe
3008 imap-mailbox-status
3009 imap-mailbox-acl-get
3010 imap-mailbox-acl-set
3011 imap-mailbox-acl-delete
3012 imap-current-message
3013 imap-list-to-message-set
3014 imap-fetch-asynch
3015 imap-fetch
3016 imap-fetch-safe
3017 imap-message-put
3018 imap-message-get
3019 imap-message-map
3020 imap-search
3021 imap-message-flag-permanent-p
3022 imap-message-flags-set
3023 imap-message-flags-del
3024 imap-message-flags-add
3025 imap-message-copyuid-1
3026 imap-message-copyuid
3027 imap-message-copy
3028 imap-message-appenduid-1
3029 imap-message-appenduid
3030 imap-message-append
3031 imap-body-lines
3032 imap-envelope-from
3033 imap-send-command-1
3034 imap-send-command
3035 imap-wait-for-tag
3036 imap-sentinel
3037 imap-find-next-line
3038 imap-arrival-filter
3039 imap-parse-greeting
3040 imap-parse-response
3041 imap-parse-resp-text
3042 imap-parse-resp-text-code
3043 imap-parse-data-list
3044 imap-parse-fetch
3045 imap-parse-status
3046 imap-parse-acl
3047 imap-parse-flag-list
3048 imap-parse-envelope
3049 imap-parse-body-extension
3050 imap-parse-body
3051 )))
3052
2895(provide 'imap) 3053(provide 'imap)
2896 3054
2897;;; imap.el ends here 3055;;; imap.el ends here
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 2306927f080..408eca9bac7 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -54,12 +54,19 @@
54 "Netrc configuration." 54 "Netrc configuration."
55 :group 'comm) 55 :group 'comm)
56 56
57(defcustom netrc-file "~/.authinfo"
58 "File where user credentials are stored."
59 :type 'file
60 :group 'netrc)
61
57(defvar netrc-services-file "/etc/services" 62(defvar netrc-services-file "/etc/services"
58 "The name of the services file.") 63 "The name of the services file.")
59 64
60(defun netrc-parse (file) 65(defun netrc-parse (&optional file)
61 (interactive "fFile to Parse: ") 66 (interactive "fFile to Parse: ")
62 "Parse FILE and return a list of all entries in the file." 67 "Parse FILE and return a list of all entries in the file."
68 (unless file
69 (setq file netrc-file))
63 (if (listp file) 70 (if (listp file)
64 file 71 file
65 (when (file-exists-p file) 72 (when (file-exists-p file)
@@ -221,6 +228,19 @@ MODE can be \"login\" or \"password\", suitable for passing to
221 (eq type (car (cddr service))))))) 228 (eq type (car (cddr service)))))))
222 (cadr service))) 229 (cadr service)))
223 230
231(defun netrc-credentials (machine &rest ports)
232 "Return a user name/password pair.
233Port specifications will be prioritised in the order they are
234listed in the PORTS list."
235 (let ((list (netrc-parse))
236 found)
237 (while (and ports
238 (not found))
239 (setq found (netrc-machine list machine (pop ports))))
240 (when found
241 (list (cdr (assoc "login" found))
242 (cdr (assoc "password" found))))))
243
224(provide 'netrc) 244(provide 'netrc)
225 245
226;;; netrc.el ends here 246;;; netrc.el ends here
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 9af6057c20c..093892a1100 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -774,42 +774,64 @@ If SILENT is non-nil, do not print the message in any irc buffer."
774 (setq rcirc-input-ring-index (1- rcirc-input-ring-index)) 774 (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
775 (insert (rcirc-prev-input-string -1)))) 775 (insert (rcirc-prev-input-string -1))))
776 776
777(defvar rcirc-nick-completions nil) 777(defvar rcirc-server-commands
778(defvar rcirc-nick-completion-start-offset nil) 778 '("/admin" "/away" "/connect" "/die" "/error" "/info"
779 779 "/invite" "/ison" "/join" "/kick" "/kill" "/links"
780(defun rcirc-complete-nick () 780 "/list" "/lusers" "/mode" "/motd" "/names" "/nick"
781 "Cycle through nick completions from list of nicks in channel." 781 "/notice" "/oper" "/part" "/pass" "/ping" "/pong"
782 "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist"
783 "/server" "/squery" "/squit" "/stats" "/summon" "/time"
784 "/topic" "/trace" "/user" "/userhost" "/users" "/version"
785 "/wallops" "/who" "/whois" "/whowas")
786 "A list of user commands by IRC server.
787The value defaults to RFCs 1459 and 2812.")
788
789;; /me and /ctcp are not defined by `defun-rcirc-command'.
790(defvar rcirc-client-commands '("/me" "/ctcp")
791 "A list of user commands defined by IRC client rcirc.
792The list is updated automatically by `defun-rcirc-command'.")
793
794(defun rcirc-completion-at-point ()
795 "Function used for `completion-at-point-functions' in `rcirc-mode'."
796 (let* ((beg (save-excursion
797 (if (re-search-backward " " rcirc-prompt-end-marker t)
798 (1+ (point))
799 rcirc-prompt-end-marker)))
800 (table (if (and (= beg rcirc-prompt-end-marker)
801 (eq (char-after beg) ?/))
802 (delete-dups
803 (nconc
804 (sort (copy-sequence rcirc-client-commands) 'string-lessp)
805 (sort (copy-sequence rcirc-server-commands) 'string-lessp)))
806 (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target))))
807 (list beg (point) table)))
808
809(defvar rcirc-completions nil)
810(defvar rcirc-completion-start nil)
811
812(defun rcirc-complete ()
813 "Cycle through completions from list of nicks in channel or IRC commands.
814IRC command completion is performed only if '/' is the first input char."
782 (interactive) 815 (interactive)
783 (if (eq last-command this-command) 816 (if (eq last-command this-command)
784 (setq rcirc-nick-completions 817 (setq rcirc-completions
785 (append (cdr rcirc-nick-completions) 818 (append (cdr rcirc-completions) (list (car rcirc-completions))))
786 (list (car rcirc-nick-completions)))) 819 (let ((completion-ignore-case t)
787 (setq rcirc-nick-completion-start-offset 820 (table (rcirc-completion-at-point)))
788 (- (save-excursion 821 (setq rcirc-completion-start (car table))
789 (if (re-search-backward " " rcirc-prompt-end-marker t) 822 (setq rcirc-completions
790 (1+ (point)) 823 (all-completions (buffer-substring rcirc-completion-start
791 rcirc-prompt-end-marker)) 824 (cadr table))
792 rcirc-prompt-end-marker)) 825 (nth 2 table)))))
793 (setq rcirc-nick-completions 826 (let ((completion (car rcirc-completions)))
794 (let ((completion-ignore-case t))
795 (all-completions
796 (buffer-substring
797 (+ rcirc-prompt-end-marker
798 rcirc-nick-completion-start-offset)
799 (point))
800 (mapcar (lambda (x) (cons x nil))
801 (rcirc-channel-nicks (rcirc-buffer-process)
802 rcirc-target))))))
803 (let ((completion (car rcirc-nick-completions)))
804 (when completion 827 (when completion
805 (delete-region (+ rcirc-prompt-end-marker 828 (delete-region rcirc-completion-start (point))
806 rcirc-nick-completion-start-offset) 829 (insert
807 (point)) 830 (concat completion
808 (insert (concat completion 831 (cond
809 (if (= (+ rcirc-prompt-end-marker 832 ((= (aref completion 0) ?/) " ")
810 rcirc-nick-completion-start-offset) 833 ((= rcirc-completion-start rcirc-prompt-end-marker) ": ")
811 rcirc-prompt-end-marker) 834 (t "")))))))
812 ": "))))))
813 835
814(defun set-rcirc-decode-coding-system (coding-system) 836(defun set-rcirc-decode-coding-system (coding-system)
815 "Set the decode coding system used in this channel." 837 "Set the decode coding system used in this channel."
@@ -827,7 +849,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
827(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) 849(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
828(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) 850(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
829(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) 851(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
830(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick) 852(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete)
831(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) 853(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
832(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) 854(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
833(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) 855(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
@@ -948,6 +970,9 @@ This number is independent of the number of lines in the buffer.")
948 rcirc-buffer-alist)))) 970 rcirc-buffer-alist))))
949 (rcirc-update-short-buffer-names)) 971 (rcirc-update-short-buffer-names))
950 972
973 (add-hook 'completion-at-point-functions
974 'rcirc-completion-at-point nil 'local)
975
951 (run-hooks 'rcirc-mode-hook)) 976 (run-hooks 'rcirc-mode-hook))
952 977
953(defun rcirc-update-prompt (&optional all) 978(defun rcirc-update-prompt (&optional all)
@@ -2004,16 +2029,18 @@ activity. Only run if the buffer is not visible and
2004;; containing the text following the /cmd. 2029;; containing the text following the /cmd.
2005 2030
2006(defmacro defun-rcirc-command (command argument docstring interactive-form 2031(defmacro defun-rcirc-command (command argument docstring interactive-form
2007 &rest body) 2032 &rest body)
2008 "Define a command." 2033 "Define a command."
2009 `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) 2034 `(progn
2010 (,@argument &optional process target) 2035 (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
2011 ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" 2036 (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
2012 "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") 2037 (,@argument &optional process target)
2013 ,interactive-form 2038 ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
2014 (let ((process (or process (rcirc-buffer-process))) 2039 "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
2015 (target (or target rcirc-target))) 2040 ,interactive-form
2016 ,@body))) 2041 (let ((process (or process (rcirc-buffer-process)))
2042 (target (or target rcirc-target)))
2043 ,@body))))
2017 2044
2018(defun-rcirc-command msg (message) 2045(defun-rcirc-command msg (message)
2019 "Send private MESSAGE to TARGET." 2046 "Send private MESSAGE to TARGET."
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 9c8ab4cb017..5745546e3e8 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -50,24 +50,12 @@
50 50
51;;; Code: 51;;; Code:
52 52
53;; Pacify byte-compiler. 53(require 'tramp)
54(eval-when-compile 54(autoload 'time-stamp-string "time-stamp")
55 (require 'cl)
56 (autoload 'tramp-message "tramp")
57 (autoload 'tramp-tramp-file-p "tramp")
58 ;; We cannot autoload macro `with-parsed-tramp-file-name', it
59 ;; results in problems of byte-compiled code.
60 (autoload 'tramp-dissect-file-name "tramp")
61 (autoload 'tramp-file-name-method "tramp")
62 (autoload 'tramp-file-name-user "tramp")
63 (autoload 'tramp-file-name-host "tramp")
64 (autoload 'tramp-file-name-localname "tramp")
65 (autoload 'tramp-run-real-handler "tramp")
66 (autoload 'tramp-time-less-p "tramp")
67 (autoload 'time-stamp-string "time-stamp"))
68 55
69;;; -- Cache -- 56;;; -- Cache --
70 57
58;;;###tramp-autoload
71(defvar tramp-cache-data (make-hash-table :test 'equal) 59(defvar tramp-cache-data (make-hash-table :test 'equal)
72 "Hash table for remote files properties.") 60 "Hash table for remote files properties.")
73 61
@@ -103,6 +91,7 @@ time.")
103(defvar tramp-cache-data-changed nil 91(defvar tramp-cache-data-changed nil
104 "Whether persistent cache data have been changed.") 92 "Whether persistent cache data have been changed.")
105 93
94;;;###tramp-autoload
106(defun tramp-get-file-property (vec file property default) 95(defun tramp-get-file-property (vec file property default)
107 "Get the PROPERTY of FILE from the cache context of VEC. 96 "Get the PROPERTY of FILE from the cache context of VEC.
108Returns DEFAULT if not set." 97Returns DEFAULT if not set."
@@ -130,6 +119,7 @@ Returns DEFAULT if not set."
130 (tramp-message vec 8 "%s %s %s" file property value) 119 (tramp-message vec 8 "%s %s %s" file property value)
131 value)) 120 value))
132 121
122;;;###tramp-autoload
133(defun tramp-set-file-property (vec file property value) 123(defun tramp-set-file-property (vec file property value)
134 "Set the PROPERTY of FILE to VALUE, in the cache context of VEC. 124 "Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
135Returns VALUE." 125Returns VALUE."
@@ -144,6 +134,28 @@ Returns VALUE."
144 (tramp-message vec 8 "%s %s %s" file property value) 134 (tramp-message vec 8 "%s %s %s" file property value)
145 value)) 135 value))
146 136
137;;;###tramp-autoload
138(defmacro with-file-property (vec file property &rest body)
139 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
140FILE must be a local file name on a connection identified via VEC."
141 `(if (file-name-absolute-p ,file)
142 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
143 (when (eq value 'undef)
144 ;; We cannot pass @body as parameter to
145 ;; `tramp-set-file-property' because it mangles our
146 ;; debug messages.
147 (setq value (progn ,@body))
148 (tramp-set-file-property ,vec ,file ,property value))
149 value)
150 ,@body))
151
152;;;###tramp-autoload
153(put 'with-file-property 'lisp-indent-function 3)
154(put 'with-file-property 'edebug-form-spec t)
155(tramp-compat-font-lock-add-keywords
156 'emacs-lisp-mode '("\\<with-file-property\\>"))
157
158;;;###tramp-autoload
147(defun tramp-flush-file-property (vec file) 159(defun tramp-flush-file-property (vec file)
148 "Remove all properties of FILE in the cache context of VEC." 160 "Remove all properties of FILE in the cache context of VEC."
149 ;; Unify localname. 161 ;; Unify localname.
@@ -152,6 +164,7 @@ Returns VALUE."
152 (tramp-message vec 8 "%s" file) 164 (tramp-message vec 8 "%s" file)
153 (remhash vec tramp-cache-data)) 165 (remhash vec tramp-cache-data))
154 166
167;;;###tramp-autoload
155(defun tramp-flush-directory-property (vec directory) 168(defun tramp-flush-directory-property (vec directory)
156 "Remove all properties of DIRECTORY in the cache context of VEC. 169 "Remove all properties of DIRECTORY in the cache context of VEC.
157Remove also properties of all files in subdirectories." 170Remove also properties of all files in subdirectories."
@@ -175,8 +188,7 @@ Remove also properties of all files in subdirectories."
175 (buffer-file-name) 188 (buffer-file-name)
176 default-directory))) 189 default-directory)))
177 (when (tramp-tramp-file-p bfn) 190 (when (tramp-tramp-file-p bfn)
178 (let* ((v (tramp-dissect-file-name bfn)) 191 (with-parsed-tramp-file-name bfn nil
179 (localname (tramp-file-name-localname v)))
180 (tramp-flush-file-property v localname))))) 192 (tramp-flush-file-property v localname)))))
181 193
182(add-hook 'before-revert-hook 'tramp-flush-file-function) 194(add-hook 'before-revert-hook 'tramp-flush-file-function)
@@ -193,6 +205,7 @@ Remove also properties of all files in subdirectories."
193 205
194;;; -- Properties -- 206;;; -- Properties --
195 207
208;;;###tramp-autoload
196(defun tramp-get-connection-property (key property default) 209(defun tramp-get-connection-property (key property default)
197 "Get the named PROPERTY for the connection. 210 "Get the named PROPERTY for the connection.
198KEY identifies the connection, it is either a process or a vector. 211KEY identifies the connection, it is either a process or a vector.
@@ -209,6 +222,7 @@ If the value is not set for the connection, returns DEFAULT."
209 (tramp-message key 7 "%s %s" property value) 222 (tramp-message key 7 "%s %s" property value)
210 value)) 223 value))
211 224
225;;;###tramp-autoload
212(defun tramp-set-connection-property (key property value) 226(defun tramp-set-connection-property (key property value)
213 "Set the named PROPERTY of a connection to VALUE. 227 "Set the named PROPERTY of a connection to VALUE.
214KEY identifies the connection, it is either a process or a vector. 228KEY identifies the connection, it is either a process or a vector.
@@ -223,14 +237,28 @@ PROPERTY is set persistent when KEY is a vector."
223 tramp-cache-data)))) 237 tramp-cache-data))))
224 (puthash property value hash) 238 (puthash property value hash)
225 (setq tramp-cache-data-changed t) 239 (setq tramp-cache-data-changed t)
226 ;; This function is called also during initialization of 240 (tramp-message key 7 "%s %s" property value)
227 ;; tramp-cache.el. `tramp-message´ is not defined yet at this 241 value))
228 ;; time, so we ignore the corresponding error. 242
229 (condition-case nil 243;;;###tramp-autoload
230 (tramp-message key 7 "%s %s" property value) 244(defmacro with-connection-property (key property &rest body)
231 (error nil)) 245 "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
246 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
247 (when (eq value 'undef)
248 ;; We cannot pass ,@body as parameter to
249 ;; `tramp-set-connection-property' because it mangles our debug
250 ;; messages.
251 (setq value (progn ,@body))
252 (tramp-set-connection-property ,key ,property value))
232 value)) 253 value))
233 254
255;;;###tramp-autoload
256(put 'with-connection-property 'lisp-indent-function 2)
257(put 'with-connection-property 'edebug-form-spec t)
258(tramp-compat-font-lock-add-keywords
259 'emacs-lisp-mode '("\\<with-connection-property\\>"))
260
261;;;###tramp-autoload
234(defun tramp-flush-connection-property (key) 262(defun tramp-flush-connection-property (key)
235 "Remove all properties identified by KEY. 263 "Remove all properties identified by KEY.
236KEY identifies the connection, it is either a process or a vector." 264KEY identifies the connection, it is either a process or a vector."
@@ -251,6 +279,7 @@ KEY identifies the connection, it is either a process or a vector."
251 (setq tramp-cache-data-changed t) 279 (setq tramp-cache-data-changed t)
252 (remhash key tramp-cache-data)) 280 (remhash key tramp-cache-data))
253 281
282;;;###tramp-autoload
254(defun tramp-cache-print (table) 283(defun tramp-cache-print (table)
255 "Print hash table TABLE." 284 "Print hash table TABLE."
256 (when (hash-table-p table) 285 (when (hash-table-p table)
@@ -271,6 +300,7 @@ KEY identifies the connection, it is either a process or a vector."
271 table) 300 table)
272 result))) 301 result)))
273 302
303;;;###tramp-autoload
274(defun tramp-list-connections () 304(defun tramp-list-connections ()
275 "Return a list of all known connection vectors according to `tramp-cache'." 305 "Return a list of all known connection vectors according to `tramp-cache'."
276 (let (result) 306 (let (result)
@@ -284,41 +314,40 @@ KEY identifies the connection, it is either a process or a vector."
284(defun tramp-dump-connection-properties () 314(defun tramp-dump-connection-properties ()
285 "Write persistent connection properties into file `tramp-persistency-file-name'." 315 "Write persistent connection properties into file `tramp-persistency-file-name'."
286 ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed. 316 ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
287 (condition-case nil 317 (ignore-errors
288 (when (and (hash-table-p tramp-cache-data) 318 (when (and (hash-table-p tramp-cache-data)
289 (not (zerop (hash-table-count tramp-cache-data))) 319 (not (zerop (hash-table-count tramp-cache-data)))
290 tramp-cache-data-changed 320 tramp-cache-data-changed
291 (stringp tramp-persistency-file-name)) 321 (stringp tramp-persistency-file-name))
292 (let ((cache (copy-hash-table tramp-cache-data))) 322 (let ((cache (copy-hash-table tramp-cache-data)))
293 ;; Remove temporary data. 323 ;; Remove temporary data.
294 (maphash 324 (maphash
295 '(lambda (key value) 325 '(lambda (key value)
296 (if (and (vectorp key) (not (tramp-file-name-localname key))) 326 (if (and (vectorp key) (not (tramp-file-name-localname key)))
297 (progn 327 (progn
298 (remhash "process-name" value) 328 (remhash "process-name" value)
299 (remhash "process-buffer" value) 329 (remhash "process-buffer" value)
300 (remhash "first-password-request" value)) 330 (remhash "first-password-request" value))
301 (remhash key cache))) 331 (remhash key cache)))
302 cache) 332 cache)
303 ;; Dump it. 333 ;; Dump it.
304 (with-temp-buffer 334 (with-temp-buffer
305 (insert 335 (insert
306 ";; -*- emacs-lisp -*-" 336 ";; -*- emacs-lisp -*-"
307 ;; `time-stamp-string' might not exist in all (X)Emacs flavors. 337 ;; `time-stamp-string' might not exist in all (X)Emacs flavors.
308 (condition-case nil 338 (condition-case nil
309 (progn 339 (progn
310 (format 340 (format
311 " <%s %s>\n" 341 " <%s %s>\n"
312 (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") 342 (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
313 tramp-persistency-file-name)) 343 tramp-persistency-file-name))
314 (error "\n")) 344 (error "\n"))
315 ";; Tramp connection history. Don't change this file.\n" 345 ";; Tramp connection history. Don't change this file.\n"
316 ";; You can delete it, forcing Tramp to reapply the checks.\n\n" 346 ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
317 (with-output-to-string 347 (with-output-to-string
318 (pp (read (format "(%s)" (tramp-cache-print cache)))))) 348 (pp (read (format "(%s)" (tramp-cache-print cache))))))
319 (write-region 349 (write-region
320 (point-min) (point-max) tramp-persistency-file-name)))) 350 (point-min) (point-max) tramp-persistency-file-name))))))
321 (error nil)))
322 351
323(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties) 352(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
324(add-hook 'tramp-cache-unload-hook 353(add-hook 'tramp-cache-unload-hook
@@ -326,6 +355,7 @@ KEY identifies the connection, it is either a process or a vector."
326 (remove-hook 'kill-emacs-hook 355 (remove-hook 'kill-emacs-hook
327 'tramp-dump-connection-properties))) 356 'tramp-dump-connection-properties)))
328 357
358;;;###tramp-autoload
329(defun tramp-parse-connection-properties (method) 359(defun tramp-parse-connection-properties (method)
330 "Return a list of (user host) tuples allowed to access for METHOD. 360 "Return a list of (user host) tuples allowed to access for METHOD.
331This function is added always in `tramp-get-completion-function' 361This function is added always in `tramp-get-completion-function'
@@ -364,6 +394,10 @@ for all methods. Resulting data are derived from connection history."
364 tramp-persistency-file-name (error-message-string err)) 394 tramp-persistency-file-name (error-message-string err))
365 (clrhash tramp-cache-data)))) 395 (clrhash tramp-cache-data))))
366 396
397(add-hook 'tramp-unload-hook
398 (lambda ()
399 (unload-feature 'tramp-cache 'force)))
400
367(provide 'tramp-cache) 401(provide 'tramp-cache)
368 402
369;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26 403;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index c3243083695..32cbb16b9e8 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -129,6 +129,7 @@ This includes password cache, file cache, connection cache, buffers."
129 129
130;; Tramp version is useful in a number of situations. 130;; Tramp version is useful in a number of situations.
131 131
132;;;###tramp-autoload
132(defun tramp-version (arg) 133(defun tramp-version (arg)
133 "Print version number of tramp.el in minibuffer or current buffer." 134 "Print version number of tramp.el in minibuffer or current buffer."
134 (interactive "P") 135 (interactive "P")
@@ -387,6 +388,9 @@ please ensure that the buffers are attached to your email.\n\n")
387 388
388(defalias 'tramp-submit-bug 'tramp-bug) 389(defalias 'tramp-submit-bug 'tramp-bug)
389 390
391(add-hook 'tramp-unload-hook
392 (lambda () (unload-feature 'tramp-cmds 'force)))
393
390(provide 'tramp-cmds) 394(provide 'tramp-cmds)
391 395
392;;; TODO: 396;;; TODO:
@@ -395,7 +399,7 @@ please ensure that the buffers are attached to your email.\n\n")
395;; * WIBNI there was an interactive command prompting for Tramp 399;; * WIBNI there was an interactive command prompting for Tramp
396;; method, hostname, username and filename and translates the user 400;; method, hostname, username and filename and translates the user
397;; input into the correct filename syntax (depending on the Emacs 401;; input into the correct filename syntax (depending on the Emacs
398;; flavor) (Reiner Steib) 402;; flavor) (Reiner Steib)
399;; * Let the user edit the connection properties interactively. 403;; * Let the user edit the connection properties interactively.
400;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. 404;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
401;; * It's just that when I come to Customize `tramp-default-user-alist' 405;; * It's just that when I come to Customize `tramp-default-user-alist'
@@ -404,7 +408,7 @@ please ensure that the buffers are attached to your email.\n\n")
404;; Option and should not be modified by the code. add-to-list is 408;; Option and should not be modified by the code. add-to-list is
405;; called in several places. One way to handle that is to have a new 409;; called in several places. One way to handle that is to have a new
406;; ordinary variable that gets its initial value from 410;; ordinary variable that gets its initial value from
407;; tramp-default-user-alist and then is added to. (Pete Forman) 411;; tramp-default-user-alist and then is added to. (Pete Forman)
408 412
409;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c 413;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c
410;;; tramp-cmds.el ends here 414;;; tramp-cmds.el ends here
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 92ad7811189..4da2fb33771 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -29,6 +29,8 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(require 'tramp-loaddefs)
33
32(eval-when-compile 34(eval-when-compile
33 35
34 ;; Pacify byte-compiler. 36 ;; Pacify byte-compiler.
@@ -36,40 +38,41 @@
36 38
37(eval-and-compile 39(eval-and-compile
38 40
41 (require 'advice)
39 (require 'custom) 42 (require 'custom)
43 (require 'format-spec)
44
45 ;; As long as password.el is not part of (X)Emacs, it shouldn't be
46 ;; mandatory.
47 (if (featurep 'xemacs)
48 (load "password" 'noerror)
49 (or (require 'password-cache nil 'noerror)
50 (require 'password nil 'noerror))) ; Part of contrib.
51
52 ;; auth-source is relatively new.
53 (if (featurep 'xemacs)
54 (load "auth-source" 'noerror)
55 (require 'auth-source nil 'noerror))
40 56
41 ;; Load the appropriate timer package. 57 ;; Load the appropriate timer package.
42 (if (featurep 'xemacs) 58 (if (featurep 'xemacs)
43 (require 'timer-funcs) 59 (require 'timer-funcs)
44 (require 'timer)) 60 (require 'timer))
45 61
46 (autoload 'tramp-tramp-file-p "tramp")
47 (autoload 'tramp-file-name-handler "tramp")
48
49 ;; We check whether `start-file-process' is bound. 62 ;; We check whether `start-file-process' is bound.
50 (unless (fboundp 'start-file-process) 63 (unless (fboundp 'start-file-process)
51 64
52 ;; tramp-util offers integration into other (X)Emacs packages like 65 ;; tramp-util offers integration into other (X)Emacs packages like
53 ;; compile.el, gud.el etc. Not necessary in Emacs 23. 66 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
54 (eval-after-load "tramp" 67 (eval-after-load "tramp"
55 '(progn 68 '(require 'tramp-util))
56 (require 'tramp-util)
57 (add-hook 'tramp-unload-hook
58 '(lambda ()
59 (when (featurep 'tramp-util)
60 (unload-feature 'tramp-util 'force))))))
61 69
62 ;; Make sure that we get integration with the VC package. When it 70 ;; Make sure that we get integration with the VC package. When it
63 ;; is loaded, we need to pull in the integration module. Not 71 ;; is loaded, we need to pull in the integration module. Not
64 ;; necessary in Emacs 23. 72 ;; necessary in Emacs 23.
65 (eval-after-load "vc" 73 (eval-after-load "vc"
66 (eval-after-load "tramp" 74 (eval-after-load "tramp"
67 '(progn 75 '(require 'tramp-vc))))
68 (require 'tramp-vc)
69 (add-hook 'tramp-unload-hook
70 '(lambda ()
71 (when (featurep 'tramp-vc)
72 (unload-feature 'tramp-vc 'force))))))))
73 76
74 ;; Avoid byte-compiler warnings if the byte-compiler supports this. 77 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
75 ;; Currently, XEmacs supports this. 78 ;; Currently, XEmacs supports this.
@@ -93,11 +96,6 @@
93 (defvar byte-compile-not-obsolete-vars nil)) 96 (defvar byte-compile-not-obsolete-vars nil))
94 (setq byte-compile-not-obsolete-vars '(directory-sep-char)) 97 (setq byte-compile-not-obsolete-vars '(directory-sep-char))
95 98
96 ;; `with-temp-message' does not exists in XEmacs.
97 (condition-case nil
98 (with-temp-message (current-message) nil)
99 (error (defmacro with-temp-message (message &rest body) `(progn ,@body))))
100
101 ;; For not existing functions, or functions with a changed argument 99 ;; For not existing functions, or functions with a changed argument
102 ;; list, there are compiler warnings. We want to avoid them in 100 ;; list, there are compiler warnings. We want to avoid them in
103 ;; cases we know what we do. 101 ;; cases we know what we do.
@@ -111,10 +109,6 @@
111 (unless (fboundp 'set-buffer-multibyte) 109 (unless (fboundp 'set-buffer-multibyte)
112 (defalias 'set-buffer-multibyte 'ignore)) 110 (defalias 'set-buffer-multibyte 'ignore))
113 111
114 ;; `font-lock-add-keywords' does not exist in XEmacs.
115 (unless (fboundp 'font-lock-add-keywords)
116 (defalias 'font-lock-add-keywords 'ignore))
117
118 ;; The following functions cannot be aliases of the corresponding 112 ;; The following functions cannot be aliases of the corresponding
119 ;; `tramp-handle-*' functions, because this would bypass the locking 113 ;; `tramp-handle-*' functions, because this would bypass the locking
120 ;; mechanism. 114 ;; mechanism.
@@ -187,6 +181,19 @@
187 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) 181 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
188 (ad-activate 'file-expand-wildcards))))) 182 (ad-activate 'file-expand-wildcards)))))
189 183
184;; `with-temp-message' does not exists in XEmacs.
185(if (fboundp 'with-temp-message)
186 (defalias 'tramp-compat-with-temp-message 'with-temp-message)
187 (defun tramp-compat-with-temp-message (message &rest body)
188 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
189 `(progn ,@body)))
190
191;; `font-lock-add-keywords' does not exist in XEmacs.
192(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
193 "Add highlighting KEYWORDS for MODE."
194 (ignore-errors
195 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how)))
196
190(defsubst tramp-compat-line-beginning-position () 197(defsubst tramp-compat-line-beginning-position ()
191 "Return point at beginning of line (compat function). 198 "Return point at beginning of line (compat function).
192Calls `line-beginning-position' or `point-at-bol' if defined, else 199Calls `line-beginning-position' or `point-at-bol' if defined, else
@@ -263,6 +270,24 @@ Add the extension of FILENAME, if existing."
263 ;; Default value in XEmacs. 270 ;; Default value in XEmacs.
264 (t 134217727))) 271 (t 134217727)))
265 272
273(defun tramp-compat-decimal-to-octal (i)
274 "Return a string consisting of the octal digits of I.
275Not actually used. Use `(format \"%o\" i)' instead?"
276 (cond ((< i 0) (error "Cannot convert negative number to octal"))
277 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
278 ((zerop i) "0")
279 (t (concat (tramp-compat-decimal-to-octal (/ i 8))
280 (number-to-string (% i 8))))))
281
282;; Kudos to Gerd Moellmann for this suggestion.
283(defun tramp-compat-octal-to-decimal (ostr)
284 "Given a string of octal digits, return a decimal number."
285 (let ((x (or ostr "")))
286 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
287 (unless (string-match "\\`[0-7]*\\'" x)
288 (error "Non-octal junk in string `%s'" x))
289 (string-to-number ostr 8)))
290
266;; ID-FORMAT does not exists in XEmacs. 291;; ID-FORMAT does not exists in XEmacs.
267(defun tramp-compat-file-attributes (filename &optional id-format) 292(defun tramp-compat-file-attributes (filename &optional id-format)
268 "Like `file-attributes' for Tramp files (compat function)." 293 "Like `file-attributes' for Tramp files (compat function)."
@@ -397,6 +422,20 @@ This is, the first, empty, element is omitted. In XEmacs, the first
397element is not omitted." 422element is not omitted."
398 (delete "" (split-string string pattern))) 423 (delete "" (split-string string pattern)))
399 424
425(defun tramp-compat-call-process
426 (program &optional infile destination display &rest args)
427 "Calls `call-process' on the local host.
428This is needed because for some Emacs flavors Tramp has
429defadviced `call-process' to behave like `process-file'. The
430Lisp error raised when PROGRAM is nil is trapped also, returning 1."
431 (let ((default-directory
432 (if (file-remote-p default-directory)
433 (tramp-compat-temporary-file-directory)
434 default-directory)))
435 (if (executable-find program)
436 (apply 'call-process program infile destination display args)
437 1)))
438
400(defun tramp-compat-process-running-p (process-name) 439(defun tramp-compat-process-running-p (process-name)
401 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." 440 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
402 (when (stringp process-name) 441 (when (stringp process-name)
@@ -439,6 +478,22 @@ element is not omitted."
439 (setenv "UNIX95" unix95) 478 (setenv "UNIX95" unix95)
440 result))))) 479 result)))))
441 480
481;; The following functions do not exist in XEmacs. We ignore this;
482;; they are used for checking a remote tty.
483(defun tramp-compat-process-get (process propname)
484 "Return the value of PROCESS' PROPNAME property.
485This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
486 (ignore-errors (tramp-compat-funcall 'process-get process propname)))
487
488(defun tramp-compat-process-put (process propname value)
489 "Change PROCESS' PROPNAME property to VALUE.
490It can be retrieved with `(process-get PROCESS PROPNAME)'."
491 (ignore-errors (tramp-compat-funcall 'process-put process propname value)))
492
493(add-hook 'tramp-unload-hook
494 (lambda ()
495 (unload-feature 'tramp-compat 'force)))
496
442(provide 'tramp-compat) 497(provide 'tramp-compat)
443 498
444;;; TODO: 499;;; TODO:
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el
deleted file mode 100644
index 81dea724dd6..00000000000
--- a/lisp/net/tramp-fish.el
+++ /dev/null
@@ -1,1181 +0,0 @@
1;;; tramp-fish.el --- Tramp access functions for FISH protocol
2
3;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4
5;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes
7;; Package: tramp
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Access functions for FIles transferred over SHell protocol from Tramp.
27
28;; FISH is a protocol developped for the GNU Midnight Commander
29;; <https://savannah.gnu.org/projects/mc>. A client connects to a
30;; remote host via ssh (or rsh, shall be configurable), and starts
31;; there a fish server via the command "start_fish_server". All
32;; commands from the client have the form "#FISH_COMMAND\n" (always
33;; one line), followed by equivalent shell commands in case there is
34;; no fish server running.
35
36;; The fish server (or the equivalent shell commands) must return the
37;; response, which is finished by a line "### xxx <optional text>\n".
38;; "xxx" stands for 3 digits, representing a return code. Return
39;; codes "# 000" and "# 001" are reserved for fallback implementation
40;; with native shell commands; they are not used inside the server. See
41;; <http://cvs.savannah.gnu.org/viewcvs/mc/vfs/README.fish?root=mc&view=markup>
42;; for details of original specification.
43
44;; The GNU Midnight Commander implements the original fish protocol
45;; version 0.0.2. The KDE Konqueror has its own implementation, which
46;; can be found at
47;; <http://websvn.kde.org/branches/KDE/3.5/kdebase/kioslave/fish>. It
48;; implements an extended protocol version 0.0.3. Additionally, it
49;; provides a fish server implementation in Perl (which is the only
50;; implementation I've heard of). The following command reference is
51;; based on that implementation.
52
53;; All commands return either "### 2xx\n" (OK) or "### 5xx <optional text>\n"
54;; (NOK). Return codes are mentioned only if they are different from this.
55;; Spaces in any parameter must be escaped by "\ ".
56
57;; Command/Return Code Comment
58;;
59;; #FISH initial connection, not used
60;; in .fishsrv.pl
61;; ### 100 transfer fish server missing server, or wrong checksum
62;; version 0.0.3 only
63
64;; #VER a.b.c <commands requested>
65;; VER x.y.z <commands offered> .fishsrv.pl response is not uptodate
66
67;; #PWD
68;; /path/to/file
69
70;; #CWD /some/path
71
72;; #COPY /path/a /path/b version 0.0.3 only
73
74;; #RENAME /path/a /path/b
75
76;; #SYMLINK /path/a /path/b
77
78;; #LINK /path/a /path/b
79
80;; #DELE /some/path
81
82;; #MKD /some/path
83
84;; #RMD /some/path
85
86;; #CHOWN user /file/name
87
88;; #CHGRP group /file/name
89
90;; #CHMOD 1234 file
91
92;; #READ <offset> <size> /path/and/filename
93;; ### 291 successful exit when reading
94;; ended at eof
95;; ### 292 successful exit when reading
96;; did not end at eof
97
98;; #WRITE <offset> <size> /path/and/filename
99
100;; #APPEND <size> /path/and/filename version 0.0.3 only
101
102;; #LIST /directory
103;; <number of entries> version 0.0.3 only
104;; ### 100 version 0.0.3 only
105;; P<unix permissions> <owner>.<group>
106;; S<size>
107;; d<3-letters month name> <day> <year or HH:MM>
108;; D<year> <month> <day> <hour> <minute> <second>[.1234]
109;; E<major-of-device>,<minor>
110;; :<filename>
111;; L<filename symlink points to>
112;; M<mimetype> version 0.0.3 only
113;; <blank line to separate items>
114
115;; #STAT /file version 0.0.3 only
116;; like #LIST except for directories
117;; <number of entries>
118;; ### 100
119;; P<unix permissions> <owner>.<group>
120;; S<size>
121;; d<3-letters month name> <day> <year or HH:MM>
122;; D<year> <month> <day> <hour> <minute> <second>[.1234]
123;; E<major-of-device>,<minor>
124;; :<filename>
125;; L<filename symlink points to>
126;; <blank line to separate items>
127
128;; #RETR /some/name
129;; <filesize>
130;; ### 100
131;; <binary data> exactly filesize bytes
132;; ### 200 with no preceding newline
133
134;; #STOR <size> /file/name
135;; ### 100
136;; <data> exactly size bytes
137;; ### 001 partial success
138
139;; #EXEC <command> <tmpfile> version 0.0.3 only
140;; <tmpfile> must not exists. It contains the output of <command>.
141;; It can be retrieved afterwards. Last line is
142;; ###RESULT: <returncode>
143
144;; This implementation is meant as proof of the concept, whether there
145;; is a better performance compared with the native ssh method. It
146;; looks like the file information retrieval is slower, especially the
147;; #LIST command. On the other hand, the file contents transmission
148;; seems to perform better than other inline methods, because there is
149;; no need for data encoding/decoding, and it supports the APPEND
150;; parameter of `write-region'. Transfer of binary data fails due to
151;; Emacs' process input/output handling.
152
153;;; Code:
154
155(eval-when-compile
156 ;; Pacify byte-compiler.
157 (require 'cl))
158
159(require 'tramp)
160(require 'tramp-cache)
161(require 'tramp-compat)
162
163;; Define FISH method ...
164(defcustom tramp-fish-method "fish"
165 "*Method to connect via FISH protocol."
166 :group 'tramp
167 :type 'string)
168
169;; ... and add it to the method list.
170(add-to-list 'tramp-methods (cons tramp-fish-method nil))
171
172;; Add a default for `tramp-default-user-alist'. Default is the local user.
173(add-to-list 'tramp-default-user-alist
174 `(,tramp-fish-method nil ,(user-login-name)))
175
176;; Add completion function for FISH method.
177(tramp-set-completion-function
178 tramp-fish-method tramp-completion-function-alist-ssh)
179
180(defconst tramp-fish-continue-prompt-regexp "^### 100.*\n"
181 "FISH return code OK.")
182
183;; It cannot be a defconst, occasionally we bind it locally.
184(defvar tramp-fish-ok-prompt-regexp "^### 200\n"
185 "FISH return code OK.")
186
187(defconst tramp-fish-error-prompt-regexp "^### \\(4\\|5\\)[0-9]+.*\n"
188 "Regexp for possible error strings of FISH servers.
189Used instead of analyzing error codes of commands.")
190
191(defcustom tramp-fish-start-fish-server-command
192 (concat "stty intr \"\" quit \"\" erase \"\" kill \"\" eof \"\" eol \"\" eol2 \"\" swtch \"\" start \"\" stop \"\" susp \"\" rprnt \"\" werase \"\" lnext \"\" flush \"\"; "
193 "perl .fishsrv.pl "
194 "`grep 'ARGV\\[0\\]' .fishsrv.pl | "
195 "sed -e 's/^[^\"]*\"//' -e 's/\"[^\"]*$//'`; "
196 "exit")
197 "*Command to connect via FISH protocol."
198 :group 'tramp
199 :type 'string)
200
201;; New handlers should be added here.
202(defconst tramp-fish-file-name-handler-alist
203 '(
204 ;; `access-file' performed by default handler
205 (add-name-to-file . tramp-fish-handle-add-name-to-file)
206 ;; `byte-compiler-base-file-name' performed by default handler
207 (copy-file . tramp-fish-handle-copy-file)
208 (delete-directory . tramp-fish-handle-delete-directory)
209 (delete-file . tramp-fish-handle-delete-file)
210 ;; `diff-latest-backup-file' performed by default handler
211 (directory-file-name . tramp-handle-directory-file-name)
212 (directory-files . tramp-handle-directory-files)
213 (directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes)
214 ;; `dired-call-process' performed by default handler
215 ;; `dired-compress-file' performed by default handler
216 (dired-uncache . tramp-handle-dired-uncache)
217 (expand-file-name . tramp-fish-handle-expand-file-name)
218 ;; `file-accessible-directory-p' performed by default handler
219 (file-attributes . tramp-fish-handle-file-attributes)
220 (file-directory-p . tramp-fish-handle-file-directory-p)
221 (file-executable-p . tramp-fish-handle-file-executable-p)
222 (file-exists-p . tramp-fish-handle-file-exists-p)
223 (file-local-copy . tramp-fish-handle-file-local-copy)
224 (file-modes . tramp-handle-file-modes)
225 (file-name-all-completions . tramp-fish-handle-file-name-all-completions)
226 (file-name-as-directory . tramp-handle-file-name-as-directory)
227 (file-name-completion . tramp-handle-file-name-completion)
228 (file-name-directory . tramp-handle-file-name-directory)
229 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
230 ;; `file-name-sans-versions' performed by default handler
231 (file-newer-than-file-p . tramp-fish-handle-file-newer-than-file-p)
232 (file-ownership-preserved-p . ignore)
233 (file-readable-p . tramp-fish-handle-file-readable-p)
234 (file-regular-p . tramp-handle-file-regular-p)
235 (file-remote-p . tramp-handle-file-remote-p)
236 ;; `file-selinux-context' performed by default handler.
237 (file-symlink-p . tramp-handle-file-symlink-p)
238 ;; `file-truename' performed by default handler
239 (file-writable-p . tramp-fish-handle-file-writable-p)
240 (find-backup-file-name . tramp-handle-find-backup-file-name)
241 ;; `find-file-noselect' performed by default handler
242 ;; `get-file-buffer' performed by default handler
243 (insert-directory . tramp-fish-handle-insert-directory)
244 (insert-file-contents . tramp-fish-handle-insert-file-contents)
245 (load . tramp-handle-load)
246 (make-directory . tramp-fish-handle-make-directory)
247 (make-directory-internal . tramp-fish-handle-make-directory-internal)
248 (make-symbolic-link . tramp-fish-handle-make-symbolic-link)
249 (rename-file . tramp-fish-handle-rename-file)
250 (set-file-modes . tramp-fish-handle-set-file-modes)
251 ;; `set-file-selinux-context' performed by default handler.
252 (set-file-times . tramp-fish-handle-set-file-times)
253 (set-visited-file-modtime . ignore)
254 (shell-command . tramp-handle-shell-command)
255 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
256 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
257 (vc-registered . ignore)
258 (verify-visited-file-modtime . ignore)
259 (write-region . tramp-fish-handle-write-region)
260 (executable-find . tramp-fish-handle-executable-find)
261 (start-file-process . ignore)
262 (process-file . tramp-fish-handle-process-file)
263)
264 "Alist of handler functions for Tramp FISH method.
265Operations not mentioned here will be handled by the default Emacs primitives.")
266
267(defun tramp-fish-file-name-p (filename)
268 "Check if it's a filename for FISH protocol."
269 (let ((v (tramp-dissect-file-name filename)))
270 (string= (tramp-file-name-method v) tramp-fish-method)))
271
272(defun tramp-fish-file-name-handler (operation &rest args)
273 "Invoke the FISH related OPERATION.
274First arg specifies the OPERATION, second arg is a list of arguments to
275pass to the OPERATION."
276 (let ((fn (assoc operation tramp-fish-file-name-handler-alist)))
277 (if fn
278 (save-match-data (apply (cdr fn) args))
279 (tramp-run-real-handler operation args))))
280
281(add-to-list 'tramp-foreign-file-name-handler-alist
282 (cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler))
283
284
285;; File name primitives
286
287(defun tramp-fish-handle-add-name-to-file
288 (filename newname &optional ok-if-already-exists)
289 "Like `add-name-to-file' for Tramp files."
290 (unless (tramp-equal-remote filename newname)
291 (with-parsed-tramp-file-name
292 (if (tramp-tramp-file-p filename) filename newname) nil
293 (tramp-error
294 v 'file-error
295 "add-name-to-file: %s"
296 "only implemented for same method, same user, same host")))
297 (with-parsed-tramp-file-name filename v1
298 (with-parsed-tramp-file-name newname v2
299 (when (and (not ok-if-already-exists)
300 (file-exists-p newname)
301 (not (numberp ok-if-already-exists))
302 (y-or-n-p
303 (format
304 "File %s already exists; make it a new name anyway? "
305 newname)))
306 (tramp-error
307 v2 'file-error
308 "add-name-to-file: file %s already exists" newname))
309 (tramp-flush-file-property v2 v2-localname)
310 (unless (tramp-fish-send-command-and-check
311 v1 (format "#LINK %s %s" v1-localname v2-localname))
312 (tramp-error
313 v1 'file-error "Error with add-name-to-file %s" newname)))))
314
315(defun tramp-fish-handle-copy-file
316 (filename newname &optional ok-if-already-exists keep-date
317 preserve-uid-gid preserve-selinux-context)
318 "Like `copy-file' for Tramp files."
319 (tramp-fish-do-copy-or-rename-file
320 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
321
322(defun tramp-fish-handle-delete-directory (directory &optional recursive)
323 "Like `delete-directory' for Tramp files."
324 (when (file-exists-p directory)
325 (if recursive
326 (mapc
327 (lambda (file)
328 (if (file-directory-p file)
329 (tramp-compat-delete-directory file recursive)
330 (delete-file file)))
331 ;; We do not want to delete "." and "..".
332 (directory-files
333 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
334 (with-parsed-tramp-file-name
335 (directory-file-name (expand-file-name directory)) nil
336 (tramp-flush-directory-property v localname)
337 (tramp-fish-send-command-and-check v (format "#RMD %s" localname)))))
338
339(defun tramp-fish-handle-delete-file (filename &optional trash)
340 "Like `delete-file' for Tramp files."
341 (when (file-exists-p filename)
342 (with-parsed-tramp-file-name (expand-file-name filename) nil
343 (tramp-flush-file-property v localname)
344 (tramp-fish-send-command-and-check v (format "#DELE %s" localname)))))
345
346(defun tramp-fish-handle-directory-files-and-attributes
347 (directory &optional full match nosort id-format)
348 "Like `directory-files-and-attributes' for Tramp files."
349 (mapcar
350 (lambda (x)
351 (cons x
352 (tramp-compat-file-attributes
353 (if full x (expand-file-name x directory))
354 id-format)))
355 (directory-files directory full match nosort)))
356
357(defun tramp-fish-handle-expand-file-name (name &optional dir)
358 "Like `expand-file-name' for Tramp files."
359 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
360 (setq dir (or dir default-directory "/"))
361 ;; Unless NAME is absolute, concat DIR and NAME.
362 (unless (file-name-absolute-p name)
363 (setq name (concat (file-name-as-directory dir) name)))
364 ;; If NAME is not a Tramp file, run the real handler,
365 (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
366 (tramp-drop-volume-letter
367 (tramp-run-real-handler 'expand-file-name (list name nil)))
368 ;; Dissect NAME.
369 (with-parsed-tramp-file-name name nil
370 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
371 (setq localname (concat "~/" localname)))
372 ;; Tilde expansion if necessary.
373 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
374 (let ((uname (match-string 1 localname))
375 (fname (match-string 2 localname)))
376 ;; We cannot apply "~user/", because this is not supported
377 ;; by the FISH protocol.
378 (unless (string-equal uname "~")
379 (tramp-error
380 v 'file-error "Tilde expansion not supported for %s" name))
381 (setq uname
382 (with-connection-property v uname
383 (tramp-fish-send-command-and-check v "#PWD")
384 (with-current-buffer (tramp-get-buffer v)
385 (goto-char (point-min))
386 (buffer-substring (point) (tramp-compat-line-end-position)))))
387 (setq localname (concat uname fname))))
388 ;; There might be a double slash, for example when "~/"
389 ;; expands to "/". Remove this.
390 (while (string-match "//" localname)
391 (setq localname (replace-match "/" t t localname)))
392 ;; No tilde characters in file name, do normal
393 ;; expand-file-name (this does "/./" and "/../"). We bind
394 ;; `directory-sep-char' here for XEmacs on Windows, which
395 ;; would otherwise use backslash. `default-directory' is
396 ;; bound, because on Windows there would be problems with UNC
397 ;; shares or Cygwin mounts.
398 (let ((directory-sep-char ?/)
399 (default-directory (tramp-compat-temporary-file-directory)))
400 (tramp-make-tramp-file-name
401 method user host
402 (tramp-drop-volume-letter
403 (tramp-run-real-handler
404 'expand-file-name (list localname))))))))
405
406(defun tramp-fish-handle-file-attributes (filename &optional id-format)
407 "Like `file-attributes' for Tramp files."
408 (with-parsed-tramp-file-name (expand-file-name filename) nil
409 (with-file-property v localname (format "file-attributes-%s" id-format)
410 (cdr (car (tramp-fish-get-file-entries v localname nil))))))
411
412(defun tramp-fish-handle-file-directory-p (filename)
413 "Like `file-directory-p' for Tramp files."
414 (let ((attributes (file-attributes filename)))
415 (and attributes
416 (or (string-match "d" (nth 8 attributes))
417 (and (file-symlink-p filename)
418 (with-parsed-tramp-file-name filename nil
419 (file-directory-p
420 (tramp-make-tramp-file-name
421 method user host (nth 0 attributes))))))
422 t)))
423
424(defun tramp-fish-handle-file-exists-p (filename)
425 "Like `file-exists-p' for Tramp files."
426 (and (file-attributes filename) t))
427
428(defun tramp-fish-handle-file-executable-p (filename)
429 "Like `file-executable-p' for Tramp files."
430 (with-parsed-tramp-file-name (expand-file-name filename) nil
431 (with-file-property v localname "file-executable-p"
432 (when (file-exists-p filename)
433 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
434 (home-directory
435 (tramp-make-tramp-file-name
436 method user host
437 (tramp-get-connection-property v "home-directory" nil))))
438 (or (and (char-equal (aref mode-chars 3) ?x)
439 (equal (nth 2 (file-attributes filename))
440 (nth 2 (file-attributes home-directory))))
441 (and (char-equal (aref mode-chars 6) ?x)
442 (equal (nth 3 (file-attributes filename))
443 (nth 3 (file-attributes home-directory))))
444 (char-equal (aref mode-chars 9) ?x)))))))
445
446(defun tramp-fish-handle-file-readable-p (filename)
447 "Like `file-readable-p' for Tramp files."
448 (with-parsed-tramp-file-name (expand-file-name filename) nil
449 (with-file-property v localname "file-readable-p"
450 (when (file-exists-p filename)
451 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
452 (home-directory
453 (tramp-make-tramp-file-name
454 method user host
455 (tramp-get-connection-property v "home-directory" nil))))
456 (or (and (char-equal (aref mode-chars 1) ?r)
457 (equal (nth 2 (file-attributes filename))
458 (nth 2 (file-attributes home-directory))))
459 (and (char-equal (aref mode-chars 4) ?r)
460 (equal (nth 3 (file-attributes filename))
461 (nth 3 (file-attributes home-directory))))
462 (char-equal (aref mode-chars 7) ?r)))))))
463
464(defun tramp-fish-handle-file-writable-p (filename)
465 "Like `file-writable-p' for Tramp files."
466 (with-parsed-tramp-file-name (expand-file-name filename) nil
467 (with-file-property v localname "file-writable-p"
468 (if (not (file-exists-p filename))
469 ;; If file doesn't exist, check if directory is writable.
470 (and (file-directory-p (file-name-directory filename))
471 (file-writable-p (file-name-directory filename)))
472 ;; Existing files must be writable.
473 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
474 (home-directory
475 (tramp-make-tramp-file-name
476 method user host
477 (tramp-get-connection-property v "home-directory" nil))))
478 (or (and (char-equal (aref mode-chars 2) ?w)
479 (equal (nth 2 (file-attributes filename))
480 (nth 2 (file-attributes home-directory))))
481 (and (char-equal (aref mode-chars 5) ?w)
482 (equal (nth 3 (file-attributes filename))
483 (nth 3 (file-attributes home-directory))))
484 (char-equal (aref mode-chars 8) ?w)))))))
485
486(defun tramp-fish-handle-file-local-copy (filename)
487 "Like `file-local-copy' for Tramp files."
488 (with-parsed-tramp-file-name (expand-file-name filename) nil
489 (unless (file-exists-p filename)
490 (tramp-error
491 v 'file-error
492 "Cannot make local copy of non-existing file `%s'" filename))
493 (let ((tmpfile (tramp-compat-make-temp-file filename)))
494 (with-progress-reporter
495 v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
496 (when (tramp-fish-retrieve-data v)
497 ;; Save file
498 (with-current-buffer (tramp-get-buffer v)
499 (write-region (point-min) (point-max) tmpfile))
500 tmpfile)))))
501
502;; This function should return "foo/" for directories and "bar" for
503;; files.
504(defun tramp-fish-handle-file-name-all-completions (filename directory)
505 "Like `file-name-all-completions' for Tramp files."
506 (all-completions
507 filename
508 (with-parsed-tramp-file-name (expand-file-name directory) nil
509 (with-file-property v localname "file-name-all-completions"
510 (save-match-data
511 (let ((entries
512 (with-file-property v localname "file-entries"
513 (tramp-fish-get-file-entries v localname t))))
514 (mapcar
515 (lambda (x)
516 (list
517 (if (string-match "d" (nth 9 x))
518 (file-name-as-directory (nth 0 x))
519 (nth 0 x))))
520 entries)))))))
521
522(defun tramp-fish-handle-file-newer-than-file-p (file1 file2)
523 "Like `file-newer-than-file-p' for Tramp files."
524 (cond
525 ((not (file-exists-p file1)) nil)
526 ((not (file-exists-p file2)) t)
527 (t (tramp-time-less-p (nth 5 (file-attributes file2))
528 (nth 5 (file-attributes file1))))))
529
530(defun tramp-fish-handle-insert-directory
531 (filename switches &optional wildcard full-directory-p)
532 "Like `insert-directory' for Tramp files.
533WILDCARD and FULL-DIRECTORY-P are not handled."
534 (setq filename (expand-file-name filename))
535 (when (file-directory-p filename)
536 ;; This check is a little bit strange, but in `dired-add-entry'
537 ;; this function is called with a non-directory ...
538 (setq filename (file-name-as-directory filename)))
539
540 (with-parsed-tramp-file-name filename nil
541 (tramp-flush-file-property v localname)
542 (save-match-data
543 (let ((entries
544 (with-file-property v localname "file-entries"
545 (tramp-fish-get-file-entries v localname t))))
546
547 ;; Sort entries
548 (setq entries
549 (sort
550 entries
551 (lambda (x y)
552 (if (string-match "t" switches)
553 ;; Sort by date.
554 (tramp-time-less-p (nth 6 y) (nth 6 x))
555 ;; Sort by name.
556 (string-lessp (nth 0 x) (nth 0 y))))))
557
558 ;; Print entries.
559 (mapcar
560 (lambda (x)
561 (insert
562 (format
563 "%10s %3d %-8s %-8s %8s %s %s%s\n"
564 (nth 9 x) ; mode
565 1 ; hardlinks
566 (nth 3 x) ; uid
567 (nth 4 x) ; gid
568 (nth 8 x) ; size
569 (format-time-string
570 (if (tramp-time-less-p
571 (tramp-time-subtract (current-time) (nth 6 x))
572 tramp-half-a-year)
573 "%b %e %R"
574 "%b %e %Y")
575 (nth 6 x)) ; date
576 (nth 0 x) ; file name
577 (if (stringp (nth 1 x)) (format " -> %s" (nth 1 x)) "")))
578 (forward-line)
579 (beginning-of-line))
580 entries)))))
581
582(defun tramp-fish-handle-insert-file-contents
583 (filename &optional visit beg end replace)
584 "Like `insert-file-contents' for Tramp files."
585 (barf-if-buffer-read-only)
586 (when visit
587 (setq buffer-file-name (expand-file-name filename))
588 (set-visited-file-modtime)
589 (set-buffer-modified-p nil))
590
591 (with-parsed-tramp-file-name filename nil
592 (if (not (file-exists-p filename))
593 (tramp-error
594 v 'file-error "File %s not found on remote host" filename)
595
596 (let ((point (point))
597 size)
598 (with-progress-reporter v 3 (format "Fetching file %s" filename)
599 (when (tramp-fish-retrieve-data v)
600 ;; Insert file
601 (insert
602 (with-current-buffer (tramp-get-buffer v)
603 (let ((beg (or beg (point-min)))
604 (end (min (or end (point-max)) (point-max))))
605 (setq size (- end beg))
606 (buffer-substring beg end))))
607 (goto-char point)))
608
609 (list (expand-file-name filename) size)))))
610
611(defun tramp-fish-handle-make-directory (dir &optional parents)
612 "Like `make-directory' for Tramp files."
613 (setq dir (directory-file-name (expand-file-name dir)))
614 (unless (file-name-absolute-p dir)
615 (setq dir (expand-file-name dir default-directory)))
616 (with-parsed-tramp-file-name dir nil
617 (save-match-data
618 (let ((ldir (file-name-directory dir)))
619 ;; Make missing directory parts
620 (when (and parents (not (file-directory-p ldir)))
621 (make-directory ldir parents))
622 ;; Just do it
623 (when (file-directory-p ldir)
624 (make-directory-internal dir))
625 (unless (file-directory-p dir)
626 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
627
628(defun tramp-fish-handle-make-directory-internal (directory)
629 "Like `make-directory-internal' for Tramp files."
630 (setq directory (directory-file-name (expand-file-name directory)))
631 (unless (file-name-absolute-p directory)
632 (setq directory (expand-file-name directory default-directory)))
633 (when (file-directory-p (file-name-directory directory))
634 (with-parsed-tramp-file-name directory nil
635 (save-match-data
636 (unless
637 (tramp-fish-send-command-and-check v (format "#MKD %s" localname))
638 (tramp-error
639 v 'file-error "Couldn't make directory %s" directory))))))
640
641(defun tramp-fish-handle-make-symbolic-link
642 (filename linkname &optional ok-if-already-exists)
643 "Like `make-symbolic-link' for Tramp files.
644If LINKNAME is a non-Tramp file, it is used verbatim as the target of
645the symlink. If LINKNAME is a Tramp file, only the localname component is
646used as the target of the symlink.
647
648If LINKNAME is a Tramp file and the localname component is relative, then
649it is expanded first, before the localname component is taken. Note that
650this can give surprising results if the user/host for the source and
651target of the symlink differ."
652 (with-parsed-tramp-file-name linkname nil
653 ;; Do the 'confirm if exists' thing.
654 (when (file-exists-p linkname)
655 ;; What to do?
656 (if (or (null ok-if-already-exists) ; not allowed to exist
657 (and (numberp ok-if-already-exists)
658 (not (yes-or-no-p
659 (format
660 "File %s already exists; make it a link anyway? "
661 localname)))))
662 (tramp-error
663 v 'file-already-exists "File %s already exists" localname)
664 (delete-file linkname)))
665
666 ;; If FILENAME is a Tramp name, use just the localname component.
667 (when (tramp-tramp-file-p filename)
668 (setq filename (tramp-file-name-localname
669 (tramp-dissect-file-name (expand-file-name filename)))))
670
671 ;; Right, they are on the same host, regardless of user, method, etc.
672 ;; We now make the link on the remote machine. This will occur as the user
673 ;; that FILENAME belongs to.
674 (unless
675 (tramp-fish-send-command-and-check
676 v (format "#SYMLINK %s %s" filename localname))
677 (tramp-error v 'file-error "Error creating symbolic link %s" linkname))))
678
679(defun tramp-fish-handle-rename-file
680 (filename newname &optional ok-if-already-exists)
681 "Like `rename-file' for Tramp files."
682 (tramp-fish-do-copy-or-rename-file
683 'rename filename newname ok-if-already-exists t))
684
685(defun tramp-fish-handle-set-file-modes (filename mode)
686 "Like `set-file-modes' for Tramp files."
687 (with-parsed-tramp-file-name filename nil
688 (tramp-flush-file-property v localname)
689 (unless (tramp-fish-send-command-and-check
690 v (format "#CHMOD %s %s"
691 (tramp-decimal-to-octal mode)
692 (tramp-shell-quote-argument localname)))
693 (tramp-error
694 v 'file-error "Error while changing file's mode %s" filename))))
695
696(defun tramp-fish-handle-set-file-times (filename &optional time)
697 "Like `set-file-times' for Tramp files."
698 (with-parsed-tramp-file-name filename nil
699 (let ((time (if (or (null time) (equal time '(0 0))) (current-time) time)))
700 (zerop (process-file
701 "touch" nil nil nil "-t"
702 (format-time-string "%Y%m%d%H%M.%S" time)
703 (tramp-shell-quote-argument localname))))))
704
705(defun tramp-fish-handle-write-region
706 (start end filename &optional append visit lockname confirm)
707 "Like `write-region' for Tramp files."
708 (setq filename (expand-file-name filename))
709 (with-parsed-tramp-file-name filename nil
710 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
711 (when (and (not (featurep 'xemacs))
712 confirm (file-exists-p filename))
713 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
714 filename))
715 (tramp-error v 'file-error "File not overwritten")))
716
717 (tramp-flush-file-property v localname)
718
719 ;; Send command
720 (let ((tramp-fish-ok-prompt-regexp
721 (concat
722 tramp-fish-ok-prompt-regexp "\\|"
723 tramp-fish-continue-prompt-regexp)))
724 (tramp-fish-send-command
725 v (format "%s %d %s\n### 100"
726 (if append "#APPEND" "#STOR") (- end start) localname)))
727
728 ;; Send data, if there are any.
729 (when (> end start)
730 (tramp-fish-send-command v (buffer-substring-no-properties start end)))
731
732 (when (eq visit t)
733 (set-visited-file-modtime))))
734
735(defun tramp-fish-handle-executable-find (command)
736 "Like `executable-find' for Tramp files."
737 (with-temp-buffer
738 (if (zerop (process-file "which" nil t nil command))
739 (progn
740 (goto-char (point-min))
741 (buffer-substring (point-min) (tramp-compat-line-end-position))))))
742
743(defun tramp-fish-handle-process-file
744 (program &optional infile destination display &rest args)
745 "Like `process-file' for Tramp files."
746 ;; The implementation is not complete yet.
747 (when (and (numberp destination) (zerop destination))
748 (error "Implementation does not handle immediate return"))
749
750 (with-parsed-tramp-file-name default-directory nil
751 (let (command input tmpinput output tmpoutput stderr tmpstderr
752 outbuf tmpfile ret)
753 ;; Compute command.
754 (setq command (mapconcat 'tramp-shell-quote-argument
755 (cons program args) " "))
756 ;; Determine input.
757 (if (null infile)
758 (setq input "/dev/null")
759 (setq infile (expand-file-name infile))
760 (if (tramp-equal-remote default-directory infile)
761 ;; INFILE is on the same remote host.
762 (setq input (with-parsed-tramp-file-name infile nil localname))
763 ;; INFILE must be copied to remote host.
764 (setq input (tramp-make-tramp-temp-file v)
765 tmpinput (tramp-make-tramp-file-name method user host input))
766 (copy-file infile tmpinput t)))
767 (when input (setq command (format "%s <%s" command input)))
768
769 ;; Determine output.
770 (setq output (tramp-make-tramp-temp-file v)
771 tmpoutput (tramp-make-tramp-file-name method user host output))
772 (cond
773 ;; Just a buffer
774 ((bufferp destination)
775 (setq outbuf destination))
776 ;; A buffer name
777 ((stringp destination)
778 (setq outbuf (get-buffer-create destination)))
779 ;; (REAL-DESTINATION ERROR-DESTINATION)
780 ((consp destination)
781 ;; output
782 (cond
783 ((bufferp (car destination))
784 (setq outbuf (car destination)))
785 ((stringp (car destination))
786 (setq outbuf (get-buffer-create (car destination)))))
787 ;; stderr
788 (cond
789 ((stringp (cadr destination))
790 (setcar (cdr destination) (expand-file-name (cadr destination)))
791 (if (tramp-equal-remote default-directory (cadr destination))
792 ;; stderr is on the same remote host.
793 (setq stderr (with-parsed-tramp-file-name
794 (cadr destination) nil localname))
795 ;; stderr must be copied to remote host. The temporary
796 ;; file must be deleted after execution.
797 (setq stderr (tramp-make-tramp-temp-file v)
798 tmpstderr (tramp-make-tramp-file-name
799 method user host stderr))))
800 ;; stderr to be discarded
801 ((null (cadr destination))
802 (setq stderr "/dev/null"))))
803 ;; 't
804 (destination
805 (setq outbuf (current-buffer))))
806 (when stderr (setq command (format "%s 2>%s" command stderr)))
807
808 ;; Goto working directory.
809 (unless
810 (tramp-fish-send-command-and-check
811 v (format "#CWD %s" (tramp-shell-quote-argument localname)))
812 (tramp-error v 'file-error "No such directory: %s" default-directory))
813 ;; Send the command. It might not return in time, so we protect it.
814 (condition-case nil
815 (unwind-protect
816 (unless (tramp-fish-send-command-and-check
817 v (format
818 "#EXEC %s %s"
819 (tramp-shell-quote-argument command) output))
820 (error nil))
821 ;; Check return code.
822 (setq tmpfile
823 (file-local-copy
824 (tramp-make-tramp-file-name method user host output)))
825 (with-temp-buffer
826 (insert-file-contents tmpfile)
827 (goto-char (point-max))
828 (forward-line -1)
829 (looking-at "^###RESULT: \\([0-9]+\\)")
830 (setq ret (string-to-number (match-string 1)))
831 (delete-region (point) (point-max))
832 (write-region (point-min) (point-max) tmpfile))
833 ;; We should show the output anyway.
834 (when outbuf
835 (with-current-buffer outbuf (insert-file-contents tmpfile))
836 (when display (display-buffer outbuf))))
837 ;; When the user did interrupt, we should do it also.
838 (error (setq ret 1)))
839
840 ;; Provide error file.
841 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
842 ;; Cleanup.
843 (when tmpinput (delete-file tmpinput))
844 (when tmpoutput (delete-file tmpoutput))
845 ;; Return exit status.
846 ret)))
847
848
849;; Internal file name functions
850
851(defun tramp-fish-do-copy-or-rename-file
852 (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
853 "Copy or rename a remote file.
854OP must be `copy' or `rename' and indicates the operation to
855perform. FILENAME specifies the file to copy or rename, NEWNAME
856is the name of the new file (for copy) or the new name of the
857file (for rename). OK-IF-ALREADY-EXISTS means don't barf if
858NEWNAME exists already. KEEP-DATE means to make sure that
859NEWNAME has the same timestamp as FILENAME.
860
861This function is invoked by `tramp-fish-handle-copy-file' and
862`tramp-fish-handle-rename-file'. It is an error if OP is neither
863of `copy' and `rename'. FILENAME and NEWNAME must be absolute
864file names."
865 (unless (memq op '(copy rename))
866 (error "Unknown operation `%s', must be `copy' or `rename'" op))
867 (let ((t1 (tramp-tramp-file-p filename))
868 (t2 (tramp-tramp-file-p newname)))
869
870 (unless ok-if-already-exists
871 (when (and t2 (file-exists-p newname))
872 (with-parsed-tramp-file-name newname nil
873 (tramp-error
874 v 'file-already-exists "File %s already exists" newname))))
875
876 (prog1
877 (cond
878 ;; Both are Tramp files.
879 ((and t1 t2)
880 (cond
881 ;; Shortcut: if method, host, user are the same for both
882 ;; files, we invoke `cp' or `mv' on the remote host
883 ;; directly.
884 ((tramp-equal-remote filename newname)
885 (tramp-fish-do-copy-or-rename-file-directly
886 op filename newname keep-date preserve-uid-gid))
887 ;; No shortcut was possible. So we copy the
888 ;; file first. If the operation was `rename', we go
889 ;; back and delete the original file (if the copy was
890 ;; successful). The approach is simple-minded: we
891 ;; create a new buffer, insert the contents of the
892 ;; source file into it, then write out the buffer to
893 ;; the target file. The advantage is that it doesn't
894 ;; matter which filename handlers are used for the
895 ;; source and target file.
896 (t
897 (tramp-do-copy-or-rename-file-via-buffer
898 op filename newname keep-date))))
899
900 ;; One file is a Tramp file, the other one is local.
901 ((or t1 t2)
902 ;; Use the generic method via a Tramp buffer.
903 (tramp-do-copy-or-rename-file-via-buffer
904 op filename newname keep-date))
905
906 (t
907 ;; One of them must be a Tramp file.
908 (error "Tramp implementation says this cannot happen")))
909 ;; When newname did exist, we have wrong cached values.
910 (when t2
911 (with-parsed-tramp-file-name newname nil
912 (tramp-flush-file-property v localname)
913 (tramp-flush-file-property v (file-name-directory localname)))))))
914
915(defun tramp-fish-do-copy-or-rename-file-directly
916 (op filename newname keep-date preserve-uid-gid)
917 "Invokes `COPY' or `RENAME' on the remote system.
918OP must be one of `copy' or `rename', indicating `cp' or `mv',
919respectively. VEC specifies the connection. LOCALNAME1 and
920LOCALNAME2 specify the two arguments of `cp' or `mv'. If
921KEEP-DATE is non-nil, preserve the time stamp when copying.
922PRESERVE-UID-GID is completely ignored."
923 (with-parsed-tramp-file-name filename v1
924 (with-parsed-tramp-file-name newname v2
925 (tramp-fish-send-command
926 v1
927 (format "%s %s %s"
928 (if (eq op 'copy) "#COPY" "#RENAME")
929 (tramp-shell-quote-argument v1-localname)
930 (tramp-shell-quote-argument v2-localname)))))
931 ;; KEEP-DATE handling.
932 (when (and keep-date (functionp 'set-file-times))
933 (set-file-times newname (nth 5 (file-attributes filename))))
934 ;; Set the mode.
935 (set-file-modes newname (tramp-default-file-modes filename)))
936
937(defun tramp-fish-get-file-entries (vec localname list)
938 "Read entries returned by FISH server.
939When LIST is true, a #LIST command will be sent, including all entries
940of a directory. Otherwise, #STAT is sent for just one entry.
941Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
942SIZE MODE WEIRD INODE DEVICE)."
943 (block nil
944 (with-current-buffer (tramp-get-buffer vec)
945 ;; #LIST does not work properly with trailing "/", at least in
946 ;; .fishsrv.pl.
947 (when (string-match "/$" localname)
948 (setq localname (concat localname ".")))
949
950 (let ((command (format "%s %s" (if list "#LIST" "#STAT") localname))
951 buffer-read-only num res)
952
953 ;; Send command
954 (tramp-fish-send-command vec command)
955
956 ;; Read number of entries
957 (goto-char (point-min))
958 (condition-case nil
959 (unless (integerp (setq num (read (current-buffer)))) (error nil))
960 (error (return nil)))
961 (forward-line)
962 (delete-region (point-min) (point))
963
964 ;; Read return code
965 (goto-char (point-min))
966 (condition-case nil
967 (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
968 (error (return nil)))
969 (forward-line)
970 (delete-region (point-min) (point))
971
972 ;; Loop the listing
973 (dotimes (i num)
974 (let ((item (tramp-fish-read-file-entry)))
975 ;; Add inode and device.
976 (add-to-list
977 'res (append item
978 (list (tramp-get-inode vec)
979 (tramp-get-device vec))))))
980
981 ;; Read return code
982 (goto-char (point-min))
983 (condition-case nil
984 (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
985 (error (tramp-error
986 vec 'file-error
987 "`%s' does not return a valid Lisp expression: `%s'"
988 command (buffer-string))))
989 (forward-line)
990 (delete-region (point-min) (point))
991
992 res))))
993
994(defun tramp-fish-read-file-entry ()
995 "Parse entry in output buffer.
996Result is the list (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
997SIZE MODE WEIRD)."
998 ;; We are called from `tramp-fish-get-file-entries', which sets the
999 ;; current buffer.
1000 (let (buffer-read-only localname link uid gid mtime size mode)
1001 (block nil
1002 (while t
1003 (cond
1004 ;; P<unix permissions> <owner>.<group>
1005 ((looking-at "^P\\(.+\\)\\s-\\(.+\\)\\.\\(.+\\)$")
1006 (setq mode (match-string 1))
1007 (setq uid (match-string 2))
1008 (setq gid (match-string 3))
1009 (when (string-match "^d" mode) (setq link t)))
1010 ;; S<size>
1011 ((looking-at "^S\\([0-9]+\\)$")
1012 (setq size (string-to-number (match-string 1))))
1013 ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
1014 ((looking-at
1015 "^D\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\(\\S-+\\)$")
1016 (setq mtime
1017 (encode-time
1018 (string-to-number (match-string 6))
1019 (string-to-number (match-string 5))
1020 (string-to-number (match-string 4))
1021 (string-to-number (match-string 3))
1022 (string-to-number (match-string 2))
1023 (string-to-number (match-string 1)))))
1024 ;; d<3-letters month name> <day> <year or HH:MM>
1025 ((looking-at "^d") nil)
1026 ;; E<major-of-device>,<minor>
1027 ((looking-at "^E") nil)
1028 ;; :<filename>
1029 ((looking-at "^:\\(.+\\)$")
1030 (setq localname (match-string 1)))
1031 ;; L<filename symlink points to>
1032 ((looking-at "^L\\(.+\\)$")
1033 (setq link (match-string 1)))
1034 ;; M<mimetype>
1035 ((looking-at "^M\\(.+\\)$") nil)
1036 ;; last line
1037 ((looking-at "^$")
1038 (return)))
1039 ;; Delete line.
1040 (forward-line)
1041 (delete-region (point-min) (point))))
1042
1043 ;; Delete trailing empty line.
1044 (forward-line)
1045 (delete-region (point-min) (point))
1046
1047 ;; Return entry in `file-attributes' format.
1048 (list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil)))
1049
1050(defun tramp-fish-retrieve-data (vec)
1051 "Reads remote data for FISH protocol.
1052The data are left in the connection buffer of VEC for further processing.
1053Returns the size of the data."
1054 (block nil
1055 (with-current-buffer (tramp-get-buffer vec)
1056 ;; The retrieved data might be in binary format, without
1057 ;; trailing newline. Therefore, the OK prompt might not start
1058 ;; at the beginning of a line.
1059 (let ((tramp-fish-ok-prompt-regexp "### 200\n")
1060 size)
1061
1062 ;; Send command
1063 (tramp-fish-send-command
1064 vec (format "#RETR %s" (tramp-file-name-localname vec)))
1065
1066 ;; Read filesize
1067 (goto-char (point-min))
1068 (condition-case nil
1069 (unless (integerp (setq size (read (current-buffer)))) (error nil))
1070 (error (return nil)))
1071 (forward-line)
1072 (delete-region (point-min) (point))
1073
1074 ;; Read return code
1075 (goto-char (point-min))
1076 (condition-case nil
1077 (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil))
1078 (error (return nil)))
1079 (forward-line)
1080 (delete-region (point-min) (point))
1081
1082 ;; The received data might contain the OK prompt already, so
1083 ;; there might be outstanding data.
1084 (while (/= (+ size (length tramp-fish-ok-prompt-regexp))
1085 (- (point-max) (point-min)))
1086 (tramp-wait-for-regexp
1087 (tramp-get-connection-process vec) nil
1088 (concat tramp-fish-ok-prompt-regexp "$")))
1089
1090 ;; Read return code
1091 (goto-char (+ (point-min) size))
1092 (condition-case nil
1093 (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil))
1094 (error (return nil)))
1095 (delete-region (+ (point-min) size) (point-max))
1096 size))))
1097
1098
1099;; Connection functions
1100
1101(defun tramp-fish-maybe-open-connection (vec)
1102 "Maybe open a connection VEC.
1103Does not do anything if a connection is already open, but re-opens the
1104connection if a previous connection has died for some reason."
1105 (let ((process-connection-type tramp-process-connection-type)
1106 (p (get-buffer-process (tramp-get-buffer vec))))
1107
1108 ;; New connection must be opened.
1109 (unless (and p (processp p) (memq (process-status p) '(run open)))
1110
1111 ;; Set variables for computing the prompt for reading password.
1112 (setq tramp-current-method (tramp-file-name-method vec)
1113 tramp-current-user (tramp-file-name-user vec)
1114 tramp-current-host (tramp-file-name-host vec))
1115
1116 ;; Start new process.
1117 (when (and p (processp p))
1118 (delete-process p))
1119 (setenv "TERM" tramp-terminal-type)
1120 (setenv "PS1" tramp-initial-end-of-output)
1121 (with-progress-reporter
1122 vec 3
1123 (format "Opening connection for %s@%s using %s"
1124 tramp-current-user tramp-current-host tramp-current-method)
1125
1126 (let* ((process-connection-type tramp-process-connection-type)
1127 (inhibit-eol-conversion nil)
1128 (coding-system-for-read 'binary)
1129 (coding-system-for-write 'binary)
1130 ;; This must be done in order to avoid our file name handler.
1131 (p (let ((default-directory
1132 (tramp-compat-temporary-file-directory)))
1133 (start-process
1134 (or (tramp-get-connection-property vec "process-name" nil)
1135 (tramp-buffer-name vec))
1136 (tramp-get-connection-buffer vec)
1137 "ssh" "-l"
1138 (tramp-file-name-user vec)
1139 (tramp-file-name-host vec)))))
1140 (tramp-message
1141 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1142
1143 ;; Check whether process is alive.
1144 (tramp-set-process-query-on-exit-flag p nil)
1145
1146 (tramp-process-actions p vec tramp-actions-before-shell 60)
1147 (tramp-fish-send-command vec tramp-fish-start-fish-server-command)
1148 (tramp-message
1149 vec 3
1150 "Found remote shell prompt on `%s'" (tramp-file-name-host vec)))))))
1151
1152(defun tramp-fish-send-command (vec command)
1153 "Send the COMMAND to connection VEC."
1154 (tramp-fish-maybe-open-connection vec)
1155 (tramp-message vec 6 "%s" command)
1156 (tramp-send-string vec command)
1157 (tramp-wait-for-regexp
1158 (tramp-get-connection-process vec) nil
1159 (concat tramp-fish-ok-prompt-regexp "\\|" tramp-fish-error-prompt-regexp)))
1160
1161(defun tramp-fish-send-command-and-check (vec command)
1162 "Send the COMMAND to connection VEC.
1163Returns nil if there has been an error message."
1164
1165 ;; Send command.
1166 (tramp-fish-send-command vec command)
1167
1168 ;; Read return code.
1169 (with-current-buffer (tramp-get-buffer vec)
1170 (goto-char (point-min))
1171 (looking-at tramp-fish-ok-prompt-regexp)))
1172
1173(provide 'tramp-fish)
1174;
1175;;;; TODO:
1176;
1177;; * Evaluate the MIME information with #LIST or #STAT.
1178;
1179
1180;; arch-tag: a66df7df-5f29-42a7-a921-643ceb29db49
1181;;;; tramp-fish.el ends here
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 14cf2e0adbf..7f8b7454caf 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -30,7 +30,6 @@
30;;; Code: 30;;; Code:
31 31
32(require 'tramp) 32(require 'tramp)
33(autoload 'tramp-set-connection-property "tramp-cache")
34 33
35(eval-when-compile 34(eval-when-compile
36 35
@@ -99,13 +98,14 @@ present for backward compatibility."
99(add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp) 98(add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp)
100 99
101;; Define FTP method ... 100;; Define FTP method ...
102(defcustom tramp-ftp-method "ftp" 101;;;###tramp-autoload
103 "*When this method name is used, forward all calls to Ange-FTP." 102(defconst tramp-ftp-method "ftp"
104 :group 'tramp 103 "*When this method name is used, forward all calls to Ange-FTP.")
105 :type 'string)
106 104
107;; ... and add it to the method list. 105;; ... and add it to the method list.
108(add-to-list 'tramp-methods (cons tramp-ftp-method nil)) 106;;;###tramp-autoload
107(unless (featurep 'xemacs)
108 (add-to-list 'tramp-methods (cons tramp-ftp-method nil)))
109 109
110;; Add some defaults for `tramp-default-method-alist' 110;; Add some defaults for `tramp-default-method-alist'
111(add-to-list 'tramp-default-method-alist 111(add-to-list 'tramp-default-method-alist
@@ -129,6 +129,7 @@ present for backward compatibility."
129 (symbol-plist 129 (symbol-plist
130 'substitute-in-file-name)))))) 130 'substitute-in-file-name))))))
131 131
132;;;###tramp-autoload
132(defun tramp-ftp-file-name-handler (operation &rest args) 133(defun tramp-ftp-file-name-handler (operation &rest args)
133 "Invoke the Ange-FTP handler for OPERATION. 134 "Invoke the Ange-FTP handler for OPERATION.
134First arg specifies the OPERATION, second arg is a list of arguments to 135First arg specifies the OPERATION, second arg is a list of arguments to
@@ -199,23 +200,26 @@ pass to the OPERATION."
199 (inhibit-file-name-operation operation)) 200 (inhibit-file-name-operation operation))
200 (apply 'ange-ftp-hook-function operation args))))))) 201 (apply 'ange-ftp-hook-function operation args)))))))
201 202
202(defun tramp-ftp-file-name-p (filename) 203;;;###tramp-autoload
204(defsubst tramp-ftp-file-name-p (filename)
203 "Check if it's a filename that should be forwarded to Ange-FTP." 205 "Check if it's a filename that should be forwarded to Ange-FTP."
204 (let ((v (tramp-dissect-file-name filename))) 206 (let ((v (tramp-dissect-file-name filename)))
205 (string= (tramp-file-name-method v) tramp-ftp-method))) 207 (string= (tramp-file-name-method v) tramp-ftp-method)))
206 208
207(add-to-list 'tramp-foreign-file-name-handler-alist 209;;;###tramp-autoload
208 (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) 210(unless (featurep 'xemacs)
211 (add-to-list 'tramp-foreign-file-name-handler-alist
212 (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)))
213
214(add-hook 'tramp-unload-hook
215 (lambda ()
216 (unload-feature 'tramp-ftp 'force)))
209 217
210(provide 'tramp-ftp) 218(provide 'tramp-ftp)
211 219
212;;; TODO: 220;;; TODO:
213 221
214;; * In case of "/ftp:host:file" this works only for functions which 222;; * There are no backup files on FTP hosts.
215;; are defined in `tramp-file-name-handler-alist'. Call has to be
216;; pretended in `tramp-file-name-handler' otherwise.
217;; Furthermore, there are no backup files on FTP hosts.
218;; Worth further investigations.
219 223
220;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff 224;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff
221;;; tramp-ftp.el ends here 225;;; tramp-ftp.el ends here
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d0814545e6e..cd2bab26f47 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -103,11 +103,17 @@
103 (require 'custom)) 103 (require 'custom))
104 104
105(require 'tramp) 105(require 'tramp)
106
107;; We call several `tramp-handle-*' functions directly. So we must
108;; reqire that package as well.
109(require 'tramp-sh)
110
106(require 'dbus) 111(require 'dbus)
107(require 'url-parse) 112(require 'url-parse)
108(require 'url-util) 113(require 'url-util)
109(require 'zeroconf) 114(require 'zeroconf)
110 115
116;;;###tramp-autoload
111(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce") 117(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
112 "*List of methods for remote files, accessed with GVFS." 118 "*List of methods for remote files, accessed with GVFS."
113 :group 'tramp 119 :group 'tramp
@@ -133,11 +139,11 @@
133 139
134;; Add the methods to `tramp-methods', in order to allow minibuffer 140;; Add the methods to `tramp-methods', in order to allow minibuffer
135;; completion. 141;; completion.
136(eval-after-load "tramp-gvfs" 142;;;###tramp-autoload
137 '(when (featurep 'tramp-gvfs) 143(when (featurep 'dbusbind)
138 (dolist (elt tramp-gvfs-methods) 144 (dolist (elt tramp-gvfs-methods)
139 (unless (assoc elt tramp-methods) 145 (unless (assoc elt tramp-methods)
140 (add-to-list 'tramp-methods (cons elt nil)))))) 146 (add-to-list 'tramp-methods (cons elt nil)))))
141 147
142(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") 148(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
143 "The preceeding object path for own objects.") 149 "The preceeding object path for own objects.")
@@ -145,9 +151,12 @@
145(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" 151(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
146 "The well known name of the GVFS daemon.") 152 "The well known name of the GVFS daemon.")
147 153
148;; Check that GVFS is available. 154;; Check that GVFS is available. D-Bus integration is available since
149(unless (dbus-ping :session tramp-gvfs-service-daemon 100) 155;; Emacs 23 on some system types. We don't call `dbus-ping', because
150 (throw 'tramp-loading nil)) 156;; this would load dbus.el.
157(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
158 (tramp-compat-process-running-p "gvfs-fuse-daemon"))
159 (error "Package `tramp-gvfs' not supported"))
151 160
152(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" 161(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
153 "The object path of the GVFS daemon.") 162 "The object path of the GVFS daemon.")
@@ -385,7 +394,7 @@ Every entry is a list (NAME ADDRESS).")
385 (expand-file-name . tramp-gvfs-handle-expand-file-name) 394 (expand-file-name . tramp-gvfs-handle-expand-file-name)
386 ;; `file-accessible-directory-p' performed by default handler. 395 ;; `file-accessible-directory-p' performed by default handler.
387 (file-attributes . tramp-gvfs-handle-file-attributes) 396 (file-attributes . tramp-gvfs-handle-file-attributes)
388 (file-directory-p . tramp-smb-handle-file-directory-p) 397 (file-directory-p . tramp-gvfs-handle-file-directory-p)
389 (file-executable-p . tramp-gvfs-handle-file-executable-p) 398 (file-executable-p . tramp-gvfs-handle-file-executable-p)
390 (file-exists-p . tramp-gvfs-handle-file-exists-p) 399 (file-exists-p . tramp-gvfs-handle-file-exists-p)
391 (file-local-copy . tramp-gvfs-handle-file-local-copy) 400 (file-local-copy . tramp-gvfs-handle-file-local-copy)
@@ -431,13 +440,15 @@ Every entry is a list (NAME ADDRESS).")
431 "Alist of handler functions for Tramp GVFS method. 440 "Alist of handler functions for Tramp GVFS method.
432Operations not mentioned here will be handled by the default Emacs primitives.") 441Operations not mentioned here will be handled by the default Emacs primitives.")
433 442
434(defun tramp-gvfs-file-name-p (filename) 443;;;###tramp-autoload
444(defsubst tramp-gvfs-file-name-p (filename)
435 "Check if it's a filename handled by the GVFS daemon." 445 "Check if it's a filename handled by the GVFS daemon."
436 (and (tramp-tramp-file-p filename) 446 (and (tramp-tramp-file-p filename)
437 (let ((method 447 (let ((method
438 (tramp-file-name-method (tramp-dissect-file-name filename)))) 448 (tramp-file-name-method (tramp-dissect-file-name filename))))
439 (and (stringp method) (member method tramp-gvfs-methods))))) 449 (and (stringp method) (member method tramp-gvfs-methods)))))
440 450
451;;;###tramp-autoload
441(defun tramp-gvfs-file-name-handler (operation &rest args) 452(defun tramp-gvfs-file-name-handler (operation &rest args)
442 "Invoke the GVFS related OPERATION. 453 "Invoke the GVFS related OPERATION.
443First arg specifies the OPERATION, second arg is a list of arguments to 454First arg specifies the OPERATION, second arg is a list of arguments to
@@ -449,8 +460,10 @@ pass to the OPERATION."
449 460
450;; This might be moved to tramp.el. It shall be the first file name 461;; This might be moved to tramp.el. It shall be the first file name
451;; handler. 462;; handler.
452(add-to-list 'tramp-foreign-file-name-handler-alist 463;;;###tramp-autoload
453 (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)) 464(when (featurep 'dbusbind)
465 (add-to-list 'tramp-foreign-file-name-handler-alist
466 (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))
454 467
455(defun tramp-gvfs-stringify-dbus-message (message) 468(defun tramp-gvfs-stringify-dbus-message (message)
456 "Convert a D-Bus message into readable UTF8 strings, used for traces." 469 "Convert a D-Bus message into readable UTF8 strings, used for traces."
@@ -485,7 +498,8 @@ will be traced by Tramp with trace level 6."
485 498
486(put 'with-tramp-dbus-call-method 'lisp-indent-function 2) 499(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
487(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) 500(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
488(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) 501(tramp-compat-font-lock-add-keywords
502 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
489 503
490(defmacro with-tramp-gvfs-error-message (filename handler &rest args) 504(defmacro with-tramp-gvfs-error-message (filename handler &rest args)
491 "Apply a Tramp GVFS `handler'. 505 "Apply a Tramp GVFS `handler'.
@@ -494,7 +508,7 @@ In case of an error, modify the error message by replacing
494 `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename))) 508 `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
495 elt) 509 elt)
496 (condition-case err 510 (condition-case err
497 (funcall ,handler ,@args) 511 (tramp-compat-funcall ,handler ,@args)
498 (error 512 (error
499 (setq elt (cdr err)) 513 (setq elt (cdr err))
500 (while elt 514 (while elt
@@ -506,7 +520,8 @@ In case of an error, modify the error message by replacing
506 520
507(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2) 521(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
508(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body)) 522(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
509(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>")) 523(tramp-compat-font-lock-add-keywords
524 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
510 525
511(defvar tramp-gvfs-dbus-event-vector nil 526(defvar tramp-gvfs-dbus-event-vector nil
512 "Current Tramp file name to be used, as vector. 527 "Current Tramp file name to be used, as vector.
@@ -647,6 +662,10 @@ is no information where to trace the message.")
647 "Like `file-attributes' for Tramp files." 662 "Like `file-attributes' for Tramp files."
648 (file-attributes (tramp-gvfs-fuse-file-name filename) id-format)) 663 (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
649 664
665(defun tramp-gvfs-handle-file-directory-p (filename)
666 "Like `file-directory-p' for Tramp files."
667 (file-directory-p (tramp-gvfs-fuse-file-name filename)))
668
650(defun tramp-gvfs-handle-file-executable-p (filename) 669(defun tramp-gvfs-handle-file-executable-p (filename)
651 "Like `file-executable-p' for Tramp files." 670 "Like `file-executable-p' for Tramp files."
652 (file-executable-p (tramp-gvfs-fuse-file-name filename))) 671 (file-executable-p (tramp-gvfs-fuse-file-name filename)))
@@ -956,7 +975,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
956 ;; host signature. 975 ;; host signature.
957 (with-temp-buffer 976 (with-temp-buffer
958 ;; Preserve message for `progress-reporter'. 977 ;; Preserve message for `progress-reporter'.
959 (with-temp-message "" 978 (tramp-compat-with-temp-message ""
960 (insert message) 979 (insert message)
961 (pop-to-buffer (current-buffer)) 980 (pop-to-buffer (current-buffer))
962 (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) 981 (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
@@ -1403,6 +1422,10 @@ They are retrieved from the hal daemon."
1403(tramp-set-completion-function 1422(tramp-set-completion-function
1404 "synce" '((tramp-synce-parse-device-names ""))) 1423 "synce" '((tramp-synce-parse-device-names "")))
1405 1424
1425(add-hook 'tramp-unload-hook
1426 (lambda ()
1427 (unload-feature 'tramp-gvfs 'force)))
1428
1406(provide 'tramp-gvfs) 1429(provide 'tramp-gvfs)
1407 1430
1408;;; TODO: 1431;;; TODO:
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index 76f9b30f90c..a550d46b9b5 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -38,11 +38,6 @@
38 (require 'cl) 38 (require 'cl)
39 (require 'custom)) 39 (require 'custom))
40 40
41;; Autoload the socks library. It is used only when we access a SOCKS server.
42(autoload 'socks-open-network-stream "socks")
43(defvar socks-username (user-login-name))
44(defvar socks-server (list "Default server" "socks" 1080 5))
45
46;; Avoid byte-compiler warnings if the byte-compiler supports this. 41;; Avoid byte-compiler warnings if the byte-compiler supports this.
47;; Currently, XEmacs supports this. 42;; Currently, XEmacs supports this.
48(eval-when-compile 43(eval-when-compile
@@ -50,21 +45,29 @@
50 (byte-compiler-options (warnings (- unused-vars))))) 45 (byte-compiler-options (warnings (- unused-vars)))))
51 46
52;; Define HTTP tunnel method ... 47;; Define HTTP tunnel method ...
53(defvar tramp-gw-tunnel-method "tunnel" 48;;;###tramp-autoload
49(defconst tramp-gw-tunnel-method "tunnel"
54 "*Method to connect HTTP gateways.") 50 "*Method to connect HTTP gateways.")
55 51
56;; ... and port. 52;; ... and port.
57(defvar tramp-gw-default-tunnel-port 8080 53(defconst tramp-gw-default-tunnel-port 8080
58 "*Default port for HTTP gateways.") 54 "*Default port for HTTP gateways.")
59 55
60;; Define SOCKS method ... 56;; Define SOCKS method ...
61(defvar tramp-gw-socks-method "socks" 57;;;###tramp-autoload
58(defconst tramp-gw-socks-method "socks"
62 "*Method to connect SOCKS servers.") 59 "*Method to connect SOCKS servers.")
63 60
64;; ... and port. 61;; ... and port.
65(defvar tramp-gw-default-socks-port 1080 62(defconst tramp-gw-default-socks-port 1080
66 "*Default port for SOCKS servers.") 63 "*Default port for SOCKS servers.")
67 64
65;; Autoload the socks library. It is used only when we access a SOCKS server.
66(autoload 'socks-open-network-stream "socks")
67(defvar socks-username (user-login-name))
68(defvar socks-server
69 (list "Default server" "socks" tramp-gw-default-socks-port 5))
70
68;; Add a default for `tramp-default-user-alist'. Default is the local user. 71;; Add a default for `tramp-default-user-alist'. Default is the local user.
69(add-to-list 'tramp-default-user-alist 72(add-to-list 'tramp-default-user-alist
70 `(,tramp-gw-tunnel-method nil ,(user-login-name))) 73 `(,tramp-gw-tunnel-method nil ,(user-login-name)))
@@ -125,6 +128,7 @@
125 (process-send-string 128 (process-send-string
126 (tramp-get-connection-property proc "process" nil) string))) 129 (tramp-get-connection-property proc "process" nil) string)))
127 130
131;;;###tramp-autoload
128(defun tramp-gw-open-connection (vec gw-vec target-vec) 132(defun tramp-gw-open-connection (vec gw-vec target-vec)
129 "Open a remote connection to VEC (see `tramp-file-name' structure). 133 "Open a remote connection to VEC (see `tramp-file-name' structure).
130Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a 134Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
@@ -239,10 +243,9 @@ authentication is requested from proxy server, provide it."
239 ;; Trap errors to be traced in the right trace buffer. Often, 243 ;; Trap errors to be traced in the right trace buffer. Often,
240 ;; proxies have a timeout of 60". We wait 65" in order to 244 ;; proxies have a timeout of 60". We wait 65" in order to
241 ;; receive an answer this case. 245 ;; receive an answer this case.
242 (condition-case nil 246 (ignore-errors
243 (let (tramp-verbose) 247 (let (tramp-verbose)
244 (tramp-wait-for-regexp proc 65 "\r?\n\r?\n")) 248 (tramp-wait-for-regexp proc 65 "\r?\n\r?\n")))
245 (error nil))
246 ;; Check return code. 249 ;; Check return code.
247 (goto-char (point-min)) 250 (goto-char (point-min))
248 (narrow-to-region 251 (narrow-to-region
@@ -310,6 +313,9 @@ password in password cache. This is done for the first try only."
310 (format 313 (format
311 "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) 314 "Password for %s@[%s]: " socks-username (read (current-buffer)))))))))
312 315
316(add-hook 'tramp-unload-hook
317 (lambda ()
318 (unload-feature 'tramp-gw 'force)))
313 319
314(provide 'tramp-gw) 320(provide 'tramp-gw)
315 321
diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
index 55addf588a7..4a5e2418cfb 100644
--- a/lisp/net/tramp-imap.el
+++ b/lisp/net/tramp-imap.el
@@ -55,7 +55,6 @@
55 55
56(require 'assoc) 56(require 'assoc)
57(require 'tramp) 57(require 'tramp)
58(require 'tramp-compat)
59 58
60(autoload 'auth-source-user-or-password "auth-source") 59(autoload 'auth-source-user-or-password "auth-source")
61(autoload 'epg-context-operation "epg") 60(autoload 'epg-context-operation "epg")
@@ -76,21 +75,29 @@
76 '(add-to-list 'imap-hash-headers 'X-Size 'append)) 75 '(add-to-list 'imap-hash-headers 'X-Size 'append))
77 76
78;; Define Tramp IMAP method ... 77;; Define Tramp IMAP method ...
78;;;###tramp-autoload
79(defconst tramp-imap-method "imap" 79(defconst tramp-imap-method "imap"
80 "*Method to connect via IMAP protocol.") 80 "*Method to connect via IMAP protocol.")
81 81
82(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143))) 82;;;###tramp-autoload
83(when (and (locate-library "epa") (locate-library "imap-hash"))
84 (add-to-list 'tramp-methods
85 (list tramp-imap-method '(tramp-default-port 143))))
83 86
84;; Add a default for `tramp-default-user-alist'. Default is the local user. 87;; Add a default for `tramp-default-user-alist'. Default is the local user.
85(add-to-list 'tramp-default-user-alist 88(add-to-list 'tramp-default-user-alist
86 `(,tramp-imap-method nil ,(user-login-name))) 89 `(,tramp-imap-method nil ,(user-login-name)))
87 90
88;; Define Tramp IMAPS method ... 91;; Define Tramp IMAPS method ...
92;;;###tramp-autoload
89(defconst tramp-imaps-method "imaps" 93(defconst tramp-imaps-method "imaps"
90 "*Method to connect via secure IMAP protocol.") 94 "*Method to connect via secure IMAP protocol.")
91 95
92;; ... and add it to the method list. 96;; ... and add it to the method list.
93(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993))) 97;;;###tramp-autoload
98(when (and (locate-library "epa") (locate-library "imap-hash"))
99 (add-to-list 'tramp-methods
100 (list tramp-imaps-method '(tramp-default-port 993))))
94 101
95;; Add a default for `tramp-default-user-alist'. Default is the local user. 102;; Add a default for `tramp-default-user-alist'. Default is the local user.
96(add-to-list 'tramp-default-user-alist 103(add-to-list 'tramp-default-user-alist
@@ -184,13 +191,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
184(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never 191(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
185(defvar tramp-imap-passphrase nil) 192(defvar tramp-imap-passphrase nil)
186 193
187(defun tramp-imap-file-name-p (filename) 194;;;###tramp-autoload
195(defsubst tramp-imap-file-name-p (filename)
188 "Check if it's a filename for IMAP protocol." 196 "Check if it's a filename for IMAP protocol."
189 (let ((v (tramp-dissect-file-name filename))) 197 (let ((v (tramp-dissect-file-name filename)))
190 (or 198 (or
191 (string= (tramp-file-name-method v) tramp-imap-method) 199 (string= (tramp-file-name-method v) tramp-imap-method)
192 (string= (tramp-file-name-method v) tramp-imaps-method)))) 200 (string= (tramp-file-name-method v) tramp-imaps-method))))
193 201
202;;;###tramp-autoload
194(defun tramp-imap-file-name-handler (operation &rest args) 203(defun tramp-imap-file-name-handler (operation &rest args)
195 "Invoke the IMAP related OPERATION. 204 "Invoke the IMAP related OPERATION.
196First arg specifies the OPERATION, second arg is a list of arguments to 205First arg specifies the OPERATION, second arg is a list of arguments to
@@ -200,8 +209,10 @@ pass to the OPERATION."
200 (save-match-data (apply (cdr fn) args)) 209 (save-match-data (apply (cdr fn) args))
201 (tramp-run-real-handler operation args)))) 210 (tramp-run-real-handler operation args))))
202 211
203(add-to-list 'tramp-foreign-file-name-handler-alist 212;;;###tramp-autoload
204 (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)) 213(when (and (locate-library "epa") (locate-library "imap-hash"))
214 (add-to-list 'tramp-foreign-file-name-handler-alist
215 (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)))
205 216
206(defun tramp-imap-handle-copy-file 217(defun tramp-imap-handle-copy-file
207 (filename newname &optional ok-if-already-exists keep-date 218 (filename newname &optional ok-if-already-exists keep-date
@@ -776,6 +787,10 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly."
776 tramp-imap-subject-marker 787 tramp-imap-subject-marker
777 (if needed-subject needed-subject ""))))) 788 (if needed-subject needed-subject "")))))
778 789
790(add-hook 'tramp-unload-hook
791 (lambda ()
792 (unload-feature 'tramp-imap 'force)))
793
779;;; TODO: 794;;; TODO:
780 795
781;; * Implement `tramp-imap-handle-delete-directory', 796;; * Implement `tramp-imap-handle-delete-directory',
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
new file mode 100644
index 00000000000..423b4fcbd5e
--- /dev/null
+++ b/lisp/net/tramp-sh.el
@@ -0,0 +1,5509 @@
1;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections
2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; (copyright statements below in code to be updated with the above notice)
7
8;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
9;; Michael Albinus <michael.albinus@gmx.de>
10;; Keywords: comm, processes
11;; Package: tramp
12
13;; This file is part of GNU Emacs.
14
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27
28;;; Code:
29
30(eval-when-compile (require 'cl)) ; ignore-errors
31(require 'tramp)
32(require 'shell)
33
34;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
35;; not sure at all that this is the right way to do it, but let's hope
36;; it works for now, and wait for a guru to point out the Right Way to
37;; achieve this.
38;;(eval-when-compile
39;; (unless (fboundp 'dired-insert-set-properties)
40;; (fset 'dired-insert-set-properties 'ignore)))
41;; Gerd suggests this:
42(eval-when-compile (require 'dired))
43;; Note that dired is required at run-time, too, when it is needed.
44;; It is only needed on XEmacs for the function
45;; `dired-insert-set-properties'.
46
47(defcustom tramp-inline-compress-start-size 4096
48 "*The minimum size of compressing where inline transfer.
49When inline transfer, compress transfered data of file
50whose size is this value or above (up to `tramp-copy-size-limit').
51If it is nil, no compression at all will be applied."
52 :group 'tramp
53 :type '(choice (const nil) integer))
54
55(defcustom tramp-copy-size-limit 10240
56 "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
57If it is nil, inline out-of-the-band copy will be used without a check."
58 :group 'tramp
59 :type '(choice (const nil) integer))
60
61;;;###tramp-autoload
62(defcustom tramp-terminal-type "dumb"
63 "*Value of TERM environment variable for logging in to remote host.
64Because Tramp wants to parse the output of the remote shell, it is easily
65confused by ANSI color escape sequences and suchlike. Often, shell init
66files conditionalize this setup based on the TERM environment variable."
67 :group 'tramp
68 :type 'string)
69
70;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for
71;; root users. It uses the `$' character for other users. In order
72;; to guarantee a proper prompt, we use "#$" for the prompt.
73
74(defvar tramp-end-of-output
75 (format
76 "///%s#$"
77 (md5 (concat (prin1-to-string process-environment) (current-time-string))))
78 "String used to recognize end of output.
79The '$' character at the end is quoted; the string cannot be
80detected as prompt when being sent on echoing hosts, therefore.")
81
82;;;###tramp-autoload
83(defconst tramp-initial-end-of-output "#$ "
84 "Prompt when establishing a connection.")
85
86;; Initialize `tramp-methods' with the supported methods.
87;;;###tramp-autoload
88(add-to-list 'tramp-methods
89 '("rcp"
90 (tramp-login-program "rsh")
91 (tramp-login-args (("%h") ("-l" "%u")))
92 (tramp-remote-sh "/bin/sh")
93 (tramp-copy-program "rcp")
94 (tramp-copy-args (("-p" "%k") ("-r")))
95 (tramp-copy-keep-date t)
96 (tramp-copy-recursive t)))
97;;;###tramp-autoload
98(add-to-list 'tramp-methods
99 '("remcp"
100 (tramp-login-program "remsh")
101 (tramp-login-args (("%h") ("-l" "%u")))
102 (tramp-remote-sh "/bin/sh")
103 (tramp-copy-program "rcp")
104 (tramp-copy-args (("-p" "%k")))
105 (tramp-copy-keep-date t)))
106;;;###tramp-autoload
107(add-to-list
108 'tramp-methods
109 '("scp" (tramp-login-program "ssh")
110 (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
111 (tramp-async-args (("-q")))
112 (tramp-remote-sh "/bin/sh")
113 (tramp-copy-program "scp")
114 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")))
115 (tramp-copy-keep-date t)
116 (tramp-copy-recursive t)
117 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
118 ("-o" "UserKnownHostsFile=/dev/null")
119 ("-o" "StrictHostKeyChecking=no")))
120 (tramp-default-port 22)))
121;;;###tramp-autoload
122(add-to-list 'tramp-methods
123 '("scp1"
124 (tramp-login-program "ssh")
125 (tramp-login-args (("-l" "%u") ("-p" "%p")
126 ("-1") ("-e" "none") ("%h")))
127 (tramp-async-args (("-q")))
128 (tramp-remote-sh "/bin/sh")
129 (tramp-copy-program "scp")
130 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r")))
131 (tramp-copy-keep-date t)
132 (tramp-copy-recursive t)
133 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
134 ("-o" "UserKnownHostsFile=/dev/null")
135 ("-o" "StrictHostKeyChecking=no")))
136 (tramp-default-port 22)))
137;;;###tramp-autoload
138(add-to-list 'tramp-methods
139 '("scp2"
140 (tramp-login-program "ssh")
141 (tramp-login-args (("-l" "%u") ("-p" "%p")
142 ("-2") ("-e" "none") ("%h")))
143 (tramp-async-args (("-q")))
144 (tramp-remote-sh "/bin/sh")
145 (tramp-copy-program "scp")
146 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r")))
147 (tramp-copy-keep-date t)
148 (tramp-copy-recursive t)
149 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
150 ("-o" "UserKnownHostsFile=/dev/null")
151 ("-o" "StrictHostKeyChecking=no")))
152 (tramp-default-port 22)))
153;;;###tramp-autoload
154(add-to-list 'tramp-methods
155 '("scpc"
156 (tramp-login-program "ssh")
157 (tramp-login-args (("-l" "%u") ("-p" "%p")
158 ("-o" "ControlPath=%t.%%r@%%h:%%p")
159 ("-o" "ControlMaster=yes")
160 ("-e" "none") ("%h")))
161 (tramp-async-args (("-q")))
162 (tramp-remote-sh "/bin/sh")
163 (tramp-copy-program "scp")
164 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
165 ("-o" "ControlPath=%t.%%r@%%h:%%p")
166 ("-o" "ControlMaster=auto")))
167 (tramp-copy-keep-date t)
168 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
169 ("-o" "UserKnownHostsFile=/dev/null")
170 ("-o" "StrictHostKeyChecking=no")))
171 (tramp-default-port 22)))
172;;;###tramp-autoload
173(add-to-list 'tramp-methods
174 '("scpx"
175 (tramp-login-program "ssh")
176 (tramp-login-args (("-l" "%u") ("-p" "%p")
177 ("-e" "none") ("-t" "-t")
178 ("%h") ("/bin/sh")))
179 (tramp-async-args (("-q")))
180 (tramp-remote-sh "/bin/sh")
181 (tramp-copy-program "scp")
182 (tramp-copy-args (("-p" "%k")))
183 (tramp-copy-keep-date t)
184 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
185 ("-o" "UserKnownHostsFile=/dev/null")
186 ("-o" "StrictHostKeyChecking=no")))
187 (tramp-default-port 22)))
188;;;###tramp-autoload
189(add-to-list 'tramp-methods
190 '("sftp"
191 (tramp-login-program "ssh")
192 (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
193 (tramp-async-args (("-q")))
194 (tramp-remote-sh "/bin/sh")
195 (tramp-copy-program "sftp")))
196;;;###tramp-autoload
197(add-to-list 'tramp-methods
198 '("rsync"
199 (tramp-login-program "ssh")
200 (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
201 (tramp-async-args (("-q")))
202 (tramp-remote-sh "/bin/sh")
203 (tramp-copy-program "rsync")
204 (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
205 (tramp-copy-keep-date t)
206 (tramp-copy-keep-tmpfile t)
207 (tramp-copy-recursive t)))
208;;;###tramp-autoload
209(add-to-list 'tramp-methods
210 `("rsyncc"
211 (tramp-login-program "ssh")
212 (tramp-login-args (("-l" "%u") ("-p" "%p")
213 ("-o" "ControlPath=%t.%%r@%%h:%%p")
214 ("-o" "ControlMaster=yes")
215 ("-e" "none") ("%h")))
216 (tramp-async-args (("-q")))
217 (tramp-remote-sh "/bin/sh")
218 (tramp-copy-program "rsync")
219 (tramp-copy-args (("-t" "%k") ("-r")))
220 (tramp-copy-env (("RSYNC_RSH")
221 (,(concat
222 "ssh"
223 " -o ControlPath=%t.%%r@%%h:%%p"
224 " -o ControlMaster=auto"))))
225 (tramp-copy-keep-date t)
226 (tramp-copy-keep-tmpfile t)
227 (tramp-copy-recursive t)))
228;;;###tramp-autoload
229(add-to-list 'tramp-methods
230 '("rsh"
231 (tramp-login-program "rsh")
232 (tramp-login-args (("%h") ("-l" "%u")))
233 (tramp-remote-sh "/bin/sh")))
234;;;###tramp-autoload
235(add-to-list 'tramp-methods
236 '("remsh"
237 (tramp-login-program "remsh")
238 (tramp-login-args (("%h") ("-l" "%u")))
239 (tramp-remote-sh "/bin/sh")))
240;;;###tramp-autoload
241(add-to-list 'tramp-methods
242 '("ssh"
243 (tramp-login-program "ssh")
244 (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
245 (tramp-async-args (("-q")))
246 (tramp-remote-sh "/bin/sh")
247 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
248 ("-o" "UserKnownHostsFile=/dev/null")
249 ("-o" "StrictHostKeyChecking=no")))
250 (tramp-default-port 22)))
251;;;###tramp-autoload
252(add-to-list 'tramp-methods
253 '("ssh1"
254 (tramp-login-program "ssh")
255 (tramp-login-args (("-l" "%u") ("-p" "%p")
256 ("-1") ("-e" "none") ("%h")))
257 (tramp-async-args (("-q")))
258 (tramp-remote-sh "/bin/sh")
259 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
260 ("-o" "UserKnownHostsFile=/dev/null")
261 ("-o" "StrictHostKeyChecking=no")))
262 (tramp-default-port 22)))
263;;;###tramp-autoload
264(add-to-list 'tramp-methods
265 '("ssh2"
266 (tramp-login-program "ssh")
267 (tramp-login-args (("-l" "%u") ("-p" "%p")
268 ("-2") ("-e" "none") ("%h")))
269 (tramp-async-args (("-q")))
270 (tramp-remote-sh "/bin/sh")
271 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
272 ("-o" "UserKnownHostsFile=/dev/null")
273 ("-o" "StrictHostKeyChecking=no")))
274 (tramp-default-port 22)))
275;;;###tramp-autoload
276(add-to-list 'tramp-methods
277 '("sshx"
278 (tramp-login-program "ssh")
279 (tramp-login-args (("-l" "%u") ("-p" "%p")
280 ("-e" "none") ("-t" "-t")
281 ("%h") ("/bin/sh")))
282 (tramp-async-args (("-q")))
283 (tramp-remote-sh "/bin/sh")
284 (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
285 ("-o" "UserKnownHostsFile=/dev/null")
286 ("-o" "StrictHostKeyChecking=no")))
287 (tramp-default-port 22)))
288;;;###tramp-autoload
289(add-to-list 'tramp-methods
290 '("telnet"
291 (tramp-login-program "telnet")
292 (tramp-login-args (("%h") ("%p")))
293 (tramp-remote-sh "/bin/sh")
294 (tramp-default-port 23)))
295;;;###tramp-autoload
296(add-to-list 'tramp-methods
297 '("su"
298 (tramp-login-program "su")
299 (tramp-login-args (("-") ("%u")))
300 (tramp-remote-sh "/bin/sh")))
301;;;###tramp-autoload
302(add-to-list 'tramp-methods
303 '("sudo"
304 (tramp-login-program "sudo")
305 (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:")))
306 (tramp-remote-sh "/bin/sh")))
307;;;###tramp-autoload
308(add-to-list 'tramp-methods
309 '("krlogin"
310 (tramp-login-program "krlogin")
311 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
312 (tramp-remote-sh "/bin/sh")))
313;;;###tramp-autoload
314(add-to-list 'tramp-methods
315 '("plink"
316 (tramp-login-program "plink")
317 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
318 (tramp-remote-sh "/bin/sh")
319 (tramp-password-end-of-line "xy") ;see docstring for "xy"
320 (tramp-default-port 22)))
321;;;###tramp-autoload
322(add-to-list 'tramp-methods
323 '("plink1"
324 (tramp-login-program "plink")
325 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
326 (tramp-remote-sh "/bin/sh")
327 (tramp-password-end-of-line "xy") ;see docstring for "xy"
328 (tramp-default-port 22)))
329;;;###tramp-autoload
330(add-to-list 'tramp-methods
331 `("plinkx"
332 (tramp-login-program "plink")
333 ;; ("%h") must be a single element, see
334 ;; `tramp-compute-multi-hops'.
335 (tramp-login-args (("-load") ("%h") ("-t")
336 (,(format
337 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
338 tramp-terminal-type
339 tramp-initial-end-of-output))
340 ("/bin/sh")))
341 (tramp-remote-sh "/bin/sh")))
342;;;###tramp-autoload
343(add-to-list 'tramp-methods
344 '("pscp"
345 (tramp-login-program "plink")
346 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
347 (tramp-remote-sh "/bin/sh")
348 (tramp-copy-program "pscp")
349 (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
350 (tramp-copy-keep-date t)
351 (tramp-password-end-of-line "xy") ;see docstring for "xy"
352 (tramp-default-port 22)))
353;;;###tramp-autoload
354(add-to-list 'tramp-methods
355 '("psftp"
356 (tramp-login-program "plink")
357 (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
358 (tramp-remote-sh "/bin/sh")
359 (tramp-copy-program "pscp")
360 (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
361 (tramp-copy-keep-date t)
362 (tramp-password-end-of-line "xy"))) ;see docstring for "xy"
363;;;###tramp-autoload
364(add-to-list 'tramp-methods
365 '("fcp"
366 (tramp-login-program "fsh")
367 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
368 (tramp-remote-sh "/bin/sh -i")
369 (tramp-copy-program "fcp")
370 (tramp-copy-args (("-p" "%k")))
371 (tramp-copy-keep-date t)))
372
373(add-to-list 'tramp-default-method-alist
374 `(,tramp-local-host-regexp "\\`root\\'" "su"))
375
376(add-to-list 'tramp-default-user-alist
377 '("\\`su\\(do\\)?\\'" nil "root"))
378(add-to-list 'tramp-default-user-alist
379 `("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
380 nil ,(user-login-name)))
381
382(defconst tramp-completion-function-alist-rsh
383 '((tramp-parse-rhosts "/etc/hosts.equiv")
384 (tramp-parse-rhosts "~/.rhosts"))
385 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
386
387(defconst tramp-completion-function-alist-ssh
388 '((tramp-parse-rhosts "/etc/hosts.equiv")
389 (tramp-parse-rhosts "/etc/shosts.equiv")
390 (tramp-parse-shosts "/etc/ssh_known_hosts")
391 (tramp-parse-sconfig "/etc/ssh_config")
392 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
393 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
394 (tramp-parse-rhosts "~/.rhosts")
395 (tramp-parse-rhosts "~/.shosts")
396 (tramp-parse-shosts "~/.ssh/known_hosts")
397 (tramp-parse-sconfig "~/.ssh/config")
398 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
399 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
400 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
401
402(defconst tramp-completion-function-alist-telnet
403 '((tramp-parse-hosts "/etc/hosts"))
404 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
405
406(defconst tramp-completion-function-alist-su
407 '((tramp-parse-passwd "/etc/passwd"))
408 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
409
410(defconst tramp-completion-function-alist-putty
411 '((tramp-parse-putty
412 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
413 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
414
415(tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh)
416(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
417(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
418(tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh)
419(tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh)
420(tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh)
421(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
422(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
423(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
424(tramp-set-completion-function "rsyncc" tramp-completion-function-alist-ssh)
425(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
426(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
427(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
428(tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh)
429(tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh)
430(tramp-set-completion-function "ssh1_old" tramp-completion-function-alist-ssh)
431(tramp-set-completion-function "ssh2_old" tramp-completion-function-alist-ssh)
432(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
433(tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet)
434(tramp-set-completion-function "su" tramp-completion-function-alist-su)
435(tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
436(tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh)
437(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
438(tramp-set-completion-function "plink1" tramp-completion-function-alist-ssh)
439(tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty)
440(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
441(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)
442
443;; "getconf PATH" yields:
444;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
445;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
446;; GNU/Linux (Debian, Suse): /bin:/usr/bin
447;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
448;; IRIX64: /usr/bin
449(defcustom tramp-remote-path
450 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
451 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
452 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
453 "*List of directories to search for executables on remote host.
454For every remote host, this variable will be set buffer local,
455keeping the list of existing directories on that host.
456
457You can use `~' in this list, but when searching for a shell which groks
458tilde expansion, all directory names starting with `~' will be ignored.
459
460`Default Directories' represent the list of directories given by
461the command \"getconf PATH\". It is recommended to use this
462entry on top of this list, because these are the default
463directories for POSIX compatible commands.
464
465`Private Directories' are the settings of the $PATH environment,
466as given in your `~/.profile'."
467 :group 'tramp
468 :type '(repeat (choice
469 (const :tag "Default Directories" tramp-default-remote-path)
470 (const :tag "Private Directories" tramp-own-remote-path)
471 (string :tag "Directory"))))
472
473(defcustom tramp-remote-process-environment
474 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
475 ,(format "TERM=%s" tramp-terminal-type)
476 "EMACS=t" ;; Deprecated.
477 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
478 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
479 "autocorrect=" "correct=")
480
481 "*List of environment variables to be set on the remote host.
482
483Each element should be a string of the form ENVVARNAME=VALUE. An
484entry ENVVARNAME= diables the corresponding environment variable,
485which might have been set in the init files like ~/.profile.
486
487Special handling is applied to the PATH environment, which should
488not be set here. Instead of, it should be set via `tramp-remote-path'."
489 :group 'tramp
490 :type '(repeat string))
491
492(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
493 "*Alist specifying extra arguments to pass to the remote shell.
494Entries are (REGEXP . ARGS) where REGEXP is a regular expression
495matching the shell file name and ARGS is a string specifying the
496arguments.
497
498This variable is only used when Tramp needs to start up another shell
499for tilde expansion. The extra arguments should typically prevent the
500shell from reading its init file."
501 :group 'tramp
502 ;; This might be the wrong way to test whether the widget type
503 ;; `alist' is available. Who knows the right way to test it?
504 :type (if (get 'alist 'widget-type)
505 '(alist :key-type string :value-type string)
506 '(repeat (cons string string))))
507
508(defconst tramp-actions-before-shell
509 '((tramp-login-prompt-regexp tramp-action-login)
510 (tramp-password-prompt-regexp tramp-action-password)
511 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
512 (shell-prompt-pattern tramp-action-succeed)
513 (tramp-shell-prompt-pattern tramp-action-succeed)
514 (tramp-yesno-prompt-regexp tramp-action-yesno)
515 (tramp-yn-prompt-regexp tramp-action-yn)
516 (tramp-terminal-prompt-regexp tramp-action-terminal)
517 (tramp-process-alive-regexp tramp-action-process-alive))
518 "List of pattern/action pairs.
519Whenever a pattern matches, the corresponding action is performed.
520Each item looks like (PATTERN ACTION).
521
522The PATTERN should be a symbol, a variable. The value of this
523variable gives the regular expression to search for. Note that the
524regexp must match at the end of the buffer, \"\\'\" is implicitly
525appended to it.
526
527The ACTION should also be a symbol, but a function. When the
528corresponding PATTERN matches, the ACTION function is called.")
529
530(defconst tramp-actions-copy-out-of-band
531 '((tramp-password-prompt-regexp tramp-action-password)
532 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
533 (tramp-copy-failed-regexp tramp-action-permission-denied)
534 (tramp-process-alive-regexp tramp-action-out-of-band))
535 "List of pattern/action pairs.
536This list is used for copying/renaming with out-of-band methods.
537
538See `tramp-actions-before-shell' for more info.")
539
540(defconst tramp-uudecode
541 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
542cat /tmp/tramp.$$
543rm -f /tmp/tramp.$$"
544 "Shell function to implement `uudecode' to standard output.
545Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
546for this or `uudecode -p', but some systems don't, and for them
547we have this shell function.")
548
549(defconst tramp-perl-file-truename
550 "%s -e '
551use File::Spec;
552use Cwd \"realpath\";
553
554sub recursive {
555 my ($volume, @dirs) = @_;
556 my $real = realpath(File::Spec->catpath(
557 $volume, File::Spec->catdir(@dirs), \"\"));
558 if ($real) {
559 my ($vol, $dir) = File::Spec->splitpath($real, 1);
560 return ($vol, File::Spec->splitdir($dir));
561 }
562 else {
563 my $last = pop(@dirs);
564 ($volume, @dirs) = recursive($volume, @dirs);
565 push(@dirs, $last);
566 return ($volume, @dirs);
567 }
568}
569
570$result = realpath($ARGV[0]);
571if (!$result) {
572 my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
573 ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
574
575 $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
576}
577
578if ($ARGV[0] =~ /\\/$/) {
579 $result = $result . \"/\";
580}
581
582print \"\\\"$result\\\"\\n\";
583' \"$1\" 2>/dev/null"
584 "Perl script to produce output suitable for use with `file-truename'
585on the remote file system.
586Escape sequence %s is replaced with name of Perl binary.
587This string is passed to `format', so percent characters need to be doubled.")
588
589(defconst tramp-perl-file-name-all-completions
590 "%s -e 'sub case {
591 my $str = shift;
592 if ($ARGV[2]) {
593 return lc($str);
594 }
595 else {
596 return $str;
597 }
598}
599opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
600@files = readdir(d); closedir(d);
601foreach $f (@files) {
602 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
603 if (-d \"$ARGV[0]/$f\") {
604 print \"$f/\\n\";
605 }
606 else {
607 print \"$f\\n\";
608 }
609 }
610}
611print \"ok\\n\"
612' \"$1\" \"$2\" \"$3\" 2>/dev/null"
613 "Perl script to produce output suitable for use with
614`file-name-all-completions' on the remote file system. Escape
615sequence %s is replaced with name of Perl binary. This string is
616passed to `format', so percent characters need to be doubled.")
617
618;; Perl script to implement `file-attributes' in a Lisp `read'able
619;; output. If you are hacking on this, note that you get *no* output
620;; unless this spits out a complete line, including the '\n' at the
621;; end.
622;; The device number is returned as "-1", because there will be a virtual
623;; device number set in `tramp-handle-file-attributes'.
624(defconst tramp-perl-file-attributes
625 "%s -e '
626@stat = lstat($ARGV[0]);
627if (!@stat) {
628 print \"nil\\n\";
629 exit 0;
630}
631if (($stat[2] & 0170000) == 0120000)
632{
633 $type = readlink($ARGV[0]);
634 $type = \"\\\"$type\\\"\";
635}
636elsif (($stat[2] & 0170000) == 040000)
637{
638 $type = \"t\";
639}
640else
641{
642 $type = \"nil\"
643};
644$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
645$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
646printf(
647 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\",
648 $type,
649 $stat[3],
650 $uid,
651 $gid,
652 $stat[8] >> 16 & 0xffff,
653 $stat[8] & 0xffff,
654 $stat[9] >> 16 & 0xffff,
655 $stat[9] & 0xffff,
656 $stat[10] >> 16 & 0xffff,
657 $stat[10] & 0xffff,
658 $stat[7],
659 $stat[2],
660 $stat[1] >> 16 & 0xffff,
661 $stat[1] & 0xffff
662);' \"$1\" \"$2\" 2>/dev/null"
663 "Perl script to produce output suitable for use with `file-attributes'
664on the remote file system.
665Escape sequence %s is replaced with name of Perl binary.
666This string is passed to `format', so percent characters need to be doubled.")
667
668(defconst tramp-perl-directory-files-and-attributes
669 "%s -e '
670chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
671opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
672@list = readdir(DIR);
673closedir(DIR);
674$n = scalar(@list);
675printf(\"(\\n\");
676for($i = 0; $i < $n; $i++)
677{
678 $filename = $list[$i];
679 @stat = lstat($filename);
680 if (($stat[2] & 0170000) == 0120000)
681 {
682 $type = readlink($filename);
683 $type = \"\\\"$type\\\"\";
684 }
685 elsif (($stat[2] & 0170000) == 040000)
686 {
687 $type = \"t\";
688 }
689 else
690 {
691 $type = \"nil\"
692 };
693 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
694 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
695 printf(
696 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
697 $filename,
698 $type,
699 $stat[3],
700 $uid,
701 $gid,
702 $stat[8] >> 16 & 0xffff,
703 $stat[8] & 0xffff,
704 $stat[9] >> 16 & 0xffff,
705 $stat[9] & 0xffff,
706 $stat[10] >> 16 & 0xffff,
707 $stat[10] & 0xffff,
708 $stat[7],
709 $stat[2],
710 $stat[1] >> 16 & 0xffff,
711 $stat[1] & 0xffff,
712 $stat[0] >> 16 & 0xffff,
713 $stat[0] & 0xffff);
714}
715printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
716 "Perl script implementing `directory-files-attributes' as Lisp `read'able
717output.
718Escape sequence %s is replaced with name of Perl binary.
719This string is passed to `format', so percent characters need to be doubled.")
720
721;; These two use base64 encoding.
722(defconst tramp-perl-encode-with-module
723 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
724 "Perl program to use for encoding a file.
725Escape sequence %s is replaced with name of Perl binary.
726This string is passed to `format', so percent characters need to be doubled.
727This implementation requires the MIME::Base64 Perl module to be installed
728on the remote host.")
729
730(defconst tramp-perl-decode-with-module
731 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
732 "Perl program to use for decoding a file.
733Escape sequence %s is replaced with name of Perl binary.
734This string is passed to `format', so percent characters need to be doubled.
735This implementation requires the MIME::Base64 Perl module to be installed
736on the remote host.")
737
738(defconst tramp-perl-encode
739 "%s -e '
740# This script contributed by Juanma Barranquero <lektu@terra.es>.
741# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
742# Free Software Foundation, Inc.
743use strict;
744
745my %%trans = do {
746 my $i = 0;
747 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
748 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
749};
750
751binmode(\\*STDIN);
752
753# We read in chunks of 54 bytes, to generate output lines
754# of 72 chars (plus end of line)
755$/ = \\54;
756
757while (my $data = <STDIN>) {
758 my $pad = q();
759
760 # Only for the last chunk, and only if did not fill the last three-byte packet
761 if (eof) {
762 my $mod = length($data) %% 3;
763 $pad = q(=) x (3 - $mod) if $mod;
764 }
765
766 # Not the fastest method, but it is simple: unpack to binary string, split
767 # by groups of 6 bits and convert back from binary to byte; then map into
768 # the translation table
769 print
770 join q(),
771 map($trans{$_},
772 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
773 $pad,
774 qq(\\n);
775}' 2>/dev/null"
776 "Perl program to use for encoding a file.
777Escape sequence %s is replaced with name of Perl binary.
778This string is passed to `format', so percent characters need to be doubled.")
779
780(defconst tramp-perl-decode
781 "%s -e '
782# This script contributed by Juanma Barranquero <lektu@terra.es>.
783# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
784# Free Software Foundation, Inc.
785use strict;
786
787my %%trans = do {
788 my $i = 0;
789 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
790 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
791};
792
793my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
794
795binmode(\\*STDOUT);
796
797# We are going to accumulate into $pending to accept any line length
798# (we do not check they are <= 76 chars as the RFC says)
799my $pending = q();
800
801while (my $data = <STDIN>) {
802 chomp $data;
803
804 # If we find one or two =, we have reached the end and
805 # any following data is to be discarded
806 my $finished = $data =~ s/(==?).*/$1/;
807 $pending .= $data;
808
809 my $len = length($pending);
810 my $chunk = substr($pending, 0, $len & ~3);
811 $pending = substr($pending, $len & ~3 + 1);
812
813 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
814 # split in 8-bit chunks and convert back to char.
815 print join q(),
816 map $bytes{$_},
817 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
818
819 last if $finished;
820}' 2>/dev/null"
821 "Perl program to use for decoding a file.
822Escape sequence %s is replaced with name of Perl binary.
823This string is passed to `format', so percent characters need to be doubled.")
824
825(defconst tramp-vc-registered-read-file-names
826 "echo \"(\"
827while read file; do
828 if %s \"$file\"; then
829 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
830 else
831 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
832 fi
833 if %s \"$file\"; then
834 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
835 else
836 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
837 fi
838done
839echo \")\""
840 "Script to check existence of VC related files.
841It must be send formatted with two strings; the tests for file
842existence, and file readability. Input shall be read via
843here-document, otherwise the command could exceed maximum length
844of command line.")
845
846(defconst tramp-file-mode-type-map
847 '((0 . "-") ; Normal file (SVID-v2 and XPG2)
848 (1 . "p") ; fifo
849 (2 . "c") ; character device
850 (3 . "m") ; multiplexed character device (v7)
851 (4 . "d") ; directory
852 (5 . "?") ; Named special file (XENIX)
853 (6 . "b") ; block device
854 (7 . "?") ; multiplexed block device (v7)
855 (8 . "-") ; regular file
856 (9 . "n") ; network special file (HP-UX)
857 (10 . "l") ; symlink
858 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
859 (12 . "s") ; socket
860 (13 . "D") ; door special (Solaris)
861 (14 . "w")) ; whiteout (BSD)
862 "A list of file types returned from the `stat' system call.
863This is used to map a mode number to a permission string.")
864
865;; New handlers should be added here. The following operations can be
866;; handled using the normal primitives: file-name-sans-versions,
867;; get-file-buffer.
868(defconst tramp-sh-file-name-handler-alist
869 '((load . tramp-handle-load)
870 (make-symbolic-link . tramp-handle-make-symbolic-link)
871 (file-name-as-directory . tramp-handle-file-name-as-directory)
872 (file-name-directory . tramp-handle-file-name-directory)
873 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
874 (file-truename . tramp-handle-file-truename)
875 (file-exists-p . tramp-handle-file-exists-p)
876 (file-directory-p . tramp-handle-file-directory-p)
877 (file-executable-p . tramp-handle-file-executable-p)
878 (file-readable-p . tramp-handle-file-readable-p)
879 (file-regular-p . tramp-handle-file-regular-p)
880 (file-symlink-p . tramp-handle-file-symlink-p)
881 (file-writable-p . tramp-handle-file-writable-p)
882 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
883 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
884 (file-attributes . tramp-handle-file-attributes)
885 (file-modes . tramp-handle-file-modes)
886 (directory-files . tramp-handle-directory-files)
887 (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
888 (file-name-all-completions . tramp-handle-file-name-all-completions)
889 (file-name-completion . tramp-handle-file-name-completion)
890 (add-name-to-file . tramp-handle-add-name-to-file)
891 (copy-file . tramp-handle-copy-file)
892 (copy-directory . tramp-handle-copy-directory)
893 (rename-file . tramp-handle-rename-file)
894 (set-file-modes . tramp-handle-set-file-modes)
895 (set-file-times . tramp-handle-set-file-times)
896 (make-directory . tramp-handle-make-directory)
897 (delete-directory . tramp-handle-delete-directory)
898 (delete-file . tramp-handle-delete-file)
899 (directory-file-name . tramp-handle-directory-file-name)
900 ;; `executable-find' is not official yet.
901 (executable-find . tramp-handle-executable-find)
902 (start-file-process . tramp-handle-start-file-process)
903 (process-file . tramp-handle-process-file)
904 (shell-command . tramp-handle-shell-command)
905 (insert-directory . tramp-handle-insert-directory)
906 (expand-file-name . tramp-handle-expand-file-name)
907 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
908 (file-local-copy . tramp-handle-file-local-copy)
909 (file-remote-p . tramp-handle-file-remote-p)
910 (insert-file-contents . tramp-handle-insert-file-contents)
911 (insert-file-contents-literally
912 . tramp-handle-insert-file-contents-literally)
913 (write-region . tramp-handle-write-region)
914 (find-backup-file-name . tramp-handle-find-backup-file-name)
915 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
916 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
917 (dired-compress-file . tramp-handle-dired-compress-file)
918 (dired-recursive-delete-directory
919 . tramp-handle-dired-recursive-delete-directory)
920 (dired-uncache . tramp-handle-dired-uncache)
921 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
922 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
923 (file-selinux-context . tramp-handle-file-selinux-context)
924 (set-file-selinux-context . tramp-handle-set-file-selinux-context)
925 (vc-registered . tramp-handle-vc-registered))
926 "Alist of handler functions.
927Operations not mentioned here will be handled by the normal Emacs functions.")
928
929;; This must be the last entry, because `identity' always matches.
930;;;###tramp-autoload
931(add-to-list 'tramp-foreign-file-name-handler-alist
932 '(identity . tramp-sh-file-name-handler) 'append)
933
934;;; File Name Handler Functions:
935
936(defun tramp-handle-make-symbolic-link
937 (filename linkname &optional ok-if-already-exists)
938 "Like `make-symbolic-link' for Tramp files.
939If LINKNAME is a non-Tramp file, it is used verbatim as the target of
940the symlink. If LINKNAME is a Tramp file, only the localname component is
941used as the target of the symlink.
942
943If LINKNAME is a Tramp file and the localname component is relative, then
944it is expanded first, before the localname component is taken. Note that
945this can give surprising results if the user/host for the source and
946target of the symlink differ."
947 (with-parsed-tramp-file-name linkname l
948 (let ((ln (tramp-get-remote-ln l))
949 (cwd (tramp-run-real-handler
950 'file-name-directory (list l-localname))))
951 (unless ln
952 (tramp-error
953 l 'file-error
954 "Making a symbolic link. ln(1) does not exist on the remote host."))
955
956 ;; Do the 'confirm if exists' thing.
957 (when (file-exists-p linkname)
958 ;; What to do?
959 (if (or (null ok-if-already-exists) ; not allowed to exist
960 (and (numberp ok-if-already-exists)
961 (not (yes-or-no-p
962 (format
963 "File %s already exists; make it a link anyway? "
964 l-localname)))))
965 (tramp-error
966 l 'file-already-exists "File %s already exists" l-localname)
967 (delete-file linkname)))
968
969 ;; If FILENAME is a Tramp name, use just the localname component.
970 (when (tramp-tramp-file-p filename)
971 (setq filename
972 (tramp-file-name-localname
973 (tramp-dissect-file-name (expand-file-name filename)))))
974
975 (tramp-flush-file-property l (file-name-directory l-localname))
976 (tramp-flush-file-property l l-localname)
977
978 ;; Right, they are on the same host, regardless of user, method, etc.
979 ;; We now make the link on the remote machine. This will occur as the user
980 ;; that FILENAME belongs to.
981 (tramp-send-command-and-check
982 l
983 (format
984 "cd %s && %s -sf %s %s"
985 (tramp-shell-quote-argument cwd)
986 ln
987 (tramp-shell-quote-argument filename)
988 (tramp-shell-quote-argument l-localname))
989 t))))
990
991(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
992 "Like `load' for Tramp files."
993 (with-parsed-tramp-file-name (expand-file-name file) nil
994 (unless nosuffix
995 (cond ((file-exists-p (concat file ".elc"))
996 (setq file (concat file ".elc")))
997 ((file-exists-p (concat file ".el"))
998 (setq file (concat file ".el")))))
999 (when must-suffix
1000 ;; The first condition is always true for absolute file names.
1001 ;; Included for safety's sake.
1002 (unless (or (file-name-directory file)
1003 (string-match "\\.elc?\\'" file))
1004 (tramp-error
1005 v 'file-error
1006 "File `%s' does not include a `.el' or `.elc' suffix" file)))
1007 (unless noerror
1008 (when (not (file-exists-p file))
1009 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
1010 (if (not (file-exists-p file))
1011 nil
1012 (let ((tramp-message-show-message (not nomessage)))
1013 (with-progress-reporter v 0 (format "Loading %s" file)
1014 (let ((local-copy (file-local-copy file)))
1015 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
1016 (unwind-protect
1017 (load local-copy noerror t t)
1018 (delete-file local-copy)))))
1019 t)))
1020
1021;; Localname manipulation functions that grok Tramp localnames...
1022(defun tramp-handle-file-name-as-directory (file)
1023 "Like `file-name-as-directory' but aware of Tramp files."
1024 ;; `file-name-as-directory' would be sufficient except localname is
1025 ;; the empty string.
1026 (let ((v (tramp-dissect-file-name file t)))
1027 ;; Run the command on the localname portion only.
1028 (tramp-make-tramp-file-name
1029 (tramp-file-name-method v)
1030 (tramp-file-name-user v)
1031 (tramp-file-name-host v)
1032 (tramp-run-real-handler
1033 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
1034
1035(defun tramp-handle-file-name-directory (file)
1036 "Like `file-name-directory' but aware of Tramp files."
1037 ;; Everything except the last filename thing is the directory. We
1038 ;; cannot apply `with-parsed-tramp-file-name', because this expands
1039 ;; the remote file name parts. This is a problem when we are in
1040 ;; file name completion.
1041 (let ((v (tramp-dissect-file-name file t)))
1042 ;; Run the command on the localname portion only.
1043 (tramp-make-tramp-file-name
1044 (tramp-file-name-method v)
1045 (tramp-file-name-user v)
1046 (tramp-file-name-host v)
1047 (tramp-run-real-handler
1048 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
1049
1050(defun tramp-handle-file-name-nondirectory (file)
1051 "Like `file-name-nondirectory' but aware of Tramp files."
1052 (with-parsed-tramp-file-name file nil
1053 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
1054
1055(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
1056 "Like `file-truename' for Tramp files."
1057 (with-parsed-tramp-file-name (expand-file-name filename) nil
1058 (with-file-property v localname "file-truename"
1059 (let ((result nil)) ; result steps in reverse order
1060 (tramp-message v 4 "Finding true name for `%s'" filename)
1061 (cond
1062 ;; Use GNU readlink --canonicalize-missing where available.
1063 ((tramp-get-remote-readlink v)
1064 (setq result
1065 (tramp-send-command-and-read
1066 v
1067 (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
1068 (tramp-get-remote-readlink v)
1069 (tramp-shell-quote-argument localname)))))
1070
1071 ;; Use Perl implementation.
1072 ((and (tramp-get-remote-perl v)
1073 (tramp-get-connection-property v "perl-file-spec" nil)
1074 (tramp-get-connection-property v "perl-cwd-realpath" nil))
1075 (tramp-maybe-send-script
1076 v tramp-perl-file-truename "tramp_perl_file_truename")
1077 (setq result
1078 (tramp-send-command-and-read
1079 v
1080 (format "tramp_perl_file_truename %s"
1081 (tramp-shell-quote-argument localname)))))
1082
1083 ;; Do it yourself. We bind `directory-sep-char' here for
1084 ;; XEmacs on Windows, which would otherwise use backslash.
1085 (t (let* ((directory-sep-char ?/)
1086 (steps (tramp-compat-split-string localname "/"))
1087 (localnamedir (tramp-run-real-handler
1088 'file-name-as-directory (list localname)))
1089 (is-dir (string= localname localnamedir))
1090 (thisstep nil)
1091 (numchase 0)
1092 ;; Don't make the following value larger than
1093 ;; necessary. People expect an error message in a
1094 ;; timely fashion when something is wrong;
1095 ;; otherwise they might think that Emacs is hung.
1096 ;; Of course, correctness has to come first.
1097 (numchase-limit 20)
1098 symlink-target)
1099 (while (and steps (< numchase numchase-limit))
1100 (setq thisstep (pop steps))
1101 (tramp-message
1102 v 5 "Check %s"
1103 (mapconcat 'identity
1104 (append '("") (reverse result) (list thisstep))
1105 "/"))
1106 (setq symlink-target
1107 (nth 0 (file-attributes
1108 (tramp-make-tramp-file-name
1109 method user host
1110 (mapconcat 'identity
1111 (append '("")
1112 (reverse result)
1113 (list thisstep))
1114 "/")))))
1115 (cond ((string= "." thisstep)
1116 (tramp-message v 5 "Ignoring step `.'"))
1117 ((string= ".." thisstep)
1118 (tramp-message v 5 "Processing step `..'")
1119 (pop result))
1120 ((stringp symlink-target)
1121 ;; It's a symlink, follow it.
1122 (tramp-message v 5 "Follow symlink to %s" symlink-target)
1123 (setq numchase (1+ numchase))
1124 (when (file-name-absolute-p symlink-target)
1125 (setq result nil))
1126 ;; If the symlink was absolute, we'll get a string like
1127 ;; "/user@host:/some/target"; extract the
1128 ;; "/some/target" part from it.
1129 (when (tramp-tramp-file-p symlink-target)
1130 (unless (tramp-equal-remote filename symlink-target)
1131 (tramp-error
1132 v 'file-error
1133 "Symlink target `%s' on wrong host" symlink-target))
1134 (setq symlink-target localname))
1135 (setq steps
1136 (append (tramp-compat-split-string
1137 symlink-target "/")
1138 steps)))
1139 (t
1140 ;; It's a file.
1141 (setq result (cons thisstep result)))))
1142 (when (>= numchase numchase-limit)
1143 (tramp-error
1144 v 'file-error
1145 "Maximum number (%d) of symlinks exceeded" numchase-limit))
1146 (setq result (reverse result))
1147 ;; Combine list to form string.
1148 (setq result
1149 (if result
1150 (mapconcat 'identity (cons "" result) "/")
1151 "/"))
1152 (when (and is-dir (or (string= "" result)
1153 (not (string= (substring result -1) "/"))))
1154 (setq result (concat result "/"))))))
1155
1156 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
1157 (tramp-make-tramp-file-name method user host result)))))
1158
1159;; Basic functions.
1160
1161(defun tramp-handle-file-exists-p (filename)
1162 "Like `file-exists-p' for Tramp files."
1163 (with-parsed-tramp-file-name filename nil
1164 (with-file-property v localname "file-exists-p"
1165 (or (not (null (tramp-get-file-property
1166 v localname "file-attributes-integer" nil)))
1167 (not (null (tramp-get-file-property
1168 v localname "file-attributes-string" nil)))
1169 (tramp-send-command-and-check
1170 v
1171 (format
1172 "%s %s"
1173 (tramp-get-file-exists-command v)
1174 (tramp-shell-quote-argument localname)))))))
1175
1176;; CCC: This should check for an error condition and signal failure
1177;; when something goes wrong.
1178;; Daniel Pittman <daniel@danann.net>
1179(defun tramp-handle-file-attributes (filename &optional id-format)
1180 "Like `file-attributes' for Tramp files."
1181 (unless id-format (setq id-format 'integer))
1182 ;; Don't modify `last-coding-system-used' by accident.
1183 (let ((last-coding-system-used last-coding-system-used))
1184 (with-parsed-tramp-file-name (expand-file-name filename) nil
1185 (with-file-property v localname (format "file-attributes-%s" id-format)
1186 (save-excursion
1187 (tramp-convert-file-attributes
1188 v
1189 (cond
1190 ((tramp-get-remote-stat v)
1191 (tramp-do-file-attributes-with-stat v localname id-format))
1192 ((tramp-get-remote-perl v)
1193 (tramp-do-file-attributes-with-perl v localname id-format))
1194 (t
1195 (tramp-do-file-attributes-with-ls v localname id-format)))))))))
1196
1197(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
1198 "Implement `file-attributes' for Tramp files using the ls(1) command."
1199 (let (symlinkp dirp
1200 res-inode res-filemodes res-numlinks
1201 res-uid res-gid res-size res-symlink-target)
1202 (tramp-message vec 5 "file attributes with ls: %s" localname)
1203 (tramp-send-command
1204 vec
1205 (format "(%s %s || %s -h %s) && %s %s %s"
1206 (tramp-get-file-exists-command vec)
1207 (tramp-shell-quote-argument localname)
1208 (tramp-get-test-command vec)
1209 (tramp-shell-quote-argument localname)
1210 (tramp-get-ls-command vec)
1211 (if (eq id-format 'integer) "-ildn" "-ild")
1212 (tramp-shell-quote-argument localname)))
1213 ;; parse `ls -l' output ...
1214 (with-current-buffer (tramp-get-buffer vec)
1215 (when (> (buffer-size) 0)
1216 (goto-char (point-min))
1217 ;; ... inode
1218 (setq res-inode
1219 (condition-case err
1220 (read (current-buffer))
1221 (invalid-read-syntax
1222 (when (and (equal (cadr err)
1223 "Integer constant overflow in reader")
1224 (string-match
1225 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
1226 (car (cddr err))))
1227 (let* ((big (read (substring (car (cddr err)) 0
1228 (match-beginning 1))))
1229 (small (read (match-string 1 (car (cddr err)))))
1230 (twiddle (/ small 65536)))
1231 (cons (+ big twiddle)
1232 (- small (* twiddle 65536))))))))
1233 ;; ... file mode flags
1234 (setq res-filemodes (symbol-name (read (current-buffer))))
1235 ;; ... number links
1236 (setq res-numlinks (read (current-buffer)))
1237 ;; ... uid and gid
1238 (setq res-uid (read (current-buffer)))
1239 (setq res-gid (read (current-buffer)))
1240 (if (eq id-format 'integer)
1241 (progn
1242 (unless (numberp res-uid) (setq res-uid -1))
1243 (unless (numberp res-gid) (setq res-gid -1)))
1244 (progn
1245 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
1246 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
1247 ;; ... size
1248 (setq res-size (read (current-buffer)))
1249 ;; From the file modes, figure out other stuff.
1250 (setq symlinkp (eq ?l (aref res-filemodes 0)))
1251 (setq dirp (eq ?d (aref res-filemodes 0)))
1252 ;; if symlink, find out file name pointed to
1253 (when symlinkp
1254 (search-forward "-> ")
1255 (setq res-symlink-target
1256 (buffer-substring (point) (tramp-compat-line-end-position))))
1257 ;; return data gathered
1258 (list
1259 ;; 0. t for directory, string (name linked to) for symbolic
1260 ;; link, or nil.
1261 (or dirp res-symlink-target)
1262 ;; 1. Number of links to file.
1263 res-numlinks
1264 ;; 2. File uid.
1265 res-uid
1266 ;; 3. File gid.
1267 res-gid
1268 ;; 4. Last access time, as a list of two integers. First
1269 ;; integer has high-order 16 bits of time, second has low 16
1270 ;; bits.
1271 ;; 5. Last modification time, likewise.
1272 ;; 6. Last status change time, likewise.
1273 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
1274 ;; 7. Size in bytes (-1, if number is out of range).
1275 res-size
1276 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
1277 res-filemodes
1278 ;; 9. t if file's gid would change if file were deleted and
1279 ;; recreated. Will be set in `tramp-convert-file-attributes'
1280 t
1281 ;; 10. inode number.
1282 res-inode
1283 ;; 11. Device number. Will be replaced by a virtual device number.
1284 -1
1285 )))))
1286
1287(defun tramp-do-file-attributes-with-perl
1288 (vec localname &optional id-format)
1289 "Implement `file-attributes' for Tramp files using a Perl script."
1290 (tramp-message vec 5 "file attributes with perl: %s" localname)
1291 (tramp-maybe-send-script
1292 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
1293 (tramp-send-command-and-read
1294 vec
1295 (format "tramp_perl_file_attributes %s %s"
1296 (tramp-shell-quote-argument localname) id-format)))
1297
1298(defun tramp-do-file-attributes-with-stat
1299 (vec localname &optional id-format)
1300 "Implement `file-attributes' for Tramp files using stat(1) command."
1301 (tramp-message vec 5 "file attributes with stat: %s" localname)
1302 (tramp-send-command-and-read
1303 vec
1304 (format
1305 ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
1306 ;; parse correctly the sequence "((". Therefore, we add a space.
1307 "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)"
1308 (tramp-get-file-exists-command vec)
1309 (tramp-shell-quote-argument localname)
1310 (tramp-get-test-command vec)
1311 (tramp-shell-quote-argument localname)
1312 (tramp-get-remote-stat vec)
1313 (if (eq id-format 'integer) "%u" "\"%U\"")
1314 (if (eq id-format 'integer) "%g" "\"%G\"")
1315 (tramp-shell-quote-argument localname))))
1316
1317(defun tramp-handle-set-visited-file-modtime (&optional time-list)
1318 "Like `set-visited-file-modtime' for Tramp files."
1319 (unless (buffer-file-name)
1320 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
1321 (buffer-name)))
1322 (if time-list
1323 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
1324 (let ((f (buffer-file-name))
1325 coding-system-used)
1326 (with-parsed-tramp-file-name f nil
1327 (let* ((attr (file-attributes f))
1328 ;; '(-1 65535) means file doesn't exists yet.
1329 (modtime (or (nth 5 attr) '(-1 65535))))
1330 (when (boundp 'last-coding-system-used)
1331 (setq coding-system-used (symbol-value 'last-coding-system-used)))
1332 ;; We use '(0 0) as a don't-know value. See also
1333 ;; `tramp-do-file-attributes-with-ls'.
1334 (if (not (equal modtime '(0 0)))
1335 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
1336 (progn
1337 (tramp-send-command
1338 v
1339 (format "%s -ild %s"
1340 (tramp-get-ls-command v)
1341 (tramp-shell-quote-argument localname)))
1342 (setq attr (buffer-substring (point)
1343 (progn (end-of-line) (point)))))
1344 (tramp-set-file-property
1345 v localname "visited-file-modtime-ild" attr))
1346 (when (boundp 'last-coding-system-used)
1347 (set 'last-coding-system-used coding-system-used))
1348 nil)))))
1349
1350;; This function makes the same assumption as
1351;; `tramp-handle-set-visited-file-modtime'.
1352(defun tramp-handle-verify-visited-file-modtime (buf)
1353 "Like `verify-visited-file-modtime' for Tramp files.
1354At the time `verify-visited-file-modtime' calls this function, we
1355already know that the buffer is visiting a file and that
1356`visited-file-modtime' does not return 0. Do not call this
1357function directly, unless those two cases are already taken care
1358of."
1359 (with-current-buffer buf
1360 (let ((f (buffer-file-name)))
1361 ;; There is no file visiting the buffer, or the buffer has no
1362 ;; recorded last modification time, or there is no established
1363 ;; connection.
1364 (if (or (not f)
1365 (eq (visited-file-modtime) 0)
1366 (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
1367 t
1368 (with-parsed-tramp-file-name f nil
1369 (tramp-flush-file-property v localname)
1370 (let* ((attr (file-attributes f))
1371 (modtime (nth 5 attr))
1372 (mt (visited-file-modtime)))
1373
1374 (cond
1375 ;; File exists, and has a known modtime.
1376 ((and attr (not (equal modtime '(0 0))))
1377 (< (abs (tramp-time-diff
1378 modtime
1379 ;; For compatibility, deal with both the old
1380 ;; (HIGH . LOW) and the new (HIGH LOW) return
1381 ;; values of `visited-file-modtime'.
1382 (if (atom (cdr mt))
1383 (list (car mt) (cdr mt))
1384 mt)))
1385 2))
1386 ;; Modtime has the don't know value.
1387 (attr
1388 (tramp-send-command
1389 v
1390 (format "%s -ild %s"
1391 (tramp-get-ls-command v)
1392 (tramp-shell-quote-argument localname)))
1393 (with-current-buffer (tramp-get-buffer v)
1394 (setq attr (buffer-substring
1395 (point) (progn (end-of-line) (point)))))
1396 (equal
1397 attr
1398 (tramp-get-file-property
1399 v localname "visited-file-modtime-ild" "")))
1400 ;; If file does not exist, say it is not modified if and
1401 ;; only if that agrees with the buffer's record.
1402 (t (equal mt '(-1 65535))))))))))
1403
1404(defun tramp-handle-set-file-modes (filename mode)
1405 "Like `set-file-modes' for Tramp files."
1406 (with-parsed-tramp-file-name filename nil
1407 (tramp-flush-file-property v localname)
1408 ;; FIXME: extract the proper text from chmod's stderr.
1409 (tramp-barf-unless-okay
1410 v
1411 (format "chmod %s %s"
1412 (tramp-compat-decimal-to-octal mode)
1413 (tramp-shell-quote-argument localname))
1414 "Error while changing file's mode %s" filename)))
1415
1416(defun tramp-handle-set-file-times (filename &optional time)
1417 "Like `set-file-times' for Tramp files."
1418 (if (file-remote-p filename)
1419 (with-parsed-tramp-file-name filename nil
1420 (tramp-flush-file-property v localname)
1421 (let ((time (if (or (null time) (equal time '(0 0)))
1422 (current-time)
1423 time))
1424 ;; With GNU Emacs, `format-time-string' has an optional
1425 ;; parameter UNIVERSAL. This is preferred, because we
1426 ;; could handle the case when the remote host is located
1427 ;; in a different time zone as the local host.
1428 (utc (not (featurep 'xemacs))))
1429 (tramp-send-command-and-check
1430 v (format "%s touch -t %s %s"
1431 (if utc "TZ=UTC; export TZ;" "")
1432 (if utc
1433 (format-time-string "%Y%m%d%H%M.%S" time t)
1434 (format-time-string "%Y%m%d%H%M.%S" time))
1435 (tramp-shell-quote-argument localname)))))
1436
1437 ;; We handle also the local part, because in older Emacsen,
1438 ;; without `set-file-times', this function is an alias for this.
1439 ;; We are local, so we don't need the UTC settings.
1440 (zerop
1441 (tramp-compat-call-process
1442 "touch" nil nil nil "-t"
1443 (format-time-string "%Y%m%d%H%M.%S" time)
1444 (tramp-shell-quote-argument filename)))))
1445
1446(defun tramp-set-file-uid-gid (filename &optional uid gid)
1447 "Set the ownership for FILENAME.
1448If UID and GID are provided, these values are used; otherwise uid
1449and gid of the corresponding user is taken. Both parameters must be integers."
1450 ;; Modern Unices allow chown only for root. So we might need
1451 ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
1452 ;; working with su(do)? when it is needed, so it shall succeed in
1453 ;; the majority of cases.
1454 ;; Don't modify `last-coding-system-used' by accident.
1455 (let ((last-coding-system-used last-coding-system-used))
1456 (if (file-remote-p filename)
1457 (with-parsed-tramp-file-name filename nil
1458 (if (and (zerop (user-uid)) (tramp-local-host-p v))
1459 ;; If we are root on the local host, we can do it directly.
1460 (tramp-set-file-uid-gid localname uid gid)
1461 (let ((uid (or (and (integerp uid) uid)
1462 (tramp-get-remote-uid v 'integer)))
1463 (gid (or (and (integerp gid) gid)
1464 (tramp-get-remote-gid v 'integer))))
1465 (tramp-send-command
1466 v (format
1467 "chown %d:%d %s" uid gid
1468 (tramp-shell-quote-argument localname))))))
1469
1470 ;; We handle also the local part, because there doesn't exist
1471 ;; `set-file-uid-gid'. On W32 "chown" might not work.
1472 (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
1473 (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
1474 (tramp-compat-call-process
1475 "chown" nil nil nil
1476 (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
1477
1478(defun tramp-remote-selinux-p (vec)
1479 "Check, whether SELINUX is enabled on the remote host."
1480 (with-connection-property (tramp-get-connection-process vec) "selinux-p"
1481 (let ((result (tramp-find-executable
1482 vec "getenforce" (tramp-get-remote-path vec) t t)))
1483 (and result
1484 (string-equal
1485 (tramp-send-command-and-read
1486 vec (format "echo \\\"`%S`\\\"" result))
1487 "Enforcing")))))
1488
1489(defun tramp-handle-file-selinux-context (filename)
1490 "Like `file-selinux-context' for Tramp files."
1491 (with-parsed-tramp-file-name filename nil
1492 (with-file-property v localname "file-selinux-context"
1493 (let ((context '(nil nil nil nil))
1494 (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
1495 "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
1496 (when (and (tramp-remote-selinux-p v)
1497 (tramp-send-command-and-check
1498 v (format
1499 "%s -d -Z %s"
1500 (tramp-get-ls-command v)
1501 (tramp-shell-quote-argument localname))))
1502 (with-current-buffer (tramp-get-connection-buffer v)
1503 (goto-char (point-min))
1504 (when (re-search-forward regexp (tramp-compat-line-end-position) t)
1505 (setq context (list (match-string 1) (match-string 2)
1506 (match-string 3) (match-string 4))))))
1507 ;; Return the context.
1508 context))))
1509
1510(defun tramp-handle-set-file-selinux-context (filename context)
1511 "Like `set-file-selinux-context' for Tramp files."
1512 (with-parsed-tramp-file-name filename nil
1513 (if (and (consp context)
1514 (tramp-remote-selinux-p v)
1515 (tramp-send-command-and-check
1516 v (format "chcon %s %s %s %s %s"
1517 (if (stringp (nth 0 context))
1518 (format "--user=%s" (nth 0 context)) "")
1519 (if (stringp (nth 1 context))
1520 (format "--role=%s" (nth 1 context)) "")
1521 (if (stringp (nth 2 context))
1522 (format "--type=%s" (nth 2 context)) "")
1523 (if (stringp (nth 3 context))
1524 (format "--range=%s" (nth 3 context)) "")
1525 (tramp-shell-quote-argument localname))))
1526 (tramp-set-file-property v localname "file-selinux-context" context)
1527 (tramp-set-file-property v localname "file-selinux-context" 'undef)))
1528 ;; We always return nil.
1529 nil)
1530
1531;; Simple functions using the `test' command.
1532
1533(defun tramp-handle-file-executable-p (filename)
1534 "Like `file-executable-p' for Tramp files."
1535 (with-parsed-tramp-file-name filename nil
1536 (with-file-property v localname "file-executable-p"
1537 ;; Examine `file-attributes' cache to see if request can be
1538 ;; satisfied without remote operation.
1539 (or (tramp-check-cached-permissions v ?x)
1540 (tramp-run-test "-x" filename)))))
1541
1542(defun tramp-handle-file-readable-p (filename)
1543 "Like `file-readable-p' for Tramp files."
1544 (with-parsed-tramp-file-name filename nil
1545 (with-file-property v localname "file-readable-p"
1546 ;; Examine `file-attributes' cache to see if request can be
1547 ;; satisfied without remote operation.
1548 (or (tramp-check-cached-permissions v ?r)
1549 (tramp-run-test "-r" filename)))))
1550
1551;; When the remote shell is started, it looks for a shell which groks
1552;; tilde expansion. Here, we assume that all shells which grok tilde
1553;; expansion will also provide a `test' command which groks `-nt' (for
1554;; newer than). If this breaks, tell me about it and I'll try to do
1555;; something smarter about it.
1556(defun tramp-handle-file-newer-than-file-p (file1 file2)
1557 "Like `file-newer-than-file-p' for Tramp files."
1558 (cond ((not (file-exists-p file1))
1559 nil)
1560 ((not (file-exists-p file2))
1561 t)
1562 ;; We are sure both files exist at this point.
1563 (t
1564 (save-excursion
1565 ;; We try to get the mtime of both files. If they are not
1566 ;; equal to the "dont-know" value, then we subtract the times
1567 ;; and obtain the result.
1568 (let ((fa1 (file-attributes file1))
1569 (fa2 (file-attributes file2)))
1570 (if (and (not (equal (nth 5 fa1) '(0 0)))
1571 (not (equal (nth 5 fa2) '(0 0))))
1572 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
1573 ;; If one of them is the dont-know value, then we can
1574 ;; still try to run a shell command on the remote host.
1575 ;; However, this only works if both files are Tramp
1576 ;; files and both have the same method, same user, same
1577 ;; host.
1578 (unless (tramp-equal-remote file1 file2)
1579 (with-parsed-tramp-file-name
1580 (if (tramp-tramp-file-p file1) file1 file2) nil
1581 (tramp-error
1582 v 'file-error
1583 "Files %s and %s must have same method, user, host"
1584 file1 file2)))
1585 (with-parsed-tramp-file-name file1 nil
1586 (tramp-run-test2
1587 (tramp-get-test-nt-command v) file1 file2))))))))
1588
1589;; Functions implemented using the basic functions above.
1590
1591(defun tramp-handle-file-modes (filename)
1592 "Like `file-modes' for Tramp files."
1593 (let ((truename (or (file-truename filename) filename)))
1594 (when (file-exists-p truename)
1595 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
1596
1597(defun tramp-handle-file-directory-p (filename)
1598 "Like `file-directory-p' for Tramp files."
1599 ;; Care must be taken that this function returns `t' for symlinks
1600 ;; pointing to directories. Surely the most obvious implementation
1601 ;; would be `test -d', but that returns false for such symlinks.
1602 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
1603 ;; I now think he's right. So we could be using `test -d', couldn't
1604 ;; we?
1605 ;;
1606 ;; Alternatives: `cd %s', `test -d %s'
1607 (with-parsed-tramp-file-name filename nil
1608 (with-file-property v localname "file-directory-p"
1609 (tramp-run-test "-d" filename))))
1610
1611(defun tramp-handle-file-regular-p (filename)
1612 "Like `file-regular-p' for Tramp files."
1613 (and (file-exists-p filename)
1614 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
1615
1616(defun tramp-handle-file-symlink-p (filename)
1617 "Like `file-symlink-p' for Tramp files."
1618 (with-parsed-tramp-file-name filename nil
1619 (let ((x (car (file-attributes filename))))
1620 (when (stringp x)
1621 ;; When Tramp is running on VMS, then `file-name-absolute-p'
1622 ;; might do weird things.
1623 (if (file-name-absolute-p x)
1624 (tramp-make-tramp-file-name method user host x)
1625 x)))))
1626
1627(defun tramp-handle-file-writable-p (filename)
1628 "Like `file-writable-p' for Tramp files."
1629 (with-parsed-tramp-file-name filename nil
1630 (with-file-property v localname "file-writable-p"
1631 (if (file-exists-p filename)
1632 ;; Examine `file-attributes' cache to see if request can be
1633 ;; satisfied without remote operation.
1634 (or (tramp-check-cached-permissions v ?w)
1635 (tramp-run-test "-w" filename))
1636 ;; If file doesn't exist, check if directory is writable.
1637 (and (tramp-run-test "-d" (file-name-directory filename))
1638 (tramp-run-test "-w" (file-name-directory filename)))))))
1639
1640(defun tramp-handle-file-ownership-preserved-p (filename)
1641 "Like `file-ownership-preserved-p' for Tramp files."
1642 (with-parsed-tramp-file-name filename nil
1643 (with-file-property v localname "file-ownership-preserved-p"
1644 (let ((attributes (file-attributes filename)))
1645 ;; Return t if the file doesn't exist, since it's true that no
1646 ;; information would be lost by an (attempted) delete and create.
1647 (or (null attributes)
1648 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
1649
1650;; Other file name ops.
1651
1652(defun tramp-handle-directory-file-name (directory)
1653 "Like `directory-file-name' for Tramp files."
1654 ;; If localname component of filename is "/", leave it unchanged.
1655 ;; Otherwise, remove any trailing slash from localname component.
1656 ;; Method, host, etc, are unchanged. Does it make sense to try
1657 ;; to avoid parsing the filename?
1658 (with-parsed-tramp-file-name directory nil
1659 (if (and (not (zerop (length localname)))
1660 (eq (aref localname (1- (length localname))) ?/)
1661 (not (string= localname "/")))
1662 (substring directory 0 -1)
1663 directory)))
1664
1665;; Directory listings.
1666
1667(defun tramp-handle-directory-files
1668 (directory &optional full match nosort files-only)
1669 "Like `directory-files' for Tramp files."
1670 ;; FILES-ONLY is valid for XEmacs only.
1671 (when (file-directory-p directory)
1672 (setq directory (file-name-as-directory (expand-file-name directory)))
1673 (let ((temp (nreverse (file-name-all-completions "" directory)))
1674 result item)
1675
1676 (while temp
1677 (setq item (directory-file-name (pop temp)))
1678 (when (and (or (null match) (string-match match item))
1679 (or (null files-only)
1680 ;; Files only.
1681 (and (equal files-only t) (file-regular-p item))
1682 ;; Directories only.
1683 (file-directory-p item)))
1684 (push (if full (concat directory item) item)
1685 result)))
1686 (if nosort result (sort result 'string<)))))
1687
1688(defun tramp-handle-directory-files-and-attributes
1689 (directory &optional full match nosort id-format)
1690 "Like `directory-files-and-attributes' for Tramp files."
1691 (unless id-format (setq id-format 'integer))
1692 (when (file-directory-p directory)
1693 (setq directory (expand-file-name directory))
1694 (let* ((temp
1695 (copy-tree
1696 (with-parsed-tramp-file-name directory nil
1697 (with-file-property
1698 v localname
1699 (format "directory-files-and-attributes-%s" id-format)
1700 (save-excursion
1701 (mapcar
1702 (lambda (x)
1703 (cons (car x)
1704 (tramp-convert-file-attributes v (cdr x))))
1705 (cond
1706 ((tramp-get-remote-stat v)
1707 (tramp-do-directory-files-and-attributes-with-stat
1708 v localname id-format))
1709 ((tramp-get-remote-perl v)
1710 (tramp-do-directory-files-and-attributes-with-perl
1711 v localname id-format)))))))))
1712 result item)
1713
1714 (while temp
1715 (setq item (pop temp))
1716 (when (or (null match) (string-match match (car item)))
1717 (when full
1718 (setcar item (expand-file-name (car item) directory)))
1719 (push item result)))
1720
1721 (if nosort
1722 result
1723 (sort result (lambda (x y) (string< (car x) (car y))))))))
1724
1725(defun tramp-do-directory-files-and-attributes-with-perl
1726 (vec localname &optional id-format)
1727 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
1728 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
1729 (tramp-maybe-send-script
1730 vec tramp-perl-directory-files-and-attributes
1731 "tramp_perl_directory_files_and_attributes")
1732 (let ((object
1733 (tramp-send-command-and-read
1734 vec
1735 (format "tramp_perl_directory_files_and_attributes %s %s"
1736 (tramp-shell-quote-argument localname) id-format))))
1737 (when (stringp object) (tramp-error vec 'file-error object))
1738 object))
1739
1740(defun tramp-do-directory-files-and-attributes-with-stat
1741 (vec localname &optional id-format)
1742 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
1743 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
1744 (tramp-send-command-and-read
1745 vec
1746 (format
1747 (concat
1748 ;; We must care about filenames with spaces, or starting with
1749 ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
1750 ;; but it does not work on all remote systems. Therefore, we
1751 ;; quote the filenames via sed.
1752 "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
1753 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); "
1754 "echo \")\"")
1755 (tramp-shell-quote-argument localname)
1756 (tramp-get-ls-command vec)
1757 (tramp-get-remote-stat vec)
1758 (if (eq id-format 'integer) "%u" "\"%U\"")
1759 (if (eq id-format 'integer) "%g" "\"%G\""))))
1760
1761;; This function should return "foo/" for directories and "bar" for
1762;; files.
1763(defun tramp-handle-file-name-all-completions (filename directory)
1764 "Like `file-name-all-completions' for Tramp files."
1765 (unless (save-match-data (string-match "/" filename))
1766 (with-parsed-tramp-file-name (expand-file-name directory) nil
1767
1768 (all-completions
1769 filename
1770 (mapcar
1771 'list
1772 (or
1773 ;; Try cache first
1774 (and
1775 ;; Ignore if expired
1776 (or (not (integerp tramp-completion-reread-directory-timeout))
1777 (<= (tramp-time-diff
1778 (current-time)
1779 (tramp-get-file-property
1780 v localname "last-completion" '(0 0 0)))
1781 tramp-completion-reread-directory-timeout))
1782
1783 ;; Try cache entries for filename, filename with last
1784 ;; character removed, filename with last two characters
1785 ;; removed, ..., and finally the empty string - all
1786 ;; concatenated to the local directory name
1787
1788 ;; This is inefficient for very long filenames, pity
1789 ;; `reduce' is not available...
1790 (car
1791 (apply
1792 'append
1793 (mapcar
1794 (lambda (x)
1795 (let ((cache-hit
1796 (tramp-get-file-property
1797 v
1798 (concat localname (substring filename 0 x))
1799 "file-name-all-completions"
1800 nil)))
1801 (when cache-hit (list cache-hit))))
1802 (tramp-compat-number-sequence (length filename) 0 -1)))))
1803
1804 ;; Cache expired or no matching cache entry found so we need
1805 ;; to perform a remote operation
1806 (let (result)
1807 ;; Get a list of directories and files, including reliably
1808 ;; tagging the directories with a trailing '/'. Because I
1809 ;; rock. --daniel@danann.net
1810
1811 ;; Changed to perform `cd' in the same remote op and only
1812 ;; get entries starting with `filename'. Capture any `cd'
1813 ;; error messages. Ensure any `cd' and `echo' aliases are
1814 ;; ignored.
1815 (tramp-send-command
1816 v
1817 (if (tramp-get-remote-perl v)
1818 (progn
1819 (tramp-maybe-send-script
1820 v tramp-perl-file-name-all-completions
1821 "tramp_perl_file_name_all_completions")
1822 (format "tramp_perl_file_name_all_completions %s %s %d"
1823 (tramp-shell-quote-argument localname)
1824 (tramp-shell-quote-argument filename)
1825 (if (symbol-value
1826 ;; `read-file-name-completion-ignore-case'
1827 ;; is introduced with Emacs 22.1.
1828 (if (boundp
1829 'read-file-name-completion-ignore-case)
1830 'read-file-name-completion-ignore-case
1831 'completion-ignore-case))
1832 1 0)))
1833
1834 (format (concat
1835 "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
1836 ;; `ls' with wildcard might fail with `Argument
1837 ;; list too long' error in some corner cases; if
1838 ;; `ls' fails after `cd' succeeded, chances are
1839 ;; that's the case, so let's retry without
1840 ;; wildcard. This will return "too many" entries
1841 ;; but that isn't harmful.
1842 " || %s -a 2>/dev/null)"
1843 " | while read f; do"
1844 " if %s -d \"$f\" 2>/dev/null;"
1845 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1846 " && \\echo ok) || \\echo fail")
1847 (tramp-shell-quote-argument localname)
1848 (tramp-get-ls-command v)
1849 ;; When `filename' is empty, just `ls' without
1850 ;; filename argument is more efficient than `ls *'
1851 ;; for very large directories and might avoid the
1852 ;; `Argument list too long' error.
1853 ;;
1854 ;; With and only with wildcard, we need to add
1855 ;; `-d' to prevent `ls' from descending into
1856 ;; sub-directories.
1857 (if (zerop (length filename))
1858 "."
1859 (concat (tramp-shell-quote-argument filename) "* -d"))
1860 (tramp-get-ls-command v)
1861 (tramp-get-test-command v))))
1862
1863 ;; Now grab the output.
1864 (with-current-buffer (tramp-get-buffer v)
1865 (goto-char (point-max))
1866
1867 ;; Check result code, found in last line of output
1868 (forward-line -1)
1869 (if (looking-at "^fail$")
1870 (progn
1871 ;; Grab error message from line before last line
1872 ;; (it was put there by `cd 2>&1')
1873 (forward-line -1)
1874 (tramp-error
1875 v 'file-error
1876 "tramp-handle-file-name-all-completions: %s"
1877 (buffer-substring
1878 (point) (tramp-compat-line-end-position))))
1879 ;; For peace of mind, if buffer doesn't end in `fail'
1880 ;; then it should end in `ok'. If neither are in the
1881 ;; buffer something went seriously wrong on the remote
1882 ;; side.
1883 (unless (looking-at "^ok$")
1884 (tramp-error
1885 v 'file-error
1886 "\
1887tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
1888 (tramp-shell-quote-argument localname) (buffer-string))))
1889
1890 (while (zerop (forward-line -1))
1891 (push (buffer-substring
1892 (point) (tramp-compat-line-end-position))
1893 result)))
1894
1895 ;; Because the remote op went through OK we know the
1896 ;; directory we `cd'-ed to exists
1897 (tramp-set-file-property
1898 v localname "file-exists-p" t)
1899
1900 ;; Because the remote op went through OK we know every
1901 ;; file listed by `ls' exists.
1902 (mapc (lambda (entry)
1903 (tramp-set-file-property
1904 v (concat localname entry) "file-exists-p" t))
1905 result)
1906
1907 (tramp-set-file-property
1908 v localname "last-completion" (current-time))
1909
1910 ;; Store result in the cache
1911 (tramp-set-file-property
1912 v (concat localname filename)
1913 "file-name-all-completions"
1914 result))))))))
1915
1916(defun tramp-handle-file-name-completion
1917 (filename directory &optional predicate)
1918 "Like `file-name-completion' for Tramp files."
1919 (unless (tramp-tramp-file-p directory)
1920 (error
1921 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
1922 directory))
1923 (try-completion
1924 filename
1925 (mapcar 'list (file-name-all-completions filename directory))
1926 (when predicate
1927 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
1928
1929;; cp, mv and ln
1930
1931(defun tramp-handle-add-name-to-file
1932 (filename newname &optional ok-if-already-exists)
1933 "Like `add-name-to-file' for Tramp files."
1934 (unless (tramp-equal-remote filename newname)
1935 (with-parsed-tramp-file-name
1936 (if (tramp-tramp-file-p filename) filename newname) nil
1937 (tramp-error
1938 v 'file-error
1939 "add-name-to-file: %s"
1940 "only implemented for same method, same user, same host")))
1941 (with-parsed-tramp-file-name filename v1
1942 (with-parsed-tramp-file-name newname v2
1943 (let ((ln (when v1 (tramp-get-remote-ln v1))))
1944 (when (and (not ok-if-already-exists)
1945 (file-exists-p newname)
1946 (not (numberp ok-if-already-exists))
1947 (y-or-n-p
1948 (format
1949 "File %s already exists; make it a new name anyway? "
1950 newname)))
1951 (tramp-error
1952 v2 'file-error
1953 "add-name-to-file: file %s already exists" newname))
1954 (tramp-flush-file-property v2 (file-name-directory v2-localname))
1955 (tramp-flush-file-property v2 v2-localname)
1956 (tramp-barf-unless-okay
1957 v1
1958 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
1959 (tramp-shell-quote-argument v2-localname))
1960 "error with add-name-to-file, see buffer `%s' for details"
1961 (buffer-name))))))
1962
1963(defun tramp-handle-copy-file
1964 (filename newname &optional ok-if-already-exists keep-date
1965 preserve-uid-gid preserve-selinux-context)
1966 "Like `copy-file' for Tramp files."
1967 (setq filename (expand-file-name filename))
1968 (setq newname (expand-file-name newname))
1969 (cond
1970 ;; At least one file a Tramp file?
1971 ((or (tramp-tramp-file-p filename)
1972 (tramp-tramp-file-p newname))
1973 (tramp-do-copy-or-rename-file
1974 'copy filename newname ok-if-already-exists keep-date
1975 preserve-uid-gid preserve-selinux-context))
1976 ;; Compat section.
1977 (preserve-selinux-context
1978 (tramp-run-real-handler
1979 'copy-file
1980 (list filename newname ok-if-already-exists keep-date
1981 preserve-uid-gid preserve-selinux-context)))
1982 (preserve-uid-gid
1983 (tramp-run-real-handler
1984 'copy-file
1985 (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
1986 (t
1987 (tramp-run-real-handler
1988 'copy-file (list filename newname ok-if-already-exists keep-date)))))
1989
1990(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
1991 "Like `copy-directory' for Tramp files."
1992 (let ((t1 (tramp-tramp-file-p dirname))
1993 (t2 (tramp-tramp-file-p newname)))
1994 (with-parsed-tramp-file-name (if t1 dirname newname) nil
1995 (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
1996 ;; When DIRNAME and NEWNAME are remote, they must have
1997 ;; the same method.
1998 (or (null t1) (null t2)
1999 (string-equal
2000 (tramp-file-name-method (tramp-dissect-file-name dirname))
2001 (tramp-file-name-method (tramp-dissect-file-name newname)))))
2002 ;; scp or rsync DTRT.
2003 (progn
2004 (setq dirname (directory-file-name (expand-file-name dirname))
2005 newname (directory-file-name (expand-file-name newname)))
2006 (if (and (file-directory-p newname)
2007 (not (string-equal (file-name-nondirectory dirname)
2008 (file-name-nondirectory newname))))
2009 (setq newname
2010 (expand-file-name
2011 (file-name-nondirectory dirname) newname)))
2012 (if (not (file-directory-p (file-name-directory newname)))
2013 (make-directory (file-name-directory newname) parents))
2014 (tramp-do-copy-or-rename-file-out-of-band
2015 'copy dirname newname keep-date))
2016 ;; We must do it file-wise.
2017 (tramp-run-real-handler
2018 'copy-directory (list dirname newname keep-date parents)))
2019
2020 ;; When newname did exist, we have wrong cached values.
2021 (when t2
2022 (with-parsed-tramp-file-name newname nil
2023 (tramp-flush-file-property v (file-name-directory localname))
2024 (tramp-flush-file-property v localname))))))
2025
2026(defun tramp-handle-rename-file
2027 (filename newname &optional ok-if-already-exists)
2028 "Like `rename-file' for Tramp files."
2029 ;; Check if both files are local -- invoke normal rename-file.
2030 ;; Otherwise, use Tramp from local system.
2031 (setq filename (expand-file-name filename))
2032 (setq newname (expand-file-name newname))
2033 ;; At least one file a Tramp file?
2034 (if (or (tramp-tramp-file-p filename)
2035 (tramp-tramp-file-p newname))
2036 (tramp-do-copy-or-rename-file
2037 'rename filename newname ok-if-already-exists t t)
2038 (tramp-run-real-handler
2039 'rename-file (list filename newname ok-if-already-exists))))
2040
2041(defun tramp-do-copy-or-rename-file
2042 (op filename newname &optional ok-if-already-exists keep-date
2043 preserve-uid-gid preserve-selinux-context)
2044 "Copy or rename a remote file.
2045OP must be `copy' or `rename' and indicates the operation to perform.
2046FILENAME specifies the file to copy or rename, NEWNAME is the name of
2047the new file (for copy) or the new name of the file (for rename).
2048OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
2049KEEP-DATE means to make sure that NEWNAME has the same timestamp
2050as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
2051the uid and gid if both files are on the same host.
2052PRESERVE-SELINUX-CONTEXT activates selinux commands.
2053
2054This function is invoked by `tramp-handle-copy-file' and
2055`tramp-handle-rename-file'. It is an error if OP is neither of `copy'
2056and `rename'. FILENAME and NEWNAME must be absolute file names."
2057 (unless (memq op '(copy rename))
2058 (error "Unknown operation `%s', must be `copy' or `rename'" op))
2059 (let ((t1 (tramp-tramp-file-p filename))
2060 (t2 (tramp-tramp-file-p newname))
2061 (context (and preserve-selinux-context
2062 (apply 'file-selinux-context (list filename))))
2063 pr tm)
2064
2065 (with-parsed-tramp-file-name (if t1 filename newname) nil
2066 (when (and (not ok-if-already-exists) (file-exists-p newname))
2067 (tramp-error
2068 v 'file-already-exists "File %s already exists" newname))
2069
2070 (with-progress-reporter
2071 v 0 (format "%s %s to %s"
2072 (if (eq op 'copy) "Copying" "Renaming")
2073 filename newname)
2074
2075 (cond
2076 ;; Both are Tramp files.
2077 ((and t1 t2)
2078 (with-parsed-tramp-file-name filename v1
2079 (with-parsed-tramp-file-name newname v2
2080 (cond
2081 ;; Shortcut: if method, host, user are the same for
2082 ;; both files, we invoke `cp' or `mv' on the remote
2083 ;; host directly.
2084 ((tramp-equal-remote filename newname)
2085 (tramp-do-copy-or-rename-file-directly
2086 op filename newname
2087 ok-if-already-exists keep-date preserve-uid-gid))
2088
2089 ;; Try out-of-band operation.
2090 ((tramp-method-out-of-band-p
2091 v1 (nth 7 (file-attributes filename)))
2092 (tramp-do-copy-or-rename-file-out-of-band
2093 op filename newname keep-date))
2094
2095 ;; No shortcut was possible. So we copy the file
2096 ;; first. If the operation was `rename', we go back
2097 ;; and delete the original file (if the copy was
2098 ;; successful). The approach is simple-minded: we
2099 ;; create a new buffer, insert the contents of the
2100 ;; source file into it, then write out the buffer to
2101 ;; the target file. The advantage is that it doesn't
2102 ;; matter which filename handlers are used for the
2103 ;; source and target file.
2104 (t
2105 (tramp-do-copy-or-rename-file-via-buffer
2106 op filename newname keep-date))))))
2107
2108 ;; One file is a Tramp file, the other one is local.
2109 ((or t1 t2)
2110 (cond
2111 ;; Fast track on local machine.
2112 ((tramp-local-host-p v)
2113 (tramp-do-copy-or-rename-file-directly
2114 op filename newname
2115 ok-if-already-exists keep-date preserve-uid-gid))
2116
2117 ;; If the Tramp file has an out-of-band method, the
2118 ;; corresponding copy-program can be invoked.
2119 ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
2120 (tramp-do-copy-or-rename-file-out-of-band
2121 op filename newname keep-date))
2122
2123 ;; Use the inline method via a Tramp buffer.
2124 (t (tramp-do-copy-or-rename-file-via-buffer
2125 op filename newname keep-date))))
2126
2127 (t
2128 ;; One of them must be a Tramp file.
2129 (error "Tramp implementation says this cannot happen")))
2130
2131 ;; Handle `preserve-selinux-context'.
2132 (when context (apply 'set-file-selinux-context (list newname context)))
2133
2134 ;; In case of `rename', we must flush the cache of the source file.
2135 (when (and t1 (eq op 'rename))
2136 (with-parsed-tramp-file-name filename v1
2137 (tramp-flush-file-property v1 (file-name-directory localname))
2138 (tramp-flush-file-property v1 localname)))
2139
2140 ;; When newname did exist, we have wrong cached values.
2141 (when t2
2142 (with-parsed-tramp-file-name newname v2
2143 (tramp-flush-file-property v2 (file-name-directory localname))
2144 (tramp-flush-file-property v2 localname)))))))
2145
2146(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
2147 "Use an Emacs buffer to copy or rename a file.
2148First arg OP is either `copy' or `rename' and indicates the operation.
2149FILENAME is the source file, NEWNAME the target file.
2150KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
2151 (with-temp-buffer
2152 ;; We must disable multibyte, because binary data shall not be
2153 ;; converted.
2154 (set-buffer-multibyte nil)
2155 (let ((coding-system-for-read 'binary)
2156 (jka-compr-inhibit t))
2157 (insert-file-contents-literally filename))
2158 ;; We don't want the target file to be compressed, so we let-bind
2159 ;; `jka-compr-inhibit' to t.
2160 (let ((coding-system-for-write 'binary)
2161 (jka-compr-inhibit t))
2162 (write-region (point-min) (point-max) newname)))
2163 ;; KEEP-DATE handling.
2164 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
2165 ;; Set the mode.
2166 (set-file-modes newname (tramp-default-file-modes filename))
2167 ;; If the operation was `rename', delete the original file.
2168 (unless (eq op 'copy) (delete-file filename)))
2169
2170(defun tramp-do-copy-or-rename-file-directly
2171 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
2172 "Invokes `cp' or `mv' on the remote system.
2173OP must be one of `copy' or `rename', indicating `cp' or `mv',
2174respectively. FILENAME specifies the file to copy or rename,
2175NEWNAME is the name of the new file (for copy) or the new name of
2176the file (for rename). Both files must reside on the same host.
2177KEEP-DATE means to make sure that NEWNAME has the same timestamp
2178as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
2179the uid and gid from FILENAME."
2180 (let ((t1 (tramp-tramp-file-p filename))
2181 (t2 (tramp-tramp-file-p newname))
2182 (file-times (nth 5 (file-attributes filename)))
2183 (file-modes (tramp-default-file-modes filename)))
2184 (with-parsed-tramp-file-name (if t1 filename newname) nil
2185 (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
2186 ((eq op 'copy) "cp -f")
2187 ((eq op 'rename) "mv -f")
2188 (t (tramp-error
2189 v 'file-error
2190 "Unknown operation `%s', must be `copy' or `rename'"
2191 op))))
2192 (localname1
2193 (if t1
2194 (tramp-file-name-handler 'file-remote-p filename 'localname)
2195 filename))
2196 (localname2
2197 (if t2
2198 (tramp-file-name-handler 'file-remote-p newname 'localname)
2199 newname))
2200 (prefix (file-remote-p (if t1 filename newname)))
2201 cmd-result)
2202
2203 (cond
2204 ;; Both files are on a remote host, with same user.
2205 ((and t1 t2)
2206 (setq cmd-result
2207 (tramp-send-command-and-check
2208 v (format "%s %s %s" cmd
2209 (tramp-shell-quote-argument localname1)
2210 (tramp-shell-quote-argument localname2))))
2211 (with-current-buffer (tramp-get-buffer v)
2212 (goto-char (point-min))
2213 (unless
2214 (or
2215 (and keep-date
2216 ;; Mask cp -f error.
2217 (re-search-forward
2218 tramp-operation-not-permitted-regexp nil t))
2219 cmd-result)
2220 (tramp-error-with-buffer
2221 nil v 'file-error
2222 "Copying directly failed, see buffer `%s' for details."
2223 (buffer-name)))))
2224
2225 ;; We are on the local host.
2226 ((or t1 t2)
2227 (cond
2228 ;; We can do it directly.
2229 ((let (file-name-handler-alist)
2230 (and (file-readable-p localname1)
2231 (file-writable-p (file-name-directory localname2))
2232 (or (file-directory-p localname2)
2233 (file-writable-p localname2))))
2234 (if (eq op 'copy)
2235 (tramp-compat-copy-file
2236 localname1 localname2 ok-if-already-exists
2237 keep-date preserve-uid-gid)
2238 (tramp-run-real-handler
2239 'rename-file (list localname1 localname2 ok-if-already-exists))))
2240
2241 ;; We can do it directly with `tramp-send-command'
2242 ((and (file-readable-p (concat prefix localname1))
2243 (file-writable-p
2244 (file-name-directory (concat prefix localname2)))
2245 (or (file-directory-p (concat prefix localname2))
2246 (file-writable-p (concat prefix localname2))))
2247 (tramp-do-copy-or-rename-file-directly
2248 op (concat prefix localname1) (concat prefix localname2)
2249 ok-if-already-exists keep-date t)
2250 ;; We must change the ownership to the local user.
2251 (tramp-set-file-uid-gid
2252 (concat prefix localname2)
2253 (tramp-get-local-uid 'integer)
2254 (tramp-get-local-gid 'integer)))
2255
2256 ;; We need a temporary file in between.
2257 (t
2258 ;; Create the temporary file.
2259 (let ((tmpfile (tramp-compat-make-temp-file localname1)))
2260 (unwind-protect
2261 (progn
2262 (cond
2263 (t1
2264 (tramp-barf-unless-okay
2265 v (format
2266 "%s %s %s" cmd
2267 (tramp-shell-quote-argument localname1)
2268 (tramp-shell-quote-argument tmpfile))
2269 "Copying directly failed, see buffer `%s' for details."
2270 (tramp-get-buffer v))
2271 ;; We must change the ownership as remote user.
2272 ;; Since this does not work reliable, we also
2273 ;; give read permissions.
2274 (set-file-modes
2275 (concat prefix tmpfile)
2276 (tramp-compat-octal-to-decimal "0777"))
2277 (tramp-set-file-uid-gid
2278 (concat prefix tmpfile)
2279 (tramp-get-local-uid 'integer)
2280 (tramp-get-local-gid 'integer)))
2281 (t2
2282 (if (eq op 'copy)
2283 (tramp-compat-copy-file
2284 localname1 tmpfile t
2285 keep-date preserve-uid-gid)
2286 (tramp-run-real-handler
2287 'rename-file
2288 (list localname1 tmpfile t)))
2289 ;; We must change the ownership as local user.
2290 ;; Since this does not work reliable, we also
2291 ;; give read permissions.
2292 (set-file-modes
2293 tmpfile (tramp-compat-octal-to-decimal "0777"))
2294 (tramp-set-file-uid-gid
2295 tmpfile
2296 (tramp-get-remote-uid v 'integer)
2297 (tramp-get-remote-gid v 'integer))))
2298
2299 ;; Move the temporary file to its destination.
2300 (cond
2301 (t2
2302 (tramp-barf-unless-okay
2303 v (format
2304 "cp -f -p %s %s"
2305 (tramp-shell-quote-argument tmpfile)
2306 (tramp-shell-quote-argument localname2))
2307 "Copying directly failed, see buffer `%s' for details."
2308 (tramp-get-buffer v)))
2309 (t1
2310 (tramp-run-real-handler
2311 'rename-file
2312 (list tmpfile localname2 ok-if-already-exists)))))
2313
2314 ;; Save exit.
2315 (condition-case nil
2316 (delete-file tmpfile)
2317 (error)))))))))
2318
2319 ;; Set the time and mode. Mask possible errors.
2320 (condition-case nil
2321 (when keep-date
2322 (set-file-times newname file-times)
2323 (set-file-modes newname file-modes))
2324 (error)))))
2325
2326(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
2327 "Invoke rcp program to copy.
2328The method used must be an out-of-band method."
2329 (let ((t1 (tramp-tramp-file-p filename))
2330 (t2 (tramp-tramp-file-p newname))
2331 copy-program copy-args copy-env copy-keep-date port spec
2332 source target)
2333
2334 (with-parsed-tramp-file-name (if t1 filename newname) nil
2335 (if (and t1 t2)
2336
2337 ;; Both are Tramp files. We shall optimize it, when the
2338 ;; methods for filename and newname are the same.
2339 (let* ((dir-flag (file-directory-p filename))
2340 (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
2341 (if dir-flag
2342 (setq tmpfile
2343 (expand-file-name
2344 (file-name-nondirectory newname) tmpfile)))
2345 (unwind-protect
2346 (progn
2347 (tramp-do-copy-or-rename-file-out-of-band
2348 op filename tmpfile keep-date)
2349 (tramp-do-copy-or-rename-file-out-of-band
2350 'rename tmpfile newname keep-date))
2351 ;; Save exit.
2352 (condition-case nil
2353 (if dir-flag
2354 (tramp-compat-delete-directory
2355 (expand-file-name ".." tmpfile) 'recursive)
2356 (delete-file tmpfile))
2357 (error))))
2358
2359 ;; Expand hops. Might be necessary for gateway methods.
2360 (setq v (car (tramp-compute-multi-hops v)))
2361 (aset v 3 localname)
2362
2363 ;; Check which ones of source and target are Tramp files.
2364 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
2365 target (funcall
2366 (if (and (file-directory-p filename)
2367 (string-equal
2368 (file-name-nondirectory filename)
2369 (file-name-nondirectory newname)))
2370 'file-name-directory
2371 'identity)
2372 (if t2 (tramp-make-copy-program-file-name v) newname)))
2373
2374 ;; Check for port number. Until now, there's no need for handling
2375 ;; like method, user, host.
2376 (setq host (tramp-file-name-real-host v)
2377 port (tramp-file-name-port v)
2378 port (or (and port (number-to-string port)) ""))
2379
2380 ;; Compose copy command.
2381 (setq spec (format-spec-make
2382 ?h host ?u user ?p port
2383 ?t (tramp-get-connection-property
2384 (tramp-get-connection-process v) "temp-file" "")
2385 ?k (if keep-date " " ""))
2386 copy-program (tramp-get-method-parameter
2387 method 'tramp-copy-program)
2388 copy-keep-date (tramp-get-method-parameter
2389 method 'tramp-copy-keep-date)
2390 copy-args
2391 (delq
2392 nil
2393 (mapcar
2394 (lambda (x)
2395 (setq
2396 x
2397 ;; " " is indication for keep-date argument.
2398 (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
2399 (unless (member "" x) (mapconcat 'identity x " ")))
2400 (tramp-get-method-parameter method 'tramp-copy-args)))
2401 copy-env
2402 (delq
2403 nil
2404 (mapcar
2405 (lambda (x)
2406 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
2407 (unless (member "" x) (mapconcat 'identity x " ")))
2408 (tramp-get-method-parameter method 'tramp-copy-env))))
2409
2410 ;; Check for program.
2411 (when (and (fboundp 'executable-find)
2412 (not (let ((default-directory
2413 (tramp-compat-temporary-file-directory)))
2414 (executable-find copy-program))))
2415 (tramp-error
2416 v 'file-error "Cannot find copy program: %s" copy-program))
2417
2418 ;; Set variables for computing the prompt for reading
2419 ;; password.
2420 (setq tramp-current-method (tramp-file-name-method v)
2421 tramp-current-user (tramp-file-name-user v)
2422 tramp-current-host (tramp-file-name-host v))
2423
2424 (unwind-protect
2425 (with-temp-buffer
2426 ;; The default directory must be remote.
2427 (let ((default-directory
2428 (file-name-directory (if t1 filename newname)))
2429 (process-environment (copy-sequence process-environment)))
2430 ;; Set the transfer process properties.
2431 (tramp-set-connection-property
2432 v "process-name" (buffer-name (current-buffer)))
2433 (tramp-set-connection-property
2434 v "process-buffer" (current-buffer))
2435 (while copy-env
2436 (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
2437 (setenv (pop copy-env) (pop copy-env)))
2438
2439 ;; Use an asynchronous process. By this, password can
2440 ;; be handled. The default directory must be local, in
2441 ;; order to apply the correct `copy-program'. We don't
2442 ;; set a timeout, because the copying of large files can
2443 ;; last longer than 60 secs.
2444 (let ((p (let ((default-directory
2445 (tramp-compat-temporary-file-directory)))
2446 (apply 'start-process
2447 (tramp-get-connection-property
2448 v "process-name" nil)
2449 (tramp-get-connection-property
2450 v "process-buffer" nil)
2451 copy-program
2452 (append copy-args (list source target))))))
2453 (tramp-message
2454 v 6 "%s" (mapconcat 'identity (process-command p) " "))
2455 (tramp-set-process-query-on-exit-flag p nil)
2456 (tramp-process-actions p v tramp-actions-copy-out-of-band))))
2457
2458 ;; Reset the transfer process properties.
2459 (tramp-set-connection-property v "process-name" nil)
2460 (tramp-set-connection-property v "process-buffer" nil))
2461
2462 ;; Handle KEEP-DATE argument.
2463 (when (and keep-date (not copy-keep-date))
2464 (set-file-times newname (nth 5 (file-attributes filename))))
2465
2466 ;; Set the mode.
2467 (unless (and keep-date copy-keep-date)
2468 (ignore-errors
2469 (set-file-modes newname (tramp-default-file-modes filename)))))
2470
2471 ;; If the operation was `rename', delete the original file.
2472 (unless (eq op 'copy)
2473 (if (file-regular-p filename)
2474 (delete-file filename)
2475 (tramp-compat-delete-directory filename 'recursive))))))
2476
2477(defun tramp-handle-make-directory (dir &optional parents)
2478 "Like `make-directory' for Tramp files."
2479 (setq dir (expand-file-name dir))
2480 (with-parsed-tramp-file-name dir nil
2481 (tramp-flush-directory-property v (file-name-directory localname))
2482 (save-excursion
2483 (tramp-barf-unless-okay
2484 v (format "%s %s"
2485 (if parents "mkdir -p" "mkdir")
2486 (tramp-shell-quote-argument localname))
2487 "Couldn't make directory %s" dir))))
2488
2489(defun tramp-handle-delete-directory (directory &optional recursive)
2490 "Like `delete-directory' for Tramp files."
2491 (setq directory (expand-file-name directory))
2492 (with-parsed-tramp-file-name directory nil
2493 (tramp-flush-file-property v (file-name-directory localname))
2494 (tramp-flush-directory-property v localname)
2495 (tramp-barf-unless-okay
2496 v (format "%s %s"
2497 (if recursive "rm -rf" "rmdir")
2498 (tramp-shell-quote-argument localname))
2499 "Couldn't delete %s" directory)))
2500
2501(defun tramp-handle-delete-file (filename &optional trash)
2502 "Like `delete-file' for Tramp files."
2503 (setq filename (expand-file-name filename))
2504 (with-parsed-tramp-file-name filename nil
2505 (tramp-flush-file-property v (file-name-directory localname))
2506 (tramp-flush-file-property v localname)
2507 (tramp-barf-unless-okay
2508 v (format "%s %s"
2509 (or (and trash (tramp-get-remote-trash v)) "rm -f")
2510 (tramp-shell-quote-argument localname))
2511 "Couldn't delete %s" filename)))
2512
2513;; Dired.
2514
2515;; CCC: This does not seem to be enough. Something dies when
2516;; we try and delete two directories under Tramp :/
2517(defun tramp-handle-dired-recursive-delete-directory (filename)
2518 "Recursively delete the directory given.
2519This is like `dired-recursive-delete-directory' for Tramp files."
2520 (with-parsed-tramp-file-name filename nil
2521 ;; Run a shell command 'rm -r <localname>'
2522 ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
2523 (unless (file-exists-p filename)
2524 (tramp-error v 'file-error "No such directory: %s" filename))
2525 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
2526 (tramp-send-command
2527 v
2528 (format "rm -rf %s" (tramp-shell-quote-argument localname))
2529 ;; Don't read the output, do it explicitely.
2530 nil t)
2531 ;; Wait for the remote system to return to us...
2532 ;; This might take a while, allow it plenty of time.
2533 (tramp-wait-for-output (tramp-get-connection-process v) 120)
2534 ;; Make sure that it worked...
2535 (tramp-flush-file-property v (file-name-directory localname))
2536 (tramp-flush-directory-property v localname)
2537 (and (file-exists-p filename)
2538 (tramp-error
2539 v 'file-error "Failed to recursively delete %s" filename))))
2540
2541(defun tramp-handle-dired-compress-file (file &rest ok-flag)
2542 "Like `dired-compress-file' for Tramp files."
2543 ;; OK-FLAG is valid for XEmacs only, but not implemented.
2544 ;; Code stolen mainly from dired-aux.el.
2545 (with-parsed-tramp-file-name file nil
2546 (tramp-flush-file-property v localname)
2547 (save-excursion
2548 (let ((suffixes
2549 (if (not (featurep 'xemacs))
2550 ;; Emacs case
2551 (symbol-value 'dired-compress-file-suffixes)
2552 ;; XEmacs has `dired-compression-method-alist', which is
2553 ;; transformed into `dired-compress-file-suffixes' structure.
2554 (mapcar
2555 (lambda (x)
2556 (list (concat (regexp-quote (nth 1 x)) "\\'")
2557 nil
2558 (mapconcat 'identity (nth 3 x) " ")))
2559 (symbol-value 'dired-compression-method-alist))))
2560 suffix)
2561 ;; See if any suffix rule matches this file name.
2562 (while suffixes
2563 (let (case-fold-search)
2564 (if (string-match (car (car suffixes)) localname)
2565 (setq suffix (car suffixes) suffixes nil))
2566 (setq suffixes (cdr suffixes))))
2567
2568 (cond ((file-symlink-p file)
2569 nil)
2570 ((and suffix (nth 2 suffix))
2571 ;; We found an uncompression rule.
2572 (with-progress-reporter v 0 (format "Uncompressing %s" file)
2573 (when (tramp-send-command-and-check
2574 v (concat (nth 2 suffix) " "
2575 (tramp-shell-quote-argument localname)))
2576 ;; `dired-remove-file' is not defined in XEmacs.
2577 (tramp-compat-funcall 'dired-remove-file file)
2578 (string-match (car suffix) file)
2579 (concat (substring file 0 (match-beginning 0))))))
2580 (t
2581 ;; We don't recognize the file as compressed, so compress it.
2582 ;; Try gzip.
2583 (with-progress-reporter v 0 (format "Compressing %s" file)
2584 (when (tramp-send-command-and-check
2585 v (concat "gzip -f "
2586 (tramp-shell-quote-argument localname)))
2587 ;; `dired-remove-file' is not defined in XEmacs.
2588 (tramp-compat-funcall 'dired-remove-file file)
2589 (cond ((file-exists-p (concat file ".gz"))
2590 (concat file ".gz"))
2591 ((file-exists-p (concat file ".z"))
2592 (concat file ".z"))
2593 (t nil))))))))))
2594
2595(defun tramp-handle-dired-uncache (dir &optional dir-p)
2596 "Like `dired-uncache' for Tramp files."
2597 ;; DIR-P is valid for XEmacs only.
2598 (with-parsed-tramp-file-name
2599 (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
2600 (tramp-flush-directory-property v localname)))
2601
2602(defun tramp-handle-insert-directory
2603 (filename switches &optional wildcard full-directory-p)
2604 "Like `insert-directory' for Tramp files."
2605 (setq filename (expand-file-name filename))
2606 (with-parsed-tramp-file-name filename nil
2607 (if (and (featurep 'ls-lisp)
2608 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
2609 (tramp-run-real-handler
2610 'insert-directory (list filename switches wildcard full-directory-p))
2611 (when (stringp switches)
2612 (setq switches (split-string switches)))
2613 (when (and (member "--dired" switches)
2614 (not (tramp-get-ls-command-with-dired v)))
2615 (setq switches (delete "--dired" switches)))
2616 (when wildcard
2617 (setq wildcard (tramp-run-real-handler
2618 'file-name-nondirectory (list localname)))
2619 (setq localname (tramp-run-real-handler
2620 'file-name-directory (list localname))))
2621 (unless full-directory-p
2622 (setq switches (add-to-list 'switches "-d" 'append)))
2623 (setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
2624 (when wildcard
2625 (setq switches (concat switches " " wildcard)))
2626 (tramp-message
2627 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
2628 switches filename (if wildcard "yes" "no")
2629 (if full-directory-p "yes" "no"))
2630 ;; If `full-directory-p', we just say `ls -l FILENAME'.
2631 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
2632 (if full-directory-p
2633 (tramp-send-command
2634 v
2635 (format "%s %s %s 2>/dev/null"
2636 (tramp-get-ls-command v)
2637 switches
2638 (if wildcard
2639 localname
2640 (tramp-shell-quote-argument (concat localname ".")))))
2641 (tramp-barf-unless-okay
2642 v
2643 (format "cd %s" (tramp-shell-quote-argument
2644 (tramp-run-real-handler
2645 'file-name-directory (list localname))))
2646 "Couldn't `cd %s'"
2647 (tramp-shell-quote-argument
2648 (tramp-run-real-handler 'file-name-directory (list localname))))
2649 (tramp-send-command
2650 v
2651 (format "%s %s %s"
2652 (tramp-get-ls-command v)
2653 switches
2654 (if (or wildcard
2655 (zerop (length
2656 (tramp-run-real-handler
2657 'file-name-nondirectory (list localname)))))
2658 ""
2659 (tramp-shell-quote-argument
2660 (tramp-run-real-handler
2661 'file-name-nondirectory (list localname)))))))
2662 (let ((beg (point)))
2663 ;; We cannot use `insert-buffer-substring' because the Tramp
2664 ;; buffer changes its contents before insertion due to calling
2665 ;; `expand-file' and alike.
2666 (insert
2667 (with-current-buffer (tramp-get-buffer v)
2668 (buffer-string)))
2669
2670 ;; Check for "--dired" output.
2671 (forward-line -2)
2672 (when (looking-at "//SUBDIRED//")
2673 (forward-line -1))
2674 (when (looking-at "//DIRED//\\s-+")
2675 (let ((databeg (match-end 0))
2676 (end (tramp-compat-line-end-position)))
2677 ;; Now read the numeric positions of file names.
2678 (goto-char databeg)
2679 (while (< (point) end)
2680 (let ((start (+ beg (read (current-buffer))))
2681 (end (+ beg (read (current-buffer)))))
2682 (if (memq (char-after end) '(?\n ?\ ))
2683 ;; End is followed by \n or by " -> ".
2684 (put-text-property start end 'dired-filename t))))))
2685 ;; Remove trailing lines.
2686 (goto-char (tramp-compat-line-beginning-position))
2687 (while (looking-at "//")
2688 (forward-line 1)
2689 (delete-region (match-beginning 0) (point)))
2690
2691 ;; The inserted file could be from somewhere else.
2692 (when (and (not wildcard) (not full-directory-p))
2693 (goto-char (point-max))
2694 (when (file-symlink-p filename)
2695 (goto-char (search-backward "->" beg 'noerror)))
2696 (search-backward
2697 (if (zerop (length (file-name-nondirectory filename)))
2698 "."
2699 (file-name-nondirectory filename))
2700 beg 'noerror)
2701 (replace-match (file-relative-name filename) t))
2702
2703 (goto-char (point-max))))))
2704
2705(defun tramp-handle-unhandled-file-name-directory (filename)
2706 "Like `unhandled-file-name-directory' for Tramp files."
2707 ;; With Emacs 23, we could simply return `nil'. But we must keep it
2708 ;; for backward compatibility.
2709 (expand-file-name "~/"))
2710
2711;; Canonicalization of file names.
2712
2713(defun tramp-handle-expand-file-name (name &optional dir)
2714 "Like `expand-file-name' for Tramp files.
2715If the localname part of the given filename starts with \"/../\" then
2716the result will be a local, non-Tramp, filename."
2717 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
2718 (setq dir (or dir default-directory "/"))
2719 ;; Unless NAME is absolute, concat DIR and NAME.
2720 (unless (file-name-absolute-p name)
2721 (setq name (concat (file-name-as-directory dir) name)))
2722 ;; If NAME is not a Tramp file, run the real handler.
2723 (if (not (tramp-connectable-p name))
2724 (tramp-run-real-handler 'expand-file-name (list name nil))
2725 ;; Dissect NAME.
2726 (with-parsed-tramp-file-name name nil
2727 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
2728 (setq localname (concat "~/" localname)))
2729 ;; Tilde expansion if necessary. This needs a shell which
2730 ;; groks tilde expansion! The function `tramp-find-shell' is
2731 ;; supposed to find such a shell on the remote host. Please
2732 ;; tell me about it when this doesn't work on your system.
2733 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
2734 (let ((uname (match-string 1 localname))
2735 (fname (match-string 2 localname)))
2736 ;; We cannot simply apply "~/", because under sudo "~/" is
2737 ;; expanded to the local user home directory but to the
2738 ;; root home directory. On the other hand, using always
2739 ;; the default user name for tilde expansion is not
2740 ;; appropriate either, because ssh and companions might
2741 ;; use a user name from the config file.
2742 (when (and (string-equal uname "~")
2743 (string-match "\\`su\\(do\\)?\\'" method))
2744 (setq uname (concat uname user)))
2745 (setq uname
2746 (with-connection-property v uname
2747 (tramp-send-command
2748 v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
2749 (with-current-buffer (tramp-get-buffer v)
2750 (goto-char (point-min))
2751 (buffer-substring
2752 (point) (tramp-compat-line-end-position)))))
2753 (setq localname (concat uname fname))))
2754 ;; There might be a double slash, for example when "~/"
2755 ;; expands to "/". Remove this.
2756 (while (string-match "//" localname)
2757 (setq localname (replace-match "/" t t localname)))
2758 ;; No tilde characters in file name, do normal
2759 ;; `expand-file-name' (this does "/./" and "/../"). We bind
2760 ;; `directory-sep-char' here for XEmacs on Windows, which would
2761 ;; otherwise use backslash. `default-directory' is bound,
2762 ;; because on Windows there would be problems with UNC shares or
2763 ;; Cygwin mounts.
2764 (let ((directory-sep-char ?/)
2765 (default-directory (tramp-compat-temporary-file-directory)))
2766 (tramp-make-tramp-file-name
2767 method user host
2768 (tramp-drop-volume-letter
2769 (tramp-run-real-handler
2770 'expand-file-name (list localname))))))))
2771
2772(defun tramp-handle-substitute-in-file-name (filename)
2773 "Like `substitute-in-file-name' for Tramp files.
2774\"//\" and \"/~\" substitute only in the local filename part.
2775If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
2776beginning of local filename are not substituted."
2777 ;; First, we must replace environment variables.
2778 (setq filename (tramp-replace-environment-variables filename))
2779 (with-parsed-tramp-file-name filename nil
2780 (if (equal tramp-syntax 'url)
2781 ;; We need to check localname only. The other parts cannot contain
2782 ;; "//" or "/~".
2783 (if (and (> (length localname) 1)
2784 (or (string-match "//" localname)
2785 (string-match "/~" localname 1)))
2786 (tramp-run-real-handler 'substitute-in-file-name (list filename))
2787 (tramp-make-tramp-file-name
2788 (when method (substitute-in-file-name method))
2789 (when user (substitute-in-file-name user))
2790 (when host (substitute-in-file-name host))
2791 (when localname
2792 (tramp-run-real-handler
2793 'substitute-in-file-name (list localname)))))
2794 ;; Ignore in LOCALNAME everything before "//" or "/~".
2795 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
2796 (setq filename
2797 (concat (file-remote-p filename)
2798 (replace-match "\\1" nil nil localname)))
2799 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
2800 (when (string-match "~$" filename)
2801 (setq filename (concat filename "/"))))
2802 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
2803
2804;;; Remote commands:
2805
2806(defun tramp-handle-executable-find (command)
2807 "Like `executable-find' for Tramp files."
2808 (with-parsed-tramp-file-name default-directory nil
2809 (tramp-find-executable v command (tramp-get-remote-path v) t)))
2810
2811(defun tramp-process-sentinel (proc event)
2812 "Flush file caches."
2813 (unless (memq (process-status proc) '(run open))
2814 (let ((vec (tramp-get-connection-property proc "vector" nil)))
2815 (when vec
2816 (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event)
2817 (tramp-flush-directory-property vec "")))))
2818
2819;; We use BUFFER also as connection buffer during setup. Because of
2820;; this, its original contents must be saved, and restored once
2821;; connection has been setup.
2822(defun tramp-handle-start-file-process (name buffer program &rest args)
2823 "Like `start-file-process' for Tramp files."
2824 (with-parsed-tramp-file-name default-directory nil
2825 (unwind-protect
2826 ;; When PROGRAM is nil, we just provide a tty.
2827 (let ((command
2828 (when (stringp program)
2829 (format "cd %s; exec %s"
2830 (tramp-shell-quote-argument localname)
2831 (mapconcat 'tramp-shell-quote-argument
2832 (cons program args) " "))))
2833 (tramp-process-connection-type
2834 (or (null program) tramp-process-connection-type))
2835 (name1 name)
2836 (i 0))
2837 (unless buffer
2838 ;; BUFFER can be nil. We use a temporary buffer.
2839 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
2840 (while (get-process name1)
2841 ;; NAME must be unique as process name.
2842 (setq i (1+ i)
2843 name1 (format "%s<%d>" name i)))
2844 (setq name name1)
2845 ;; Set the new process properties.
2846 (tramp-set-connection-property v "process-name" name)
2847 (tramp-set-connection-property v "process-buffer" buffer)
2848 ;; Activate narrowing in order to save BUFFER contents.
2849 ;; Clear also the modification time; otherwise we might be
2850 ;; interrupted by `verify-visited-file-modtime'.
2851 (with-current-buffer (tramp-get-connection-buffer v)
2852 (clear-visited-file-modtime)
2853 (narrow-to-region (point-max) (point-max)))
2854 (if command
2855 ;; Send the command.
2856 (tramp-send-command v command nil t) ; nooutput
2857 ;; Check, whether a pty is associated.
2858 (tramp-maybe-open-connection v)
2859 (unless (tramp-compat-process-get
2860 (tramp-get-connection-process v) 'remote-tty)
2861 (tramp-error
2862 v 'file-error "pty association is not supported for `%s'" name)))
2863 (let ((p (tramp-get-connection-process v)))
2864 ;; Set sentinel and query flag for this process.
2865 (tramp-set-connection-property p "vector" v)
2866 (set-process-sentinel p 'tramp-process-sentinel)
2867 (tramp-set-process-query-on-exit-flag p t)
2868 ;; Return process.
2869 p))
2870 ;; Save exit.
2871 (with-current-buffer (tramp-get-connection-buffer v)
2872 (if (string-match tramp-temp-buffer-name (buffer-name))
2873 (progn
2874 (set-process-buffer (tramp-get-connection-process v) nil)
2875 (kill-buffer (current-buffer)))
2876 (widen)
2877 (goto-char (point-max))))
2878 (tramp-set-connection-property v "process-name" nil)
2879 (tramp-set-connection-property v "process-buffer" nil))))
2880
2881(defun tramp-handle-process-file
2882 (program &optional infile destination display &rest args)
2883 "Like `process-file' for Tramp files."
2884 ;; The implementation is not complete yet.
2885 (when (and (numberp destination) (zerop destination))
2886 (error "Implementation does not handle immediate return"))
2887
2888 (with-parsed-tramp-file-name default-directory nil
2889 (let (command input tmpinput stderr tmpstderr outbuf ret)
2890 ;; Compute command.
2891 (setq command (mapconcat 'tramp-shell-quote-argument
2892 (cons program args) " "))
2893 ;; Determine input.
2894 (if (null infile)
2895 (setq input "/dev/null")
2896 (setq infile (expand-file-name infile))
2897 (if (tramp-equal-remote default-directory infile)
2898 ;; INFILE is on the same remote host.
2899 (setq input (with-parsed-tramp-file-name infile nil localname))
2900 ;; INFILE must be copied to remote host.
2901 (setq input (tramp-make-tramp-temp-file v)
2902 tmpinput (tramp-make-tramp-file-name method user host input))
2903 (copy-file infile tmpinput t)))
2904 (when input (setq command (format "%s <%s" command input)))
2905
2906 ;; Determine output.
2907 (cond
2908 ;; Just a buffer.
2909 ((bufferp destination)
2910 (setq outbuf destination))
2911 ;; A buffer name.
2912 ((stringp destination)
2913 (setq outbuf (get-buffer-create destination)))
2914 ;; (REAL-DESTINATION ERROR-DESTINATION)
2915 ((consp destination)
2916 ;; output.
2917 (cond
2918 ((bufferp (car destination))
2919 (setq outbuf (car destination)))
2920 ((stringp (car destination))
2921 (setq outbuf (get-buffer-create (car destination))))
2922 ((car destination)
2923 (setq outbuf (current-buffer))))
2924 ;; stderr.
2925 (cond
2926 ((stringp (cadr destination))
2927 (setcar (cdr destination) (expand-file-name (cadr destination)))
2928 (if (tramp-equal-remote default-directory (cadr destination))
2929 ;; stderr is on the same remote host.
2930 (setq stderr (with-parsed-tramp-file-name
2931 (cadr destination) nil localname))
2932 ;; stderr must be copied to remote host. The temporary
2933 ;; file must be deleted after execution.
2934 (setq stderr (tramp-make-tramp-temp-file v)
2935 tmpstderr (tramp-make-tramp-file-name
2936 method user host stderr))))
2937 ;; stderr to be discarded.
2938 ((null (cadr destination))
2939 (setq stderr "/dev/null"))))
2940 ;; 't
2941 (destination
2942 (setq outbuf (current-buffer))))
2943 (when stderr (setq command (format "%s 2>%s" command stderr)))
2944
2945 ;; Send the command. It might not return in time, so we protect
2946 ;; it. Call it in a subshell, in order to preserve working
2947 ;; directory.
2948 (condition-case nil
2949 (unwind-protect
2950 (setq ret
2951 (if (tramp-send-command-and-check
2952 v (format "\\cd %s; %s"
2953 (tramp-shell-quote-argument localname)
2954 command)
2955 t t)
2956 0 1))
2957 ;; We should show the output anyway.
2958 (when outbuf
2959 (with-current-buffer outbuf
2960 (insert
2961 (with-current-buffer (tramp-get-connection-buffer v)
2962 (buffer-string))))
2963 (when display (display-buffer outbuf))))
2964 ;; When the user did interrupt, we should do it also. We use
2965 ;; return code -1 as marker.
2966 (quit
2967 (kill-buffer (tramp-get-connection-buffer v))
2968 (setq ret -1))
2969 ;; Handle errors.
2970 (error
2971 (kill-buffer (tramp-get-connection-buffer v))
2972 (setq ret 1)))
2973
2974 ;; Provide error file.
2975 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
2976
2977 ;; Cleanup. We remove all file cache values for the connection,
2978 ;; because the remote process could have changed them.
2979 (when tmpinput (delete-file tmpinput))
2980
2981 ;; `process-file-side-effects' has been introduced with GNU
2982 ;; Emacs 23.2. If set to `nil', no remote file will be changed
2983 ;; by `program'. If it doesn't exist, we assume its default
2984 ;; value 't'.
2985 (unless (and (boundp 'process-file-side-effects)
2986 (not (symbol-value 'process-file-side-effects)))
2987 (tramp-flush-directory-property v ""))
2988
2989 ;; Return exit status.
2990 (if (equal ret -1)
2991 (keyboard-quit)
2992 ret))))
2993
2994(defun tramp-handle-call-process-region
2995 (start end program &optional delete buffer display &rest args)
2996 "Like `call-process-region' for Tramp files."
2997 (let ((tmpfile (tramp-compat-make-temp-file "")))
2998 (write-region start end tmpfile)
2999 (when delete (delete-region start end))
3000 (unwind-protect
3001 (apply 'call-process program tmpfile buffer display args)
3002 (delete-file tmpfile))))
3003
3004(defun tramp-handle-shell-command
3005 (command &optional output-buffer error-buffer)
3006 "Like `shell-command' for Tramp files."
3007 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
3008 ;; We cannot use `shell-file-name' and `shell-command-switch',
3009 ;; they are variables of the local host.
3010 (args (list
3011 (tramp-get-method-parameter
3012 (tramp-file-name-method
3013 (tramp-dissect-file-name default-directory))
3014 'tramp-remote-sh)
3015 "-c" (substring command 0 asynchronous)))
3016 current-buffer-p
3017 (output-buffer
3018 (cond
3019 ((bufferp output-buffer) output-buffer)
3020 ((stringp output-buffer) (get-buffer-create output-buffer))
3021 (output-buffer
3022 (setq current-buffer-p t)
3023 (current-buffer))
3024 (t (get-buffer-create
3025 (if asynchronous
3026 "*Async Shell Command*"
3027 "*Shell Command Output*")))))
3028 (error-buffer
3029 (cond
3030 ((bufferp error-buffer) error-buffer)
3031 ((stringp error-buffer) (get-buffer-create error-buffer))))
3032 (buffer
3033 (if (and (not asynchronous) error-buffer)
3034 (with-parsed-tramp-file-name default-directory nil
3035 (list output-buffer (tramp-make-tramp-temp-file v)))
3036 output-buffer))
3037 (p (get-buffer-process output-buffer)))
3038
3039 ;; Check whether there is another process running. Tramp does not
3040 ;; support 2 (asynchronous) processes in parallel.
3041 (when p
3042 (if (yes-or-no-p "A command is running. Kill it? ")
3043 (ignore-errors (kill-process p))
3044 (error "Shell command in progress")))
3045
3046 (if current-buffer-p
3047 (progn
3048 (barf-if-buffer-read-only)
3049 (push-mark nil t))
3050 (with-current-buffer output-buffer
3051 (setq buffer-read-only nil)
3052 (erase-buffer)))
3053
3054 (if (and (not current-buffer-p) (integerp asynchronous))
3055 (prog1
3056 ;; Run the process.
3057 (apply 'start-file-process "*Async Shell*" buffer args)
3058 ;; Display output.
3059 (pop-to-buffer output-buffer)
3060 (setq mode-line-process '(":%s"))
3061 (shell-mode))
3062
3063 (prog1
3064 ;; Run the process.
3065 (apply 'process-file (car args) nil buffer nil (cdr args))
3066 ;; Insert error messages if they were separated.
3067 (when (listp buffer)
3068 (with-current-buffer error-buffer
3069 (insert-file-contents (cadr buffer)))
3070 (delete-file (cadr buffer)))
3071 (if current-buffer-p
3072 ;; This is like exchange-point-and-mark, but doesn't
3073 ;; activate the mark. It is cleaner to avoid activation,
3074 ;; even though the command loop would deactivate the mark
3075 ;; because we inserted text.
3076 (goto-char (prog1 (mark t)
3077 (set-marker (mark-marker) (point)
3078 (current-buffer))))
3079 ;; There's some output, display it.
3080 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
3081 (if (functionp 'display-message-or-buffer)
3082 (tramp-compat-funcall 'display-message-or-buffer output-buffer)
3083 (pop-to-buffer output-buffer))))))))
3084
3085(defun tramp-handle-file-local-copy (filename)
3086 "Like `file-local-copy' for Tramp files."
3087
3088 (with-parsed-tramp-file-name filename nil
3089 (unless (file-exists-p filename)
3090 (tramp-error
3091 v 'file-error
3092 "Cannot make local copy of non-existing file `%s'" filename))
3093
3094 (let* ((size (nth 7 (file-attributes filename)))
3095 (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
3096 (loc-dec (tramp-get-inline-coding v "local-decoding" size))
3097 (tmpfile (tramp-compat-make-temp-file filename)))
3098
3099 (condition-case err
3100 (cond
3101 ;; `copy-file' handles direct copy and out-of-band methods.
3102 ((or (tramp-local-host-p v)
3103 (tramp-method-out-of-band-p v size))
3104 (copy-file filename tmpfile t t))
3105
3106 ;; Use inline encoding for file transfer.
3107 (rem-enc
3108 (save-excursion
3109 (with-progress-reporter
3110 v 3 (format "Encoding remote file %s" filename)
3111 (tramp-barf-unless-okay
3112 v (format rem-enc (tramp-shell-quote-argument localname))
3113 "Encoding remote file failed"))
3114
3115 (if (functionp loc-dec)
3116 ;; If local decoding is a function, we call it. We
3117 ;; must disable multibyte, because
3118 ;; `uudecode-decode-region' doesn't handle it
3119 ;; correctly.
3120 (with-temp-buffer
3121 (set-buffer-multibyte nil)
3122 (insert-buffer-substring (tramp-get-buffer v))
3123 (with-progress-reporter
3124 v 3 (format "Decoding remote file %s with function %s"
3125 filename loc-dec)
3126 (funcall loc-dec (point-min) (point-max))
3127 ;; Unset `file-name-handler-alist'. Otherwise,
3128 ;; epa-file gets confused.
3129 (let (file-name-handler-alist
3130 (coding-system-for-write 'binary))
3131 (write-region (point-min) (point-max) tmpfile))))
3132
3133 ;; If tramp-decoding-function is not defined for this
3134 ;; method, we invoke tramp-decoding-command instead.
3135 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
3136 ;; Unset `file-name-handler-alist'. Otherwise,
3137 ;; epa-file gets confused.
3138 (let (file-name-handler-alist
3139 (coding-system-for-write 'binary))
3140 (write-region (point-min) (point-max) tmpfile2))
3141 (with-progress-reporter
3142 v 3 (format "Decoding remote file %s with command %s"
3143 filename loc-dec)
3144 (unwind-protect
3145 (tramp-call-local-coding-command
3146 loc-dec tmpfile2 tmpfile)
3147 (delete-file tmpfile2)))))
3148
3149 ;; Set proper permissions.
3150 (set-file-modes tmpfile (tramp-default-file-modes filename))
3151 ;; Set local user ownership.
3152 (tramp-set-file-uid-gid tmpfile)))
3153
3154 ;; Oops, I don't know what to do.
3155 (t (tramp-error
3156 v 'file-error "Wrong method specification for `%s'" method)))
3157
3158 ;; Error handling.
3159 ((error quit)
3160 (delete-file tmpfile)
3161 (signal (car err) (cdr err))))
3162
3163 (run-hooks 'tramp-handle-file-local-copy-hook)
3164 tmpfile)))
3165
3166(defun tramp-handle-file-remote-p (filename &optional identification connected)
3167 "Like `file-remote-p' for Tramp files."
3168 (let ((tramp-verbose 3))
3169 (when (tramp-tramp-file-p filename)
3170 (let* ((v (tramp-dissect-file-name filename))
3171 (p (tramp-get-connection-process v))
3172 (c (and p (processp p) (memq (process-status p) '(run open)))))
3173 ;; We expand the file name only, if there is already a connection.
3174 (with-parsed-tramp-file-name
3175 (if c (expand-file-name filename) filename) nil
3176 (and (or (not connected) c)
3177 (cond
3178 ((eq identification 'method) method)
3179 ((eq identification 'user) user)
3180 ((eq identification 'host) host)
3181 ((eq identification 'localname) localname)
3182 (t (tramp-make-tramp-file-name method user host "")))))))))
3183
3184(defun tramp-handle-insert-file-contents
3185 (filename &optional visit beg end replace)
3186 "Like `insert-file-contents' for Tramp files."
3187 (barf-if-buffer-read-only)
3188 (setq filename (expand-file-name filename))
3189 (let (result local-copy remote-copy)
3190 (with-parsed-tramp-file-name filename nil
3191 (unwind-protect
3192 (if (not (file-exists-p filename))
3193 ;; We don't raise a Tramp error, because it might be
3194 ;; suppressed, like in `find-file-noselect-1'.
3195 (signal 'file-error
3196 (list "File not found on remote host" filename))
3197
3198 (if (and (tramp-local-host-p v)
3199 (let (file-name-handler-alist)
3200 (file-readable-p localname)))
3201 ;; Short track: if we are on the local host, we can
3202 ;; run directly.
3203 (setq result
3204 (tramp-run-real-handler
3205 'insert-file-contents
3206 (list localname visit beg end replace)))
3207
3208 ;; When we shall insert only a part of the file, we copy
3209 ;; this part.
3210 (when (or beg end)
3211 (setq remote-copy (tramp-make-tramp-temp-file v))
3212 (tramp-send-command
3213 v
3214 (cond
3215 ((and beg end)
3216 (format "tail -c +%d %s | head -c +%d >%s"
3217 (1+ beg) (tramp-shell-quote-argument localname)
3218 (- end beg) remote-copy))
3219 (beg
3220 (format "tail -c +%d %s >%s"
3221 (1+ beg) (tramp-shell-quote-argument localname)
3222 remote-copy))
3223 (end
3224 (format "head -c +%d %s >%s"
3225 (1+ end) (tramp-shell-quote-argument localname)
3226 remote-copy)))))
3227
3228 ;; `insert-file-contents-literally' takes care to avoid
3229 ;; calling jka-compr. By let-binding
3230 ;; `inhibit-file-name-operation', we propagate that care
3231 ;; to the `file-local-copy' operation.
3232 (setq local-copy
3233 (let ((inhibit-file-name-operation
3234 (when (eq inhibit-file-name-operation
3235 'insert-file-contents)
3236 'file-local-copy)))
3237 (cond
3238 ((stringp remote-copy)
3239 (file-local-copy
3240 (tramp-make-tramp-file-name
3241 method user host remote-copy)))
3242 ((stringp tramp-temp-buffer-file-name)
3243 (copy-file filename tramp-temp-buffer-file-name 'ok)
3244 tramp-temp-buffer-file-name)
3245 (t (file-local-copy filename)))))
3246
3247 ;; When the file is not readable for the owner, it
3248 ;; cannot be inserted, even it is redable for the group
3249 ;; or for everybody.
3250 (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
3251
3252 (when (and (null remote-copy)
3253 (tramp-get-method-parameter
3254 method 'tramp-copy-keep-tmpfile))
3255 ;; We keep the local file for performance reasons,
3256 ;; useful for "rsync".
3257 (setq tramp-temp-buffer-file-name local-copy)
3258 (put 'tramp-temp-buffer-file-name 'permanent-local t))
3259
3260 (with-progress-reporter
3261 v 3 (format "Inserting local temp file `%s'" local-copy)
3262 ;; We must ensure that `file-coding-system-alist'
3263 ;; matches `local-copy'.
3264 (let ((file-coding-system-alist
3265 (tramp-find-file-name-coding-system-alist
3266 filename local-copy)))
3267 (setq result
3268 (insert-file-contents
3269 local-copy nil nil nil replace))))))
3270
3271 ;; Save exit.
3272 (progn
3273 (when visit
3274 (setq buffer-file-name filename)
3275 (setq buffer-read-only (not (file-writable-p filename)))
3276 (set-visited-file-modtime)
3277 (set-buffer-modified-p nil))
3278 (when (and (stringp local-copy)
3279 (or remote-copy (null tramp-temp-buffer-file-name)))
3280 (delete-file local-copy))
3281 (when (stringp remote-copy)
3282 (delete-file
3283 (tramp-make-tramp-file-name method user host remote-copy))))))
3284
3285 ;; Result.
3286 (list (expand-file-name filename)
3287 (cadr result))))
3288
3289;; This is needed for XEmacs only. Code stolen from files.el.
3290(defun tramp-handle-insert-file-contents-literally
3291 (filename &optional visit beg end replace)
3292 "Like `insert-file-contents-literally' for Tramp files."
3293 (let ((format-alist nil)
3294 (after-insert-file-functions nil)
3295 (coding-system-for-read 'no-conversion)
3296 (coding-system-for-write 'no-conversion)
3297 (find-buffer-file-type-function
3298 (if (fboundp 'find-buffer-file-type)
3299 (symbol-function 'find-buffer-file-type)
3300 nil))
3301 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
3302 (inhibit-file-name-operation 'insert-file-contents))
3303 (unwind-protect
3304 (progn
3305 (fset 'find-buffer-file-type (lambda (filename) t))
3306 (insert-file-contents filename visit beg end replace))
3307 ;; Save exit.
3308 (if find-buffer-file-type-function
3309 (fset 'find-buffer-file-type find-buffer-file-type-function)
3310 (fmakunbound 'find-buffer-file-type)))))
3311
3312(defun tramp-handle-find-backup-file-name (filename)
3313 "Like `find-backup-file-name' for Tramp files."
3314 (with-parsed-tramp-file-name filename nil
3315 ;; We set both variables. It doesn't matter whether it is
3316 ;; Emacs or XEmacs.
3317 (let ((backup-directory-alist
3318 ;; Emacs case.
3319 (when (boundp 'backup-directory-alist)
3320 (if (symbol-value 'tramp-backup-directory-alist)
3321 (mapcar
3322 (lambda (x)
3323 (cons
3324 (car x)
3325 (if (and (stringp (cdr x))
3326 (file-name-absolute-p (cdr x))
3327 (not (tramp-file-name-p (cdr x))))
3328 (tramp-make-tramp-file-name method user host (cdr x))
3329 (cdr x))))
3330 (symbol-value 'tramp-backup-directory-alist))
3331 (symbol-value 'backup-directory-alist))))
3332
3333 (bkup-backup-directory-info
3334 ;; XEmacs case.
3335 (when (boundp 'bkup-backup-directory-info)
3336 (if (symbol-value 'tramp-bkup-backup-directory-info)
3337 (mapcar
3338 (lambda (x)
3339 (nconc
3340 (list (car x))
3341 (list
3342 (if (and (stringp (car (cdr x)))
3343 (file-name-absolute-p (car (cdr x)))
3344 (not (tramp-file-name-p (car (cdr x)))))
3345 (tramp-make-tramp-file-name
3346 method user host (car (cdr x)))
3347 (car (cdr x))))
3348 (cdr (cdr x))))
3349 (symbol-value 'tramp-bkup-backup-directory-info))
3350 (symbol-value 'bkup-backup-directory-info)))))
3351
3352 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
3353
3354(defun tramp-handle-make-auto-save-file-name ()
3355 "Like `make-auto-save-file-name' for Tramp files.
3356Returns a file name in `tramp-auto-save-directory' for autosaving this file."
3357 (let ((tramp-auto-save-directory tramp-auto-save-directory)
3358 (buffer-file-name
3359 (tramp-subst-strs-in-string
3360 '(("_" . "|")
3361 ("/" . "_a")
3362 (":" . "_b")
3363 ("|" . "__")
3364 ("[" . "_l")
3365 ("]" . "_r"))
3366 (buffer-file-name))))
3367 ;; File name must be unique. This is ensured with Emacs 22 (see
3368 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
3369 ;; all other cases we must do it ourselves.
3370 (when (boundp 'auto-save-file-name-transforms)
3371 (mapc
3372 (lambda (x)
3373 (when (and (string-match (car x) buffer-file-name)
3374 (not (car (cddr x))))
3375 (setq tramp-auto-save-directory
3376 (or tramp-auto-save-directory
3377 (tramp-compat-temporary-file-directory)))))
3378 (symbol-value 'auto-save-file-name-transforms)))
3379 ;; Create directory.
3380 (when tramp-auto-save-directory
3381 (setq buffer-file-name
3382 (expand-file-name buffer-file-name tramp-auto-save-directory))
3383 (unless (file-exists-p tramp-auto-save-directory)
3384 (make-directory tramp-auto-save-directory t)))
3385 ;; Run plain `make-auto-save-file-name'. There might be an advice when
3386 ;; it is not a magic file name operation (since Emacs 22).
3387 ;; We must deactivate it temporarily.
3388 (if (not (ad-is-active 'make-auto-save-file-name))
3389 (tramp-run-real-handler 'make-auto-save-file-name nil)
3390 ;; else
3391 (ad-deactivate 'make-auto-save-file-name)
3392 (prog1
3393 (tramp-run-real-handler 'make-auto-save-file-name nil)
3394 (ad-activate 'make-auto-save-file-name)))))
3395
3396(defvar tramp-handle-write-region-hook nil
3397 "Normal hook to be run at the end of `tramp-handle-write-region'.")
3398
3399;; CCC grok LOCKNAME
3400(defun tramp-handle-write-region
3401 (start end filename &optional append visit lockname confirm)
3402 "Like `write-region' for Tramp files."
3403 (setq filename (expand-file-name filename))
3404 (with-parsed-tramp-file-name filename nil
3405 ;; Following part commented out because we don't know what to do about
3406 ;; file locking, and it does not appear to be a problem to ignore it.
3407 ;; Ange-ftp ignores it, too.
3408 ;; (when (and lockname (stringp lockname))
3409 ;; (setq lockname (expand-file-name lockname)))
3410 ;; (unless (or (eq lockname nil)
3411 ;; (string= lockname filename))
3412 ;; (error
3413 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
3414
3415 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
3416 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
3417 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
3418 (tramp-error v 'file-error "File not overwritten")))
3419
3420 (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
3421 (tramp-get-remote-uid v 'integer)))
3422 (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
3423 (tramp-get-remote-gid v 'integer))))
3424
3425 (if (and (tramp-local-host-p v)
3426 ;; `file-writable-p' calls `file-expand-file-name'. We
3427 ;; cannot use `tramp-run-real-handler' therefore.
3428 (let (file-name-handler-alist)
3429 (and
3430 (file-writable-p (file-name-directory localname))
3431 (or (file-directory-p localname)
3432 (file-writable-p localname)))))
3433 ;; Short track: if we are on the local host, we can run directly.
3434 (tramp-run-real-handler
3435 'write-region
3436 (list start end localname append 'no-message lockname confirm))
3437
3438 (let ((modes (save-excursion (tramp-default-file-modes filename)))
3439 ;; We use this to save the value of
3440 ;; `last-coding-system-used' after writing the tmp
3441 ;; file. At the end of the function, we set
3442 ;; `last-coding-system-used' to this saved value. This
3443 ;; way, any intermediary coding systems used while
3444 ;; talking to the remote shell or suchlike won't hose
3445 ;; this variable. This approach was snarfed from
3446 ;; ange-ftp.el.
3447 coding-system-used
3448 ;; Write region into a tmp file. This isn't really
3449 ;; needed if we use an encoding function, but currently
3450 ;; we use it always because this makes the logic
3451 ;; simpler.
3452 (tmpfile (or tramp-temp-buffer-file-name
3453 (tramp-compat-make-temp-file filename))))
3454
3455 ;; If `append' is non-nil, we copy the file locally, and let
3456 ;; the native `write-region' implementation do the job.
3457 (when append (copy-file filename tmpfile 'ok))
3458
3459 ;; We say `no-message' here because we don't want the
3460 ;; visited file modtime data to be clobbered from the temp
3461 ;; file. We call `set-visited-file-modtime' ourselves later
3462 ;; on. We must ensure that `file-coding-system-alist'
3463 ;; matches `tmpfile'.
3464 (let (file-name-handler-alist
3465 (file-coding-system-alist
3466 (tramp-find-file-name-coding-system-alist filename tmpfile)))
3467 (condition-case err
3468 (tramp-run-real-handler
3469 'write-region
3470 (list start end tmpfile append 'no-message lockname confirm))
3471 ((error quit)
3472 (setq tramp-temp-buffer-file-name nil)
3473 (delete-file tmpfile)
3474 (signal (car err) (cdr err))))
3475
3476 ;; Now, `last-coding-system-used' has the right value. Remember it.
3477 (when (boundp 'last-coding-system-used)
3478 (setq coding-system-used
3479 (symbol-value 'last-coding-system-used))))
3480
3481 ;; The permissions of the temporary file should be set. If
3482 ;; filename does not exist (eq modes nil) it has been
3483 ;; renamed to the backup file. This case `save-buffer'
3484 ;; handles permissions.
3485 ;; Ensure, that it is still readable.
3486 (when modes
3487 (set-file-modes
3488 tmpfile
3489 (logior (or modes 0) (tramp-compat-octal-to-decimal "0400"))))
3490
3491 ;; This is a bit lengthy due to the different methods
3492 ;; possible for file transfer. First, we check whether the
3493 ;; method uses an rcp program. If so, we call it.
3494 ;; Otherwise, both encoding and decoding command must be
3495 ;; specified. However, if the method _also_ specifies an
3496 ;; encoding function, then that is used for encoding the
3497 ;; contents of the tmp file.
3498 (let* ((size (nth 7 (file-attributes tmpfile)))
3499 (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
3500 (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
3501 (cond
3502 ;; `copy-file' handles direct copy and out-of-band methods.
3503 ((or (tramp-local-host-p v)
3504 (tramp-method-out-of-band-p v size))
3505 (if (and (not (stringp start))
3506 (= (or end (point-max)) (point-max))
3507 (= (or start (point-min)) (point-min))
3508 (tramp-get-method-parameter
3509 method 'tramp-copy-keep-tmpfile))
3510 (progn
3511 (setq tramp-temp-buffer-file-name tmpfile)
3512 (condition-case err
3513 ;; We keep the local file for performance
3514 ;; reasons, useful for "rsync".
3515 (copy-file tmpfile filename t)
3516 ((error quit)
3517 (setq tramp-temp-buffer-file-name nil)
3518 (delete-file tmpfile)
3519 (signal (car err) (cdr err)))))
3520 (setq tramp-temp-buffer-file-name nil)
3521 ;; Don't rename, in order to keep context in SELinux.
3522 (unwind-protect
3523 (copy-file tmpfile filename t)
3524 (delete-file tmpfile))))
3525
3526 ;; Use inline file transfer.
3527 (rem-dec
3528 ;; Encode tmpfile.
3529 (unwind-protect
3530 (with-temp-buffer
3531 (set-buffer-multibyte nil)
3532 ;; Use encoding function or command.
3533 (if (functionp loc-enc)
3534 (with-progress-reporter
3535 v 3 (format "Encoding region using function `%s'"
3536 loc-enc)
3537 (let ((coding-system-for-read 'binary))
3538 (insert-file-contents-literally tmpfile))
3539 ;; The following `let' is a workaround for the
3540 ;; base64.el that comes with pgnus-0.84. If
3541 ;; both of the following conditions are
3542 ;; satisfied, it tries to write to a local
3543 ;; file in default-directory, but at this
3544 ;; point, default-directory is remote.
3545 ;; (`call-process-region' can't write to
3546 ;; remote files, it seems.) The file in
3547 ;; question is a tmp file anyway.
3548 (let ((default-directory
3549 (tramp-compat-temporary-file-directory)))
3550 (funcall loc-enc (point-min) (point-max))))
3551
3552 (with-progress-reporter
3553 v 3 (format "Encoding region using command `%s'"
3554 loc-enc)
3555 (unless (zerop (tramp-call-local-coding-command
3556 loc-enc tmpfile t))
3557 (tramp-error
3558 v 'file-error
3559 (concat "Cannot write to `%s', "
3560 "local encoding command `%s' failed")
3561 filename loc-enc))))
3562
3563 ;; Send buffer into remote decoding command which
3564 ;; writes to remote file. Because this happens on
3565 ;; the remote host, we cannot use the function.
3566 (with-progress-reporter
3567 v 3
3568 (format "Decoding region into remote file %s" filename)
3569 (goto-char (point-max))
3570 (unless (bolp) (newline))
3571 (tramp-send-command
3572 v
3573 (format
3574 (concat rem-dec " <<'EOF'\n%sEOF")
3575 (tramp-shell-quote-argument localname)
3576 (buffer-string)))
3577 (tramp-barf-unless-okay
3578 v nil
3579 "Couldn't write region to `%s', decode using `%s' failed"
3580 filename rem-dec)
3581 ;; When `file-precious-flag' is set, the region is
3582 ;; written to a temporary file. Check that the
3583 ;; checksum is equal to that from the local tmpfile.
3584 (when file-precious-flag
3585 (erase-buffer)
3586 (and
3587 ;; cksum runs locally, if possible.
3588 (zerop (tramp-compat-call-process "cksum" tmpfile t))
3589 ;; cksum runs remotely.
3590 (tramp-send-command-and-check
3591 v
3592 (format
3593 "cksum <%s" (tramp-shell-quote-argument localname)))
3594 ;; ... they are different.
3595 (not
3596 (string-equal
3597 (buffer-string)
3598 (with-current-buffer (tramp-get-buffer v)
3599 (buffer-string))))
3600 (tramp-error
3601 v 'file-error
3602 (concat "Couldn't write region to `%s',"
3603 " decode using `%s' failed")
3604 filename rem-dec)))))
3605
3606 ;; Save exit.
3607 (delete-file tmpfile)))
3608
3609 ;; That's not expected.
3610 (t
3611 (tramp-error
3612 v 'file-error
3613 (concat "Method `%s' should specify both encoding and "
3614 "decoding command or an rcp program")
3615 method))))
3616
3617 ;; Make `last-coding-system-used' have the right value.
3618 (when coding-system-used
3619 (set 'last-coding-system-used coding-system-used))))
3620
3621 (tramp-flush-file-property v (file-name-directory localname))
3622 (tramp-flush-file-property v localname)
3623
3624 ;; We must protect `last-coding-system-used', now we have set it
3625 ;; to its correct value.
3626 (let (last-coding-system-used (need-chown t))
3627 ;; Set file modification time.
3628 (when (or (eq visit t) (stringp visit))
3629 (let ((file-attr (file-attributes filename)))
3630 (set-visited-file-modtime
3631 ;; We must pass modtime explicitely, because filename can
3632 ;; be different from (buffer-file-name), f.e. if
3633 ;; `file-precious-flag' is set.
3634 (nth 5 file-attr))
3635 (when (and (eq (nth 2 file-attr) uid)
3636 (eq (nth 3 file-attr) gid))
3637 (setq need-chown nil))))
3638
3639 ;; Set the ownership.
3640 (when need-chown
3641 (tramp-set-file-uid-gid filename uid gid))
3642 (when (or (eq visit t) (null visit) (stringp visit))
3643 (tramp-message v 0 "Wrote %s" filename))
3644 (run-hooks 'tramp-handle-write-region-hook)))))
3645
3646(defvar tramp-vc-registered-file-names nil
3647 "List used to collect file names, which are checked during `vc-registered'.")
3648
3649;; VC backends check for the existence of various different special
3650;; files. This is very time consuming, because every single check
3651;; requires a remote command (the file cache must be invalidated).
3652;; Therefore, we apply a kind of optimization. We install the file
3653;; name handler `tramp-vc-file-name-handler', which does nothing but
3654;; remembers all file names for which `file-exists-p' or
3655;; `file-readable-p' has been applied. A first run of `vc-registered'
3656;; is performed. Afterwards, a script is applied for all collected
3657;; file names, using just one remote command. The result of this
3658;; script is used to fill the file cache with actual values. Now we
3659;; can reset the file name handlers, and we make a second run of
3660;; `vc-registered', which returns the expected result without sending
3661;; any other remote command.
3662(defun tramp-handle-vc-registered (file)
3663 "Like `vc-registered' for Tramp files."
3664 (tramp-compat-with-temp-message ""
3665 (with-parsed-tramp-file-name file nil
3666 (with-progress-reporter
3667 v 3 (format "Checking `vc-registered' for %s" file)
3668
3669 ;; There could be new files, created by the vc backend. We
3670 ;; cannot reuse the old cache entries, therefore.
3671 (let (tramp-vc-registered-file-names
3672 (tramp-cache-inhibit-cache (current-time))
3673 (file-name-handler-alist
3674 `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
3675
3676 ;; Here we collect only file names, which need an operation.
3677 (tramp-run-real-handler 'vc-registered (list file))
3678 (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
3679
3680 ;; Send just one command, in order to fill the cache.
3681 (when tramp-vc-registered-file-names
3682 (tramp-maybe-send-script
3683 v
3684 (format tramp-vc-registered-read-file-names
3685 (tramp-get-file-exists-command v)
3686 (format "%s -r" (tramp-get-test-command v)))
3687 "tramp_vc_registered_read_file_names")
3688
3689 (dolist
3690 (elt
3691 (tramp-send-command-and-read
3692 v
3693 (format
3694 "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
3695 (mapconcat 'tramp-shell-quote-argument
3696 tramp-vc-registered-file-names
3697 "\n"))))
3698
3699 (tramp-set-file-property
3700 v (car elt) (cadr elt) (cadr (cdr elt))))))
3701
3702 ;; Second run. Now all `file-exists-p' or `file-readable-p'
3703 ;; calls shall be answered from the file cache. We unset
3704 ;; `process-file-side-effects' in order to keep the cache when
3705 ;; `process-file' calls appear.
3706 (let (process-file-side-effects)
3707 (tramp-run-real-handler 'vc-registered (list file)))))))
3708
3709;;;###tramp-autoload
3710(defun tramp-sh-file-name-handler (operation &rest args)
3711 "Invoke remote-shell Tramp file name handler.
3712Fall back to normal file name handler if no Tramp handler exists."
3713 (when (and tramp-locked (not tramp-locker))
3714 (setq tramp-locked nil)
3715 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
3716 (let ((tl tramp-locked))
3717 (unwind-protect
3718 (progn
3719 (setq tramp-locked t)
3720 (let ((tramp-locker t))
3721 (save-match-data
3722 (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
3723 (if fn
3724 (apply (cdr fn) args)
3725 (tramp-run-real-handler operation args))))))
3726 (setq tramp-locked tl))))
3727
3728(defun tramp-vc-file-name-handler (operation &rest args)
3729 "Invoke special file name handler, which collects files to be handled."
3730 (save-match-data
3731 (let ((filename
3732 (tramp-replace-environment-variables
3733 (apply 'tramp-file-name-for-operation operation args)))
3734 (fn (assoc operation tramp-sh-file-name-handler-alist)))
3735 (with-parsed-tramp-file-name filename nil
3736 (cond
3737 ;; That's what we want: file names, for which checks are
3738 ;; applied. We assume, that VC uses only `file-exists-p' and
3739 ;; `file-readable-p' checks; otherwise we must extend the
3740 ;; list. We do not perform any action, but return nil, in
3741 ;; order to keep `vc-registered' running.
3742 ((and fn (memq operation '(file-exists-p file-readable-p)))
3743 (add-to-list 'tramp-vc-registered-file-names localname 'append)
3744 nil)
3745 ;; Tramp file name handlers like `expand-file-name'. They
3746 ;; must still work.
3747 (fn
3748 (save-match-data (apply (cdr fn) args)))
3749 ;; Default file name handlers, we don't care.
3750 (t (tramp-run-real-handler operation args)))))))
3751
3752;;; Internal Functions:
3753
3754(defun tramp-maybe-send-script (vec script name)
3755 "Define in remote shell function NAME implemented as SCRIPT.
3756Only send the definition if it has not already been done."
3757 (let* ((p (tramp-get-connection-process vec))
3758 (scripts (tramp-get-connection-property p "scripts" nil)))
3759 (unless (member name scripts)
3760 (with-progress-reporter vec 5 (format "Sending script `%s'" name)
3761 ;; The script could contain a call of Perl. This is masked with `%s'.
3762 (tramp-barf-unless-okay
3763 vec
3764 (format "%s () {\n%s\n}" name
3765 (format script (tramp-get-remote-perl vec)))
3766 "Script %s sending failed" name)
3767 (tramp-set-connection-property p "scripts" (cons name scripts))))))
3768
3769(defun tramp-set-auto-save ()
3770 (when (and ;; ange-ftp has its own auto-save mechanism
3771 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
3772 'tramp-sh-file-name-handler)
3773 auto-save-default)
3774 (auto-save-mode 1)))
3775(add-hook 'find-file-hooks 'tramp-set-auto-save t)
3776(add-hook 'tramp-unload-hook
3777 (lambda ()
3778 (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
3779
3780(defun tramp-run-test (switch filename)
3781 "Run `test' on the remote system, given a SWITCH and a FILENAME.
3782Returns the exit code of the `test' program."
3783 (with-parsed-tramp-file-name filename nil
3784 (tramp-send-command-and-check
3785 v
3786 (format
3787 "%s %s %s"
3788 (tramp-get-test-command v)
3789 switch
3790 (tramp-shell-quote-argument localname)))))
3791
3792(defun tramp-run-test2 (format-string file1 file2)
3793 "Run `test'-like program on the remote system, given FILE1, FILE2.
3794FORMAT-STRING contains the program name, switches, and place holders.
3795Returns the exit code of the `test' program. Barfs if the methods,
3796hosts, or files, disagree."
3797 (unless (tramp-equal-remote file1 file2)
3798 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
3799 (tramp-error
3800 v 'file-error
3801 "tramp-run-test2 only implemented for same method, user, host")))
3802 (with-parsed-tramp-file-name file1 v1
3803 (with-parsed-tramp-file-name file1 v2
3804 (tramp-send-command-and-check
3805 v1
3806 (format format-string
3807 (tramp-shell-quote-argument v1-localname)
3808 (tramp-shell-quote-argument v2-localname))))))
3809
3810(defun tramp-find-executable
3811 (vec progname dirlist &optional ignore-tilde ignore-path)
3812 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
3813First arg VEC specifies the connection, PROGNAME is the program
3814to search for, and DIRLIST gives the list of directories to
3815search. If IGNORE-TILDE is non-nil, directory names starting
3816with `~' will be ignored. If IGNORE-PATH is non-nil, searches
3817only in DIRLIST.
3818
3819Returns the absolute file name of PROGNAME, if found, and nil otherwise.
3820
3821This function expects to be in the right *tramp* buffer."
3822 (with-current-buffer (tramp-get-connection-buffer vec)
3823 (let (result)
3824 ;; Check whether the executable is in $PATH. "which(1)" does not
3825 ;; report always a correct error code; therefore we check the
3826 ;; number of words it returns.
3827 (unless ignore-path
3828 (tramp-send-command vec (format "which \\%s | wc -w" progname))
3829 (goto-char (point-min))
3830 (if (looking-at "^\\s-*1$")
3831 (setq result (concat "\\" progname))))
3832 (unless result
3833 (when ignore-tilde
3834 ;; Remove all ~/foo directories from dirlist. In XEmacs,
3835 ;; `remove' is in CL, and we want to avoid CL dependencies.
3836 (let (newdl d)
3837 (while dirlist
3838 (setq d (car dirlist))
3839 (setq dirlist (cdr dirlist))
3840 (unless (char-equal ?~ (aref d 0))
3841 (setq newdl (cons d newdl))))
3842 (setq dirlist (nreverse newdl))))
3843 (tramp-send-command
3844 vec
3845 (format (concat "while read d; "
3846 "do if test -x $d/%s -a -f $d/%s; "
3847 "then echo tramp_executable $d/%s; "
3848 "break; fi; done <<'EOF'\n"
3849 "%s\nEOF")
3850 progname progname progname (mapconcat 'identity dirlist "\n")))
3851 (goto-char (point-max))
3852 (when (search-backward "tramp_executable " nil t)
3853 (skip-chars-forward "^ ")
3854 (skip-chars-forward " ")
3855 (setq result (buffer-substring
3856 (point) (tramp-compat-line-end-position)))))
3857 result)))
3858
3859(defun tramp-set-remote-path (vec)
3860 "Sets the remote environment PATH to existing directories.
3861I.e., for each directory in `tramp-remote-path', it is tested
3862whether it exists and if so, it is added to the environment
3863variable PATH."
3864 (tramp-message vec 5 (format "Setting $PATH environment variable"))
3865 (tramp-send-command
3866 vec (format "PATH=%s; export PATH"
3867 (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
3868
3869;; ------------------------------------------------------------
3870;; -- Communication with external shell --
3871;; ------------------------------------------------------------
3872
3873(defun tramp-find-file-exists-command (vec)
3874 "Find a command on the remote host for checking if a file exists.
3875Here, we are looking for a command which has zero exit status if the
3876file exists and nonzero exit status otherwise."
3877 (let ((existing "/")
3878 (nonexisting
3879 (tramp-shell-quote-argument "/ this file does not exist "))
3880 result)
3881 ;; The algorithm is as follows: we try a list of several commands.
3882 ;; For each command, we first run `$cmd /' -- this should return
3883 ;; true, as the root directory always exists. And then we run
3884 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
3885 ;; does not exist. This should return false. We use the first
3886 ;; command we find that seems to work.
3887 ;; The list of commands to try is as follows:
3888 ;; `ls -d' This works on most systems, but NetBSD 1.4
3889 ;; has a bug: `ls' always returns zero exit
3890 ;; status, even for files which don't exist.
3891 ;; `test -e' Some Bourne shells have a `test' builtin
3892 ;; which does not know the `-e' option.
3893 ;; `/bin/test -e' For those, the `test' binary on disk normally
3894 ;; provides the option. Alas, the binary
3895 ;; is sometimes `/bin/test' and sometimes it's
3896 ;; `/usr/bin/test'.
3897 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
3898 (unless (or
3899 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
3900 (tramp-send-command-and-check
3901 vec (format "%s %s" result existing))
3902 (not (tramp-send-command-and-check
3903 vec (format "%s %s" result nonexisting))))
3904 (and (setq result "/bin/test -e")
3905 (tramp-send-command-and-check
3906 vec (format "%s %s" result existing))
3907 (not (tramp-send-command-and-check
3908 vec (format "%s %s" result nonexisting))))
3909 (and (setq result "/usr/bin/test -e")
3910 (tramp-send-command-and-check
3911 vec (format "%s %s" result existing))
3912 (not (tramp-send-command-and-check
3913 vec (format "%s %s" result nonexisting))))
3914 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
3915 (tramp-send-command-and-check
3916 vec (format "%s %s" result existing))
3917 (not (tramp-send-command-and-check
3918 vec (format "%s %s" result nonexisting)))))
3919 (tramp-error
3920 vec 'file-error "Couldn't find command to check if file exists"))
3921 result))
3922
3923(defun tramp-open-shell (vec shell)
3924 "Opens shell SHELL."
3925 (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
3926 ;; Find arguments for this shell.
3927 (let ((tramp-end-of-output tramp-initial-end-of-output)
3928 (alist tramp-sh-extra-args)
3929 item extra-args)
3930 (while (and alist (null extra-args))
3931 (setq item (pop alist))
3932 (when (string-match (car item) shell)
3933 (setq extra-args (cdr item))))
3934 (when extra-args (setq shell (concat shell " " extra-args)))
3935 (tramp-send-command
3936 vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
3937 (shell-quote-argument tramp-end-of-output) shell)
3938 t))
3939 ;; Setting prompts.
3940 (tramp-send-command
3941 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
3942 (tramp-send-command vec "PS2=''" t)
3943 (tramp-send-command vec "PS3=''" t)
3944 (tramp-send-command vec "PROMPT_COMMAND=''" t)))
3945
3946(defun tramp-find-shell (vec)
3947 "Opens a shell on the remote host which groks tilde expansion."
3948 (unless (tramp-get-connection-property vec "remote-shell" nil)
3949 (let (shell)
3950 (with-current-buffer (tramp-get-buffer vec)
3951 (tramp-send-command vec "echo ~root" t)
3952 (cond
3953 ((or (string-match "^~root$" (buffer-string))
3954 ;; The default shell (ksh93) of OpenSolaris is buggy.
3955 (string-equal (tramp-get-connection-property vec "uname" "")
3956 "SunOS 5.11"))
3957 (setq shell
3958 (or (tramp-find-executable
3959 vec "bash" (tramp-get-remote-path vec) t t)
3960 (tramp-find-executable
3961 vec "ksh" (tramp-get-remote-path vec) t t)))
3962 (unless shell
3963 (tramp-error
3964 vec 'file-error
3965 "Couldn't find a shell which groks tilde expansion"))
3966 (tramp-message
3967 vec 5 "Starting remote shell `%s' for tilde expansion" shell)
3968 (tramp-open-shell vec shell))
3969
3970 (t (tramp-message
3971 vec 5 "Remote `%s' groks tilde expansion, good"
3972 (tramp-set-connection-property
3973 vec "remote-shell"
3974 (tramp-get-method-parameter
3975 (tramp-file-name-method vec) 'tramp-remote-sh)))))))))
3976
3977;; Utility functions.
3978
3979(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
3980 "Wait for shell prompt and barf if none appears.
3981Looks at process PROC to see if a shell prompt appears in TIMEOUT
3982seconds. If not, it produces an error message with the given ERROR-ARGS."
3983 (unless
3984 (tramp-wait-for-regexp
3985 proc timeout
3986 (format
3987 "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
3988 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
3989
3990(defun tramp-open-connection-setup-interactive-shell (proc vec)
3991 "Set up an interactive shell.
3992Mainly sets the prompt and the echo correctly. PROC is the shell
3993process to set up. VEC specifies the connection."
3994 (let ((tramp-end-of-output tramp-initial-end-of-output))
3995 ;; It is useful to set the prompt in the following command because
3996 ;; some people have a setting for $PS1 which /bin/sh doesn't know
3997 ;; about and thus /bin/sh will display a strange prompt. For
3998 ;; example, if $PS1 has "${CWD}" in the value, then ksh will
3999 ;; display the current working directory but /bin/sh will display
4000 ;; a dollar sign. The following command line sets $PS1 to a sane
4001 ;; value, and works under Bourne-ish shells as well as csh-like
4002 ;; shells. Daniel Pittman reports that the unusual positioning of
4003 ;; the single quotes makes it work under `rc', too. We also unset
4004 ;; the variable $ENV because that is read by some sh
4005 ;; implementations (eg, bash when called as sh) on startup; this
4006 ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
4007 ;; is another way to set the prompt in /bin/bash, it must be
4008 ;; discarded as well.
4009 (tramp-open-shell
4010 vec
4011 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh))
4012
4013 ;; Disable echo.
4014 (tramp-message vec 5 "Setting up remote shell environment")
4015 (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
4016 ;; Check whether the echo has really been disabled. Some
4017 ;; implementations, like busybox of embedded GNU/Linux, don't
4018 ;; support disabling.
4019 (tramp-send-command vec "echo foo" t)
4020 (with-current-buffer (process-buffer proc)
4021 (goto-char (point-min))
4022 (when (looking-at "echo foo")
4023 (tramp-set-connection-property proc "remote-echo" t)
4024 (tramp-message vec 5 "Remote echo still on. Ok.")
4025 ;; Make sure backspaces and their echo are enabled and no line
4026 ;; width magic interferes with them.
4027 (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
4028
4029 (tramp-message vec 5 "Setting shell prompt")
4030 (tramp-send-command
4031 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
4032 (tramp-send-command vec "PS2=''" t)
4033 (tramp-send-command vec "PS3=''" t)
4034 (tramp-send-command vec "PROMPT_COMMAND=''" t)
4035
4036 ;; Try to set up the coding system correctly.
4037 ;; CCC this can't be the right way to do it. Hm.
4038 (tramp-message vec 5 "Determining coding system")
4039 (tramp-send-command vec "echo foo ; echo bar" t)
4040 (with-current-buffer (process-buffer proc)
4041 (goto-char (point-min))
4042 (if (featurep 'mule)
4043 ;; Use MULE to select the right EOL convention for communicating
4044 ;; with the process.
4045 (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
4046 (cons 'undecided 'undecided)))
4047 cs-decode cs-encode)
4048 (when (symbolp cs) (setq cs (cons cs cs)))
4049 (setq cs-decode (car cs))
4050 (setq cs-encode (cdr cs))
4051 (unless cs-decode (setq cs-decode 'undecided))
4052 (unless cs-encode (setq cs-encode 'undecided))
4053 (setq cs-encode (tramp-coding-system-change-eol-conversion
4054 cs-encode 'unix))
4055 (when (search-forward "\r" nil t)
4056 (setq cs-decode (tramp-coding-system-change-eol-conversion
4057 cs-decode 'dos)))
4058 (tramp-compat-funcall
4059 'set-buffer-process-coding-system cs-decode cs-encode)
4060 (tramp-message
4061 vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
4062 ;; Look for ^M and do something useful if found.
4063 (when (search-forward "\r" nil t)
4064 ;; We have found a ^M but cannot frob the process coding system
4065 ;; because we're running on a non-MULE Emacs. Let's try
4066 ;; stty, instead.
4067 (tramp-send-command vec "stty -onlcr" t))))
4068 ;; Dump stty settings in the traces.
4069 (when (>= tramp-verbose 9)
4070 (tramp-send-command vec "stty -a" t))
4071 (tramp-send-command vec "set +o vi +o emacs" t)
4072
4073 ;; Check whether the output of "uname -sr" has been changed. If
4074 ;; yes, this is a strong indication that we must expire all
4075 ;; connection properties. We start again with
4076 ;; `tramp-maybe-open-connection', it will be catched there.
4077 (tramp-message vec 5 "Checking system information")
4078 (let ((old-uname (tramp-get-connection-property vec "uname" nil))
4079 (new-uname
4080 (tramp-set-connection-property
4081 vec "uname"
4082 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
4083 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
4084 (with-current-buffer (tramp-get-debug-buffer vec)
4085 ;; Keep the debug buffer.
4086 (rename-buffer
4087 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
4088 (tramp-compat-funcall 'tramp-cleanup-connection vec)
4089 (if (= (point-min) (point-max))
4090 (kill-buffer nil)
4091 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
4092 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
4093 (tramp-get-buffer vec)
4094 (tramp-message
4095 vec 3
4096 "Connection reset, because remote host changed from `%s' to `%s'"
4097 old-uname new-uname)
4098 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
4099
4100 ;; Check whether the remote host suffers from buggy
4101 ;; `send-process-string'. This is known for FreeBSD (see comment in
4102 ;; `send_process', file process.c). I've tested sending 624 bytes
4103 ;; successfully, sending 625 bytes failed. Emacs makes a hack when
4104 ;; this host type is detected locally. It cannot handle remote
4105 ;; hosts, though.
4106 (with-connection-property proc "chunksize"
4107 (cond
4108 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
4109 tramp-chunksize)
4110 (t
4111 (tramp-message
4112 vec 5 "Checking remote host type for `send-process-string' bug")
4113 (if (string-match
4114 "^FreeBSD" (tramp-get-connection-property vec "uname" ""))
4115 500 0))))
4116
4117 ;; Set remote PATH variable.
4118 (tramp-set-remote-path vec)
4119
4120 ;; Search for a good shell before searching for a command which
4121 ;; checks if a file exists. This is done because Tramp wants to use
4122 ;; "test foo; echo $?" to check if various conditions hold, and
4123 ;; there are buggy /bin/sh implementations which don't execute the
4124 ;; "echo $?" part if the "test" part has an error. In particular,
4125 ;; the OpenSolaris /bin/sh is a problem. There are also other
4126 ;; problems with /bin/sh of OpenSolaris, like redirection of stderr
4127 ;; in function declarations, or changing HISTFILE in place.
4128 ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when
4129 ;; detected.
4130 (tramp-find-shell vec)
4131
4132 ;; Disable unexpected output.
4133 (tramp-send-command vec "mesg n; biff n" t)
4134
4135 ;; IRIX64 bash expands "!" even when in single quotes. This
4136 ;; destroys our shell functions, we must disable it. See
4137 ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
4138 (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" ""))
4139 (tramp-send-command vec "set +H" t))
4140
4141 ;; Set `remote-tty' process property.
4142 (ignore-errors
4143 (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
4144 (unless (zerop (length tty))
4145 (tramp-compat-process-put proc 'remote-tty tty))))
4146
4147 ;; Set the environment.
4148 (tramp-message vec 5 "Setting default environment")
4149
4150 (let ((env (copy-sequence tramp-remote-process-environment))
4151 unset item)
4152 (while env
4153 (setq item (tramp-compat-split-string (car env) "="))
4154 (setcdr item (mapconcat 'identity (cdr item) "="))
4155 (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
4156 (tramp-send-command
4157 vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t)
4158 (push (car item) unset))
4159 (setq env (cdr env)))
4160 (when unset
4161 (tramp-send-command
4162 vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
4163
4164;; CCC: We should either implement a Perl version of base64 encoding
4165;; and decoding. Then we just use that in the last item. The other
4166;; alternative is to use the Perl version of UU encoding. But then
4167;; we need a Lisp version of uuencode.
4168;;
4169;; Old text from documentation of tramp-methods:
4170;; Using a uuencode/uudecode inline method is discouraged, please use one
4171;; of the base64 methods instead since base64 encoding is much more
4172;; reliable and the commands are more standardized between the different
4173;; Unix versions. But if you can't use base64 for some reason, please
4174;; note that the default uudecode command does not work well for some
4175;; Unices, in particular AIX and Irix. For AIX, you might want to use
4176;; the following command for uudecode:
4177;;
4178;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
4179;;
4180;; For Irix, no solution is known yet.
4181
4182(autoload 'uudecode-decode-region "uudecode")
4183
4184(defconst tramp-local-coding-commands
4185 '((b64 base64-encode-region base64-decode-region)
4186 (uu tramp-uuencode-region uudecode-decode-region)
4187 (pack
4188 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
4189 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
4190 "List of local coding commands for inline transfer.
4191Each item is a list that looks like this:
4192
4193\(FORMAT ENCODING DECODING\)
4194
4195FORMAT is symbol describing the encoding/decoding format. It can be
4196`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
4197
4198ENCODING and DECODING can be strings, giving commands, or symbols,
4199giving functions. If they are strings, then they can contain
4200the \"%s\" format specifier. If that specifier is present, the input
4201filename will be put into the command line at that spot. If the
4202specifier is not present, the input should be read from standard
4203input.
4204
4205If they are functions, they will be called with two arguments, start
4206and end of region, and are expected to replace the region contents
4207with the encoded or decoded results, respectively.")
4208
4209(defconst tramp-remote-coding-commands
4210 '((b64 "base64" "base64 -d")
4211 (b64 "mimencode -b" "mimencode -u -b")
4212 (b64 "mmencode -b" "mmencode -u -b")
4213 (b64 "recode data..base64" "recode base64..data")
4214 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
4215 (b64 tramp-perl-encode tramp-perl-decode)
4216 (uu "uuencode xxx" "uudecode -o /dev/stdout")
4217 (uu "uuencode xxx" "uudecode -o -")
4218 (uu "uuencode xxx" "uudecode -p")
4219 (uu "uuencode xxx" tramp-uudecode)
4220 (pack
4221 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
4222 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
4223 "List of remote coding commands for inline transfer.
4224Each item is a list that looks like this:
4225
4226\(FORMAT ENCODING DECODING\)
4227
4228FORMAT is symbol describing the encoding/decoding format. It can be
4229`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
4230
4231ENCODING and DECODING can be strings, giving commands, or symbols,
4232giving variables. If they are strings, then they can contain
4233the \"%s\" format specifier. If that specifier is present, the input
4234filename will be put into the command line at that spot. If the
4235specifier is not present, the input should be read from standard
4236input.
4237
4238If they are variables, this variable is a string containing a Perl
4239implementation for this functionality. This Perl program will be transferred
4240to the remote host, and it is available as shell function with the same name.")
4241
4242(defun tramp-find-inline-encoding (vec)
4243 "Find an inline transfer encoding that works.
4244Goes through the list `tramp-local-coding-commands' and
4245`tramp-remote-coding-commands'."
4246 (save-excursion
4247 (let ((local-commands tramp-local-coding-commands)
4248 (magic "xyzzy")
4249 loc-enc loc-dec rem-enc rem-dec litem ritem found)
4250 (while (and local-commands (not found))
4251 (setq litem (pop local-commands))
4252 (catch 'wont-work-local
4253 (let ((format (nth 0 litem))
4254 (remote-commands tramp-remote-coding-commands))
4255 (setq loc-enc (nth 1 litem))
4256 (setq loc-dec (nth 2 litem))
4257 ;; If the local encoder or decoder is a string, the
4258 ;; corresponding command has to work locally.
4259 (if (not (stringp loc-enc))
4260 (tramp-message
4261 vec 5 "Checking local encoding function `%s'" loc-enc)
4262 (tramp-message
4263 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
4264 (unless (zerop (tramp-call-local-coding-command
4265 loc-enc nil nil))
4266 (throw 'wont-work-local nil)))
4267 (if (not (stringp loc-dec))
4268 (tramp-message
4269 vec 5 "Checking local decoding function `%s'" loc-dec)
4270 (tramp-message
4271 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
4272 (unless (zerop (tramp-call-local-coding-command
4273 loc-dec nil nil))
4274 (throw 'wont-work-local nil)))
4275 ;; Search for remote coding commands with the same format
4276 (while (and remote-commands (not found))
4277 (setq ritem (pop remote-commands))
4278 (catch 'wont-work-remote
4279 (when (equal format (nth 0 ritem))
4280 (setq rem-enc (nth 1 ritem))
4281 (setq rem-dec (nth 2 ritem))
4282 ;; Check if remote encoding and decoding commands can be
4283 ;; called remotely with null input and output. This makes
4284 ;; sure there are no syntax errors and the command is really
4285 ;; found. Note that we do not redirect stdout to /dev/null,
4286 ;; for two reasons: when checking the decoding command, we
4287 ;; actually check the output it gives. And also, when
4288 ;; redirecting "mimencode" output to /dev/null, then as root
4289 ;; it might change the permissions of /dev/null!
4290 (when (not (stringp rem-enc))
4291 (let ((name (symbol-name rem-enc)))
4292 (while (string-match (regexp-quote "-") name)
4293 (setq name (replace-match "_" nil t name)))
4294 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
4295 (setq rem-enc name)))
4296 (tramp-message
4297 vec 5
4298 "Checking remote encoding command `%s' for sanity" rem-enc)
4299 (unless (tramp-send-command-and-check
4300 vec (format "%s </dev/null" rem-enc) t)
4301 (throw 'wont-work-remote nil))
4302
4303 (when (not (stringp rem-dec))
4304 (let ((name (symbol-name rem-dec)))
4305 (while (string-match (regexp-quote "-") name)
4306 (setq name (replace-match "_" nil t name)))
4307 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
4308 (setq rem-dec name)))
4309 (tramp-message
4310 vec 5
4311 "Checking remote decoding command `%s' for sanity" rem-dec)
4312 (unless (tramp-send-command-and-check
4313 vec
4314 (format "echo %s | %s | %s" magic rem-enc rem-dec)
4315 t)
4316 (throw 'wont-work-remote nil))
4317
4318 (with-current-buffer (tramp-get-buffer vec)
4319 (goto-char (point-min))
4320 (unless (looking-at (regexp-quote magic))
4321 (throw 'wont-work-remote nil)))
4322
4323 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
4324 (setq rem-enc (nth 1 ritem))
4325 (setq rem-dec (nth 2 ritem))
4326 (setq found t)))))))
4327
4328 ;; Did we find something?
4329 (unless found
4330 (tramp-error
4331 vec 'file-error "Couldn't find an inline transfer encoding"))
4332
4333 ;; Set connection properties.
4334 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
4335 (tramp-set-connection-property vec "local-encoding" loc-enc)
4336 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
4337 (tramp-set-connection-property vec "local-decoding" loc-dec)
4338 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
4339 (tramp-set-connection-property vec "remote-encoding" rem-enc)
4340 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
4341 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
4342
4343(defun tramp-call-local-coding-command (cmd input output)
4344 "Call the local encoding or decoding command.
4345If CMD contains \"%s\", provide input file INPUT there in command.
4346Otherwise, INPUT is passed via standard input.
4347INPUT can also be nil which means `/dev/null'.
4348OUTPUT can be a string (which specifies a filename), or t (which
4349means standard output and thus the current buffer), or nil (which
4350means discard it)."
4351 (tramp-compat-call-process
4352 tramp-encoding-shell
4353 (when (and input (not (string-match "%s" cmd))) input)
4354 (if (eq output t) t nil)
4355 nil
4356 tramp-encoding-command-switch
4357 (concat
4358 (if (string-match "%s" cmd) (format cmd input) cmd)
4359 (if (stringp output) (concat "> " output) ""))))
4360
4361(defconst tramp-inline-compress-commands
4362 '(("gzip" "gzip -d")
4363 ("bzip2" "bzip2 -d")
4364 ("compress" "compress -d"))
4365 "List of compress and decompress commands for inline transfer.
4366Each item is a list that looks like this:
4367
4368\(COMPRESS DECOMPRESS\)
4369
4370COMPRESS or DECOMPRESS are strings with the respective commands.")
4371
4372(defun tramp-find-inline-compress (vec)
4373 "Find an inline transfer compress command that works.
4374Goes through the list `tramp-inline-compress-commands'."
4375 (save-excursion
4376 (let ((commands tramp-inline-compress-commands)
4377 (magic "xyzzy")
4378 item compress decompress
4379 found)
4380 (while (and commands (not found))
4381 (catch 'next
4382 (setq item (pop commands)
4383 compress (nth 0 item)
4384 decompress (nth 1 item))
4385 (tramp-message
4386 vec 5
4387 "Checking local compress command `%s', `%s' for sanity"
4388 compress decompress)
4389 (unless (zerop (tramp-call-local-coding-command
4390 (format "echo %s | %s | %s"
4391 magic compress decompress) nil nil))
4392 (throw 'next nil))
4393 (tramp-message
4394 vec 5
4395 "Checking remote compress command `%s', `%s' for sanity"
4396 compress decompress)
4397 (unless (tramp-send-command-and-check
4398 vec (format "echo %s | %s | %s" magic compress decompress) t)
4399 (throw 'next nil))
4400 (setq found t)))
4401
4402 ;; Did we find something?
4403 (if found
4404 (progn
4405 ;; Set connection properties.
4406 (tramp-message
4407 vec 5 "Using inline transfer compress command `%s'" compress)
4408 (tramp-set-connection-property vec "inline-compress" compress)
4409 (tramp-message
4410 vec 5 "Using inline transfer decompress command `%s'" decompress)
4411 (tramp-set-connection-property vec "inline-decompress" decompress))
4412
4413 (tramp-set-connection-property vec "inline-compress" nil)
4414 (tramp-set-connection-property vec "inline-decompress" nil)
4415 (tramp-message
4416 vec 2 "Couldn't find an inline transfer compress command")))))
4417
4418(defun tramp-compute-multi-hops (vec)
4419 "Expands VEC according to `tramp-default-proxies-alist'.
4420Gateway hops are already opened."
4421 (let ((target-alist `(,vec))
4422 (choices tramp-default-proxies-alist)
4423 item proxy)
4424
4425 ;; Look for proxy hosts to be passed.
4426 (while choices
4427 (setq item (pop choices)
4428 proxy (eval (nth 2 item)))
4429 (when (and
4430 ;; host
4431 (string-match (or (eval (nth 0 item)) "")
4432 (or (tramp-file-name-host (car target-alist)) ""))
4433 ;; user
4434 (string-match (or (eval (nth 1 item)) "")
4435 (or (tramp-file-name-user (car target-alist)) "")))
4436 (if (null proxy)
4437 ;; No more hops needed.
4438 (setq choices nil)
4439 ;; Replace placeholders.
4440 (setq proxy
4441 (format-spec
4442 proxy
4443 (format-spec-make
4444 ?u (or (tramp-file-name-user (car target-alist)) "")
4445 ?h (or (tramp-file-name-host (car target-alist)) ""))))
4446 (with-parsed-tramp-file-name proxy l
4447 ;; Add the hop.
4448 (add-to-list 'target-alist l)
4449 ;; Start next search.
4450 (setq choices tramp-default-proxies-alist)))))
4451
4452 ;; Handle gateways.
4453 (when (string-match
4454 (format
4455 "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
4456 (tramp-file-name-method (car target-alist)))
4457 (let ((gw (pop target-alist))
4458 (hop (pop target-alist)))
4459 ;; Is the method prepared for gateways?
4460 (unless (tramp-get-method-parameter
4461 (tramp-file-name-method hop) 'tramp-default-port)
4462 (tramp-error
4463 vec 'file-error
4464 "Method `%s' is not supported for gateway access."
4465 (tramp-file-name-method hop)))
4466 ;; Add default port if needed.
4467 (unless
4468 (string-match
4469 tramp-host-with-port-regexp (tramp-file-name-host hop))
4470 (aset hop 2
4471 (concat
4472 (tramp-file-name-host hop) tramp-prefix-port-format
4473 (number-to-string
4474 (tramp-get-method-parameter
4475 (tramp-file-name-method hop) 'tramp-default-port)))))
4476 ;; Open the gateway connection.
4477 (add-to-list
4478 'target-alist
4479 (vector
4480 (tramp-file-name-method hop) (tramp-file-name-user hop)
4481 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
4482 ;; For the password prompt, we need the correct values.
4483 ;; Therefore, we must remember the gateway vector. But we
4484 ;; cannot do it as connection property, because it shouldn't
4485 ;; be persistent. And we have no started process yet either.
4486 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
4487
4488 ;; Foreign and out-of-band methods are not supported for multi-hops.
4489 (when (cdr target-alist)
4490 (setq choices target-alist)
4491 (while choices
4492 (setq item (pop choices))
4493 (when
4494 (or
4495 (not
4496 (tramp-get-method-parameter
4497 (tramp-file-name-method item) 'tramp-login-program))
4498 (tramp-get-method-parameter
4499 (tramp-file-name-method item) 'tramp-copy-program))
4500 (tramp-error
4501 vec 'file-error
4502 "Method `%s' is not supported for multi-hops."
4503 (tramp-file-name-method item)))))
4504
4505 ;; In case the host name is not used for the remote shell
4506 ;; command, the user could be misguided by applying a random
4507 ;; hostname.
4508 (let* ((v (car target-alist))
4509 (method (tramp-file-name-method v))
4510 (host (tramp-file-name-host v)))
4511 (unless
4512 (or
4513 ;; There are multi-hops.
4514 (cdr target-alist)
4515 ;; The host name is used for the remote shell command.
4516 (member
4517 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
4518 ;; The host is local. We cannot use `tramp-local-host-p'
4519 ;; here, because it opens a connection as well.
4520 (string-match tramp-local-host-regexp host))
4521 (tramp-error
4522 v 'file-error
4523 "Host `%s' looks like a remote host, `%s' can only use the local host"
4524 host method)))
4525
4526 ;; Result.
4527 target-alist))
4528
4529(defun tramp-maybe-open-connection (vec)
4530 "Maybe open a connection VEC.
4531Does not do anything if a connection is already open, but re-opens the
4532connection if a previous connection has died for some reason."
4533 (catch 'uname-changed
4534 (let ((p (tramp-get-connection-process vec))
4535 (process-name (tramp-get-connection-property vec "process-name" nil))
4536 (process-environment (copy-sequence process-environment)))
4537
4538 ;; If too much time has passed since last command was sent, look
4539 ;; whether process is still alive. If it isn't, kill it. When
4540 ;; using ssh, it can sometimes happen that the remote end has
4541 ;; hung up but the local ssh client doesn't recognize this until
4542 ;; it tries to send some data to the remote end. So that's why
4543 ;; we try to send a command from time to time, then look again
4544 ;; whether the process is really alive.
4545 (condition-case nil
4546 (when (and (> (tramp-time-diff
4547 (current-time)
4548 (tramp-get-connection-property
4549 p "last-cmd-time" '(0 0 0)))
4550 60)
4551 p (processp p) (memq (process-status p) '(run open)))
4552 (tramp-send-command vec "echo are you awake" t t)
4553 (unless (and (memq (process-status p) '(run open))
4554 (tramp-wait-for-output p 10))
4555 ;; The error will be catched locally.
4556 (tramp-error vec 'file-error "Awake did fail")))
4557 (file-error
4558 (tramp-flush-connection-property vec)
4559 (tramp-flush-connection-property p)
4560 (delete-process p)
4561 (setq p nil)))
4562
4563 ;; New connection must be opened.
4564 (unless (and p (processp p) (memq (process-status p) '(run open)))
4565
4566 ;; We call `tramp-get-buffer' in order to get a debug buffer for
4567 ;; messages from the beginning.
4568 (tramp-get-buffer vec)
4569 (with-progress-reporter
4570 vec 3
4571 (if (zerop (length (tramp-file-name-user vec)))
4572 (format "Opening connection for %s using %s"
4573 (tramp-file-name-host vec)
4574 (tramp-file-name-method vec))
4575 (format "Opening connection for %s@%s using %s"
4576 (tramp-file-name-user vec)
4577 (tramp-file-name-host vec)
4578 (tramp-file-name-method vec)))
4579
4580 ;; Start new process.
4581 (when (and p (processp p))
4582 (delete-process p))
4583 (setenv "TERM" tramp-terminal-type)
4584 (setenv "LC_ALL" "C")
4585 (setenv "PROMPT_COMMAND")
4586 (setenv "PS1" tramp-initial-end-of-output)
4587 (let* ((target-alist (tramp-compute-multi-hops vec))
4588 (process-connection-type tramp-process-connection-type)
4589 (process-adaptive-read-buffering nil)
4590 (coding-system-for-read nil)
4591 ;; This must be done in order to avoid our file name handler.
4592 (p (let ((default-directory
4593 (tramp-compat-temporary-file-directory)))
4594 (start-process
4595 (or process-name (tramp-buffer-name vec))
4596 (tramp-get-connection-buffer vec)
4597 tramp-encoding-shell))))
4598
4599 (tramp-message
4600 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
4601
4602 ;; Check whether process is alive.
4603 (tramp-set-process-query-on-exit-flag p nil)
4604 (tramp-barf-if-no-shell-prompt
4605 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
4606
4607 ;; Now do all the connections as specified.
4608 (while target-alist
4609 (let* ((hop (car target-alist))
4610 (l-method (tramp-file-name-method hop))
4611 (l-user (tramp-file-name-user hop))
4612 (l-host (tramp-file-name-host hop))
4613 (l-port nil)
4614 (login-program
4615 (tramp-get-method-parameter
4616 l-method 'tramp-login-program))
4617 (login-args
4618 (tramp-get-method-parameter l-method 'tramp-login-args))
4619 (async-args
4620 (tramp-get-method-parameter l-method 'tramp-async-args))
4621 (gw-args
4622 (tramp-get-method-parameter l-method 'tramp-gw-args))
4623 (gw (tramp-get-file-property hop "" "gateway" nil))
4624 (g-method (and gw (tramp-file-name-method gw)))
4625 (g-user (and gw (tramp-file-name-user gw)))
4626 (g-host (and gw (tramp-file-name-host gw)))
4627 (command login-program)
4628 ;; We don't create the temporary file. In fact,
4629 ;; it is just a prefix for the ControlPath option
4630 ;; of ssh; the real temporary file has another
4631 ;; name, and it is created and protected by ssh.
4632 ;; It is also removed by ssh, when the connection
4633 ;; is closed.
4634 (tmpfile
4635 (tramp-set-connection-property
4636 p "temp-file"
4637 (make-temp-name
4638 (expand-file-name
4639 tramp-temp-name-prefix
4640 (tramp-compat-temporary-file-directory)))))
4641 spec)
4642
4643 ;; Add arguments for asynchrononous processes.
4644 (when (and process-name async-args)
4645 (setq login-args (append async-args login-args)))
4646
4647 ;; Add gateway arguments if necessary.
4648 (when (and gw gw-args)
4649 (setq login-args (append gw-args login-args)))
4650
4651 ;; Check for port number. Until now, there's no need
4652 ;; for handling like method, user, host.
4653 (when (string-match tramp-host-with-port-regexp l-host)
4654 (setq l-port (match-string 2 l-host)
4655 l-host (match-string 1 l-host)))
4656
4657 ;; Set variables for computing the prompt for reading
4658 ;; password. They can also be derived from a gateway.
4659 (setq tramp-current-method (or g-method l-method)
4660 tramp-current-user (or g-user l-user)
4661 tramp-current-host (or g-host l-host))
4662
4663 ;; Replace login-args place holders.
4664 (setq
4665 l-host (or l-host "")
4666 l-user (or l-user "")
4667 l-port (or l-port "")
4668 spec (format-spec-make
4669 ?h l-host ?u l-user ?p l-port ?t tmpfile)
4670 command
4671 (concat
4672 ;; We do not want to see the trailing local prompt in
4673 ;; `start-file-process'.
4674 (unless (memq system-type '(windows-nt)) "exec ")
4675 command " "
4676 (mapconcat
4677 (lambda (x)
4678 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
4679 (unless (member "" x) (mapconcat 'identity x " ")))
4680 login-args " ")
4681 ;; Local shell could be a Windows COMSPEC. It
4682 ;; doesn't know the ";" syntax, but we must exit
4683 ;; always for `start-file-process'. "exec" does not
4684 ;; work either.
4685 (if (memq system-type '(windows-nt)) " && exit || exit")))
4686
4687 ;; Send the command.
4688 (tramp-message vec 3 "Sending command `%s'" command)
4689 (tramp-send-command vec command t t)
4690 (tramp-process-actions p vec tramp-actions-before-shell 60)
4691 (tramp-message
4692 vec 3 "Found remote shell prompt on `%s'" l-host))
4693 ;; Next hop.
4694 (setq target-alist (cdr target-alist)))
4695
4696 ;; Make initial shell settings.
4697 (tramp-open-connection-setup-interactive-shell p vec)))))))
4698
4699(defun tramp-send-command (vec command &optional neveropen nooutput)
4700 "Send the COMMAND to connection VEC.
4701Erases temporary buffer before sending the command. If optional
4702arg NEVEROPEN is non-nil, never try to open the connection. This
4703is meant to be used from `tramp-maybe-open-connection' only. The
4704function waits for output unless NOOUTPUT is set."
4705 (unless neveropen (tramp-maybe-open-connection vec))
4706 (let ((p (tramp-get-connection-process vec)))
4707 (when (tramp-get-connection-property p "remote-echo" nil)
4708 ;; We mark the command string that it can be erased in the output buffer.
4709 (tramp-set-connection-property p "check-remote-echo" t)
4710 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
4711 (tramp-message vec 6 "%s" command)
4712 (tramp-send-string vec command)
4713 (unless nooutput (tramp-wait-for-output p))))
4714
4715(defun tramp-wait-for-output (proc &optional timeout)
4716 "Wait for output from remote command."
4717 (unless (buffer-live-p (process-buffer proc))
4718 (delete-process proc)
4719 (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
4720 (with-current-buffer (process-buffer proc)
4721 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
4722 ;; be leading escape sequences, which must be ignored.
4723 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
4724 ;; Sometimes, the commands do not return a newline but a
4725 ;; null byte before the shell prompt, for example "git
4726 ;; ls-files -c -z ...".
4727 (regexp1 (format "\\(^\\|\000\\)%s" regexp))
4728 (found (tramp-wait-for-regexp proc timeout regexp1)))
4729 (if found
4730 (let (buffer-read-only)
4731 ;; A simple-minded busybox has sent " ^H" sequences.
4732 ;; Delete them.
4733 (goto-char (point-min))
4734 (when (re-search-forward
4735 "^\\(.\b\\)+$" (tramp-compat-line-end-position) t)
4736 (forward-line 1)
4737 (delete-region (point-min) (point)))
4738 ;; Delete the prompt.
4739 (goto-char (point-max))
4740 (re-search-backward regexp nil t)
4741 (delete-region (point) (point-max)))
4742 (if timeout
4743 (tramp-error
4744 proc 'file-error
4745 "[[Remote prompt `%s' not found in %d secs]]"
4746 tramp-end-of-output timeout)
4747 (tramp-error
4748 proc 'file-error
4749 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
4750 ;; Return value is whether end-of-output sentinel was found.
4751 found)))
4752
4753(defun tramp-send-command-and-check
4754 (vec command &optional subshell dont-suppress-err)
4755 "Run COMMAND and check its exit status.
4756Sends `echo $?' along with the COMMAND for checking the exit status. If
4757COMMAND is nil, just sends `echo $?'. Returns the exit status found.
4758
4759If the optional argument SUBSHELL is non-nil, the command is
4760executed in a subshell, ie surrounded by parentheses. If
4761DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
4762 (tramp-send-command
4763 vec
4764 (concat (if subshell "( " "")
4765 command
4766 (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
4767 "echo tramp_exit_status $?"
4768 (if subshell " )" "")))
4769 (with-current-buffer (tramp-get-connection-buffer vec)
4770 (goto-char (point-max))
4771 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
4772 (tramp-error
4773 vec 'file-error "Couldn't find exit status of `%s'" command))
4774 (skip-chars-forward "^ ")
4775 (prog1
4776 (zerop (read (current-buffer)))
4777 (let (buffer-read-only)
4778 (delete-region (match-beginning 0) (point-max))))))
4779
4780(defun tramp-barf-unless-okay (vec command fmt &rest args)
4781 "Run COMMAND, check exit status, throw error if exit status not okay.
4782Similar to `tramp-send-command-and-check' but accepts two more arguments
4783FMT and ARGS which are passed to `error'."
4784 (unless (tramp-send-command-and-check vec command)
4785 (apply 'tramp-error vec 'file-error fmt args)))
4786
4787(defun tramp-send-command-and-read (vec command)
4788 "Run COMMAND and return the output, which must be a Lisp expression.
4789In case there is no valid Lisp expression, it raises an error"
4790 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
4791 (with-current-buffer (tramp-get-connection-buffer vec)
4792 ;; Read the expression.
4793 (goto-char (point-min))
4794 (condition-case nil
4795 (prog1 (read (current-buffer))
4796 ;; Error handling.
4797 (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t)
4798 (error nil)))
4799 (error (tramp-error
4800 vec 'file-error
4801 "`%s' does not return a valid Lisp expression: `%s'"
4802 command (buffer-string))))))
4803
4804(defun tramp-mode-string-to-int (mode-string)
4805 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
4806 (let* (case-fold-search
4807 (mode-chars (string-to-vector mode-string))
4808 (owner-read (aref mode-chars 1))
4809 (owner-write (aref mode-chars 2))
4810 (owner-execute-or-setid (aref mode-chars 3))
4811 (group-read (aref mode-chars 4))
4812 (group-write (aref mode-chars 5))
4813 (group-execute-or-setid (aref mode-chars 6))
4814 (other-read (aref mode-chars 7))
4815 (other-write (aref mode-chars 8))
4816 (other-execute-or-sticky (aref mode-chars 9)))
4817 (save-match-data
4818 (logior
4819 (cond
4820 ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400"))
4821 ((char-equal owner-read ?-) 0)
4822 (t (error "Second char `%c' must be one of `r-'" owner-read)))
4823 (cond
4824 ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200"))
4825 ((char-equal owner-write ?-) 0)
4826 (t (error "Third char `%c' must be one of `w-'" owner-write)))
4827 (cond
4828 ((char-equal owner-execute-or-setid ?x)
4829 (tramp-compat-octal-to-decimal "00100"))
4830 ((char-equal owner-execute-or-setid ?S)
4831 (tramp-compat-octal-to-decimal "04000"))
4832 ((char-equal owner-execute-or-setid ?s)
4833 (tramp-compat-octal-to-decimal "04100"))
4834 ((char-equal owner-execute-or-setid ?-) 0)
4835 (t (error "Fourth char `%c' must be one of `xsS-'"
4836 owner-execute-or-setid)))
4837 (cond
4838 ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040"))
4839 ((char-equal group-read ?-) 0)
4840 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
4841 (cond
4842 ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020"))
4843 ((char-equal group-write ?-) 0)
4844 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
4845 (cond
4846 ((char-equal group-execute-or-setid ?x)
4847 (tramp-compat-octal-to-decimal "00010"))
4848 ((char-equal group-execute-or-setid ?S)
4849 (tramp-compat-octal-to-decimal "02000"))
4850 ((char-equal group-execute-or-setid ?s)
4851 (tramp-compat-octal-to-decimal "02010"))
4852 ((char-equal group-execute-or-setid ?-) 0)
4853 (t (error "Seventh char `%c' must be one of `xsS-'"
4854 group-execute-or-setid)))
4855 (cond
4856 ((char-equal other-read ?r)
4857 (tramp-compat-octal-to-decimal "00004"))
4858 ((char-equal other-read ?-) 0)
4859 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
4860 (cond
4861 ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002"))
4862 ((char-equal other-write ?-) 0)
4863 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
4864 (cond
4865 ((char-equal other-execute-or-sticky ?x)
4866 (tramp-compat-octal-to-decimal "00001"))
4867 ((char-equal other-execute-or-sticky ?T)
4868 (tramp-compat-octal-to-decimal "01000"))
4869 ((char-equal other-execute-or-sticky ?t)
4870 (tramp-compat-octal-to-decimal "01001"))
4871 ((char-equal other-execute-or-sticky ?-) 0)
4872 (t (error "Tenth char `%c' must be one of `xtT-'"
4873 other-execute-or-sticky)))))))
4874
4875(defun tramp-convert-file-attributes (vec attr)
4876 "Convert file-attributes ATTR generated by perl script, stat or ls.
4877Convert file mode bits to string and set virtual device number.
4878Return ATTR."
4879 (when attr
4880 ;; Convert last access time.
4881 (unless (listp (nth 4 attr))
4882 (setcar (nthcdr 4 attr)
4883 (list (floor (nth 4 attr) 65536)
4884 (floor (mod (nth 4 attr) 65536)))))
4885 ;; Convert last modification time.
4886 (unless (listp (nth 5 attr))
4887 (setcar (nthcdr 5 attr)
4888 (list (floor (nth 5 attr) 65536)
4889 (floor (mod (nth 5 attr) 65536)))))
4890 ;; Convert last status change time.
4891 (unless (listp (nth 6 attr))
4892 (setcar (nthcdr 6 attr)
4893 (list (floor (nth 6 attr) 65536)
4894 (floor (mod (nth 6 attr) 65536)))))
4895 ;; Convert file size.
4896 (when (< (nth 7 attr) 0)
4897 (setcar (nthcdr 7 attr) -1))
4898 (when (and (floatp (nth 7 attr))
4899 (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
4900 (setcar (nthcdr 7 attr) (round (nth 7 attr))))
4901 ;; Convert file mode bits to string.
4902 (unless (stringp (nth 8 attr))
4903 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
4904 (when (stringp (car attr))
4905 (aset (nth 8 attr) 0 ?l)))
4906 ;; Convert directory indication bit.
4907 (when (string-match "^d" (nth 8 attr))
4908 (setcar attr t))
4909 ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
4910 (when (consp (car attr))
4911 (if (and (stringp (caar attr))
4912 (string-match ".+ -> .\\(.+\\)." (caar attr)))
4913 (setcar attr (match-string 1 (caar attr)))
4914 (setcar attr nil)))
4915 ;; Set file's gid change bit.
4916 (setcar (nthcdr 9 attr)
4917 (if (numberp (nth 3 attr))
4918 (not (= (nth 3 attr)
4919 (tramp-get-remote-gid vec 'integer)))
4920 (not (string-equal
4921 (nth 3 attr)
4922 (tramp-get-remote-gid vec 'string)))))
4923 ;; Convert inode.
4924 (unless (listp (nth 10 attr))
4925 (setcar (nthcdr 10 attr)
4926 (condition-case nil
4927 (cons (floor (nth 10 attr) 65536)
4928 (floor (mod (nth 10 attr) 65536)))
4929 ;; Inodes can be incredible huge. We must hide this.
4930 (error (tramp-get-inode vec)))))
4931 ;; Set virtual device number.
4932 (setcar (nthcdr 11 attr)
4933 (tramp-get-device vec))
4934 attr))
4935
4936(defun tramp-check-cached-permissions (vec access)
4937 "Check `file-attributes' caches for VEC.
4938Return t if according to the cache access type ACCESS is known to
4939be granted."
4940 (let ((result nil)
4941 (offset (cond
4942 ((eq ?r access) 1)
4943 ((eq ?w access) 2)
4944 ((eq ?x access) 3))))
4945 (dolist (suffix '("string" "integer") result)
4946 (setq
4947 result
4948 (or
4949 result
4950 (let ((file-attr
4951 (tramp-get-file-property
4952 vec (tramp-file-name-localname vec)
4953 (concat "file-attributes-" suffix) nil))
4954 (remote-uid
4955 (tramp-get-connection-property
4956 vec (concat "uid-" suffix) nil))
4957 (remote-gid
4958 (tramp-get-connection-property
4959 vec (concat "gid-" suffix) nil)))
4960 (and
4961 file-attr
4962 (or
4963 ;; Not a symlink
4964 (eq t (car file-attr))
4965 (null (car file-attr)))
4966 (or
4967 ;; World accessible.
4968 (eq access (aref (nth 8 file-attr) (+ offset 6)))
4969 ;; User accessible and owned by user.
4970 (and
4971 (eq access (aref (nth 8 file-attr) offset))
4972 (equal remote-uid (nth 2 file-attr)))
4973 ;; Group accessible and owned by user's
4974 ;; principal group.
4975 (and
4976 (eq access (aref (nth 8 file-attr) (+ offset 3)))
4977 (equal remote-gid (nth 3 file-attr)))))))))))
4978
4979(defun tramp-file-mode-from-int (mode)
4980 "Turn an integer representing a file mode into an ls(1)-like string."
4981 (let ((type (cdr
4982 (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
4983 (user (logand (lsh mode -6) 7))
4984 (group (logand (lsh mode -3) 7))
4985 (other (logand (lsh mode -0) 7))
4986 (suid (> (logand (lsh mode -9) 4) 0))
4987 (sgid (> (logand (lsh mode -9) 2) 0))
4988 (sticky (> (logand (lsh mode -9) 1) 0)))
4989 (setq user (tramp-file-mode-permissions user suid "s"))
4990 (setq group (tramp-file-mode-permissions group sgid "s"))
4991 (setq other (tramp-file-mode-permissions other sticky "t"))
4992 (concat type user group other)))
4993
4994(defun tramp-file-mode-permissions (perm suid suid-text)
4995 "Convert a permission bitset into a string.
4996This is used internally by `tramp-file-mode-from-int'."
4997 (let ((r (> (logand perm 4) 0))
4998 (w (> (logand perm 2) 0))
4999 (x (> (logand perm 1) 0)))
5000 (concat (or (and r "r") "-")
5001 (or (and w "w") "-")
5002 (or (and suid x suid-text) ; suid, execute
5003 (and suid (upcase suid-text)) ; suid, !execute
5004 (and x "x") "-")))) ; !suid
5005
5006(defun tramp-shell-case-fold (string)
5007 "Converts STRING to shell glob pattern which ignores case."
5008 (mapconcat
5009 (lambda (c)
5010 (if (equal (downcase c) (upcase c))
5011 (vector c)
5012 (format "[%c%c]" (downcase c) (upcase c))))
5013 string
5014 ""))
5015
5016(defun tramp-make-copy-program-file-name (vec)
5017 "Create a file name suitable to be passed to `rcp' and workalikes."
5018 (let ((user (tramp-file-name-user vec))
5019 (host (tramp-file-name-real-host vec))
5020 (localname (tramp-shell-quote-argument
5021 (tramp-file-name-localname vec))))
5022 (if (not (zerop (length user)))
5023 (format "%s@%s:%s" user host localname)
5024 (format "%s:%s" host localname))))
5025
5026(defun tramp-method-out-of-band-p (vec size)
5027 "Return t if this is an out-of-band method, nil otherwise."
5028 (and
5029 ;; It shall be an out-of-band method.
5030 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
5031 ;; Either the file size is large enough, or (in rare cases) there
5032 ;; does not exist a remote encoding.
5033 (or (null tramp-copy-size-limit)
5034 (> size tramp-copy-size-limit)
5035 (null (tramp-get-inline-coding vec "remote-encoding" size)))))
5036
5037(defun tramp-local-host-p (vec)
5038 "Return t if this points to the local host, nil otherwise."
5039 ;; We cannot use `tramp-file-name-real-host'. A port is an
5040 ;; indication for an ssh tunnel or alike.
5041 (let ((host (tramp-file-name-host vec)))
5042 (and
5043 (stringp host)
5044 (string-match tramp-local-host-regexp host)
5045 ;; The method shall be applied to one of the shell file name
5046 ;; handler. `tramp-local-host-p' is also called for "smb" and
5047 ;; alike, where it must fail.
5048 (tramp-get-method-parameter
5049 (tramp-file-name-method vec) 'tramp-login-program)
5050 ;; The local temp directory must be writable for the other user.
5051 (file-writable-p
5052 (tramp-make-tramp-file-name
5053 (tramp-file-name-method vec)
5054 (tramp-file-name-user vec)
5055 host
5056 (tramp-compat-temporary-file-directory)))
5057 ;; On some systems, chown runs only for root.
5058 (or (zerop (user-uid))
5059 (zerop (tramp-get-remote-uid vec 'integer))))))
5060
5061;; Variables local to connection.
5062
5063(defun tramp-get-remote-path (vec)
5064 (with-connection-property
5065 ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
5066 ;; cache the result for the session only. Otherwise, the result
5067 ;; is cached persistently.
5068 (if (memq 'tramp-own-remote-path tramp-remote-path)
5069 (tramp-get-connection-process vec)
5070 vec)
5071 "remote-path"
5072 (let* ((remote-path (copy-tree tramp-remote-path))
5073 (elt1 (memq 'tramp-default-remote-path remote-path))
5074 (elt2 (memq 'tramp-own-remote-path remote-path))
5075 (default-remote-path
5076 (when elt1
5077 (condition-case nil
5078 (tramp-send-command-and-read
5079 vec "echo \\\"`getconf PATH`\\\"")
5080 ;; Default if "getconf" is not available.
5081 (error
5082 (tramp-message
5083 vec 3
5084 "`getconf PATH' not successful, using default value \"%s\"."
5085 "/bin:/usr/bin")
5086 "/bin:/usr/bin"))))
5087 (own-remote-path
5088 (when elt2
5089 (condition-case nil
5090 (tramp-send-command-and-read vec "echo \\\"$PATH\\\"")
5091 ;; Default if "getconf" is not available.
5092 (error
5093 (tramp-message
5094 vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.")
5095 nil)))))
5096
5097 ;; Replace place holder `tramp-default-remote-path'.
5098 (when elt1
5099 (setcdr elt1
5100 (append
5101 (tramp-compat-split-string default-remote-path ":")
5102 (cdr elt1)))
5103 (setq remote-path (delq 'tramp-default-remote-path remote-path)))
5104
5105 ;; Replace place holder `tramp-own-remote-path'.
5106 (when elt2
5107 (setcdr elt2
5108 (append
5109 (tramp-compat-split-string own-remote-path ":")
5110 (cdr elt2)))
5111 (setq remote-path (delq 'tramp-own-remote-path remote-path)))
5112
5113 ;; Remove double entries.
5114 (setq elt1 remote-path)
5115 (while (consp elt1)
5116 (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
5117 (setcar elt2 nil))
5118 (setq elt1 (cdr elt1)))
5119
5120 ;; Remove non-existing directories.
5121 (delq
5122 nil
5123 (mapcar
5124 (lambda (x)
5125 (and
5126 (stringp x)
5127 (file-directory-p
5128 (tramp-make-tramp-file-name
5129 (tramp-file-name-method vec)
5130 (tramp-file-name-user vec)
5131 (tramp-file-name-host vec)
5132 x))
5133 x))
5134 remote-path)))))
5135
5136(defun tramp-get-remote-tmpdir (vec)
5137 (with-connection-property vec "tmp-directory"
5138 (let ((dir (tramp-shell-quote-argument "/tmp")))
5139 (if (and (tramp-send-command-and-check
5140 vec (format "%s -d %s" (tramp-get-test-command vec) dir))
5141 (tramp-send-command-and-check
5142 vec (format "%s -w %s" (tramp-get-test-command vec) dir)))
5143 dir
5144 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
5145
5146(defun tramp-make-tramp-temp-file (vec)
5147 "Create a temporary file on the remote host identified by VEC.
5148Return the local name of the temporary file."
5149 (let ((prefix
5150 (tramp-make-tramp-file-name
5151 (tramp-file-name-method vec)
5152 (tramp-file-name-user vec)
5153 (tramp-file-name-host vec)
5154 (tramp-drop-volume-letter
5155 (expand-file-name
5156 tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
5157 result)
5158 (while (not result)
5159 ;; `make-temp-file' would be the natural choice for
5160 ;; implementation. But it calls `write-region' internally,
5161 ;; which also needs a temporary file - we would end in an
5162 ;; infinite loop.
5163 (setq result (make-temp-name prefix))
5164 (if (file-exists-p result)
5165 (setq result nil)
5166 ;; This creates the file by side effect.
5167 (set-file-times result)
5168 (set-file-modes result (tramp-compat-octal-to-decimal "0700"))))
5169
5170 ;; Return the local part.
5171 (with-parsed-tramp-file-name result nil localname)))
5172
5173(defun tramp-get-ls-command (vec)
5174 (with-connection-property vec "ls"
5175 (tramp-message vec 5 "Finding a suitable `ls' command")
5176 (or
5177 (catch 'ls-found
5178 (dolist (cmd '("ls" "gnuls" "gls"))
5179 (let ((dl (tramp-get-remote-path vec))
5180 result)
5181 (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
5182 ;; Check parameters. On busybox, "ls" output coloring is
5183 ;; enabled by default sometimes. So we try to disable it
5184 ;; when possible. $LS_COLORING is not supported there.
5185 ;; Some "ls" versions are sensible wrt the order of
5186 ;; arguments, they fail when "-al" is after the
5187 ;; "--color=never" argument (for example on FreeBSD).
5188 (when (tramp-send-command-and-check
5189 vec (format "%s -lnd /" result))
5190 (when (tramp-send-command-and-check
5191 vec (format
5192 "%s --color=never -al /dev/null" result))
5193 (setq result (concat result " --color=never")))
5194 (throw 'ls-found result))
5195 (setq dl (cdr dl))))))
5196 (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
5197
5198(defun tramp-get-ls-command-with-dired (vec)
5199 (save-match-data
5200 (with-connection-property vec "ls-dired"
5201 (tramp-message vec 5 "Checking, whether `ls --dired' works")
5202 ;; Some "ls" versions are sensible wrt the order of arguments,
5203 ;; they fail when "-al" is after the "--dired" argument (for
5204 ;; example on FreeBSD).
5205 (tramp-send-command-and-check
5206 vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec))))))
5207
5208(defun tramp-get-test-command (vec)
5209 (with-connection-property vec "test"
5210 (tramp-message vec 5 "Finding a suitable `test' command")
5211 (if (tramp-send-command-and-check vec "test 0")
5212 "test"
5213 (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
5214
5215(defun tramp-get-test-nt-command (vec)
5216 ;; Does `test A -nt B' work? Use abominable `find' construct if it
5217 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
5218 ;; for otherwise the shell crashes.
5219 (with-connection-property vec "test-nt"
5220 (or
5221 (progn
5222 (tramp-send-command
5223 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
5224 (with-current-buffer (tramp-get-buffer vec)
5225 (goto-char (point-min))
5226 (when (looking-at (regexp-quote tramp-end-of-output))
5227 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
5228 (progn
5229 (tramp-send-command
5230 vec
5231 (format
5232 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
5233 (tramp-get-test-command vec)))
5234 "tramp_test_nt %s %s"))))
5235
5236(defun tramp-get-file-exists-command (vec)
5237 (with-connection-property vec "file-exists"
5238 (tramp-message vec 5 "Finding command to check if file exists")
5239 (tramp-find-file-exists-command vec)))
5240
5241(defun tramp-get-remote-ln (vec)
5242 (with-connection-property vec "ln"
5243 (tramp-message vec 5 "Finding a suitable `ln' command")
5244 (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
5245
5246(defun tramp-get-remote-perl (vec)
5247 (with-connection-property vec "perl"
5248 (tramp-message vec 5 "Finding a suitable `perl' command")
5249 (let ((result
5250 (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
5251 (tramp-find-executable
5252 vec "perl" (tramp-get-remote-path vec)))))
5253 ;; We must check also for some Perl modules.
5254 (when result
5255 (with-connection-property vec "perl-file-spec"
5256 (tramp-send-command-and-check
5257 vec (format "%s -e 'use File::Spec;'" result)))
5258 (with-connection-property vec "perl-cwd-realpath"
5259 (tramp-send-command-and-check
5260 vec (format "%s -e 'use Cwd \"realpath\";'" result))))
5261 result)))
5262
5263(defun tramp-get-remote-stat (vec)
5264 (with-connection-property vec "stat"
5265 (tramp-message vec 5 "Finding a suitable `stat' command")
5266 (let ((result (tramp-find-executable
5267 vec "stat" (tramp-get-remote-path vec)))
5268 tmp)
5269 ;; Check whether stat(1) returns usable syntax. %s does not
5270 ;; work on older AIX systems.
5271 (when result
5272 (setq tmp
5273 ;; We don't want to display an error message.
5274 (tramp-compat-with-temp-message (or (current-message) "")
5275 (ignore-errors
5276 (tramp-send-command-and-read
5277 vec (format "%s -c '(\"%%N\" %%s)' /" result)))))
5278 (unless (and (listp tmp) (stringp (car tmp))
5279 (string-match "^./.$" (car tmp))
5280 (integerp (cadr tmp)))
5281 (setq result nil)))
5282 result)))
5283
5284(defun tramp-get-remote-readlink (vec)
5285 (with-connection-property vec "readlink"
5286 (tramp-message vec 5 "Finding a suitable `readlink' command")
5287 (let ((result (tramp-find-executable
5288 vec "readlink" (tramp-get-remote-path vec))))
5289 (when (and result
5290 ;; We don't want to display an error message.
5291 (tramp-compat-with-temp-message (or (current-message) "")
5292 (ignore-errors
5293 (tramp-send-command-and-check
5294 vec (format "%s --canonicalize-missing /" result)))))
5295 result))))
5296
5297(defun tramp-get-remote-trash (vec)
5298 (with-connection-property vec "trash"
5299 (tramp-message vec 5 "Finding a suitable `trash' command")
5300 (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
5301
5302(defun tramp-get-remote-id (vec)
5303 (with-connection-property vec "id"
5304 (tramp-message vec 5 "Finding POSIX `id' command")
5305 (or
5306 (catch 'id-found
5307 (let ((dl (tramp-get-remote-path vec))
5308 result)
5309 (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
5310 ;; Check POSIX parameter.
5311 (when (tramp-send-command-and-check vec (format "%s -u" result))
5312 (throw 'id-found result))
5313 (setq dl (cdr dl)))))
5314 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
5315
5316(defun tramp-get-remote-uid (vec id-format)
5317 (with-connection-property vec (format "uid-%s" id-format)
5318 (let ((res (tramp-send-command-and-read
5319 vec
5320 (format "%s -u%s %s"
5321 (tramp-get-remote-id vec)
5322 (if (equal id-format 'integer) "" "n")
5323 (if (equal id-format 'integer)
5324 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
5325 ;; The command might not always return a number.
5326 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
5327
5328(defun tramp-get-remote-gid (vec id-format)
5329 (with-connection-property vec (format "gid-%s" id-format)
5330 (let ((res (tramp-send-command-and-read
5331 vec
5332 (format "%s -g%s %s"
5333 (tramp-get-remote-id vec)
5334 (if (equal id-format 'integer) "" "n")
5335 (if (equal id-format 'integer)
5336 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
5337 ;; The command might not always return a number.
5338 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
5339
5340(defun tramp-get-local-uid (id-format)
5341 (if (equal id-format 'integer) (user-uid) (user-login-name)))
5342
5343(defun tramp-get-local-gid (id-format)
5344 (nth 3 (tramp-compat-file-attributes "~/" id-format)))
5345
5346;; Some predefined connection properties.
5347(defun tramp-get-inline-compress (vec prop size)
5348 "Return the compress command related to PROP.
5349PROP is either `inline-compress' or `inline-decompress'. SIZE is
5350the length of the file to be compressed.
5351
5352If no corresponding command is found, nil is returned."
5353 (when (and (integerp tramp-inline-compress-start-size)
5354 (> size tramp-inline-compress-start-size))
5355 (with-connection-property vec prop
5356 (tramp-find-inline-compress vec)
5357 (tramp-get-connection-property vec prop nil))))
5358
5359(defun tramp-get-inline-coding (vec prop size)
5360 "Return the coding command related to PROP.
5361PROP is either `remote-encoding', `remode-decoding',
5362`local-encoding' or `local-decoding'.
5363
5364SIZE is the length of the file to be coded. Depending on SIZE,
5365compression might be applied.
5366
5367If no corresponding command is found, nil is returned.
5368Otherwise, either a string is returned which contains a `%s' mark
5369to be used for the respective input or output file; or a Lisp
5370function cell is returned to be applied on a buffer."
5371 (let ((coding
5372 (with-connection-property vec prop
5373 (tramp-find-inline-encoding vec)
5374 (tramp-get-connection-property vec prop nil)))
5375 (prop1 (if (string-match "encoding" prop)
5376 "inline-compress" "inline-decompress"))
5377 compress)
5378 ;; The connection property might have been cached. So we must send
5379 ;; the script to the remote side - maybe.
5380 (when (and coding (symbolp coding) (string-match "remote" prop))
5381 (let ((name (symbol-name coding)))
5382 (while (string-match (regexp-quote "-") name)
5383 (setq name (replace-match "_" nil t name)))
5384 (tramp-maybe-send-script vec (symbol-value coding) name)
5385 (setq coding name)))
5386 (when coding
5387 ;; Check for the `compress' command.
5388 (setq compress (tramp-get-inline-compress vec prop1 size))
5389 ;; Return the value.
5390 (cond
5391 ((and compress (symbolp coding))
5392 (if (string-match "decompress" prop1)
5393 `(lambda (beg end)
5394 (,coding beg end)
5395 (let ((coding-system-for-write 'binary)
5396 (coding-system-for-read 'binary))
5397 (apply
5398 'call-process-region (point-min) (point-max)
5399 (car (split-string ,compress)) t t nil
5400 (cdr (split-string ,compress)))))
5401 `(lambda (beg end)
5402 (let ((coding-system-for-write 'binary)
5403 (coding-system-for-read 'binary))
5404 (apply
5405 'call-process-region beg end
5406 (car (split-string ,compress)) t t nil
5407 (cdr (split-string ,compress))))
5408 (,coding (point-min) (point-max)))))
5409 ((symbolp coding)
5410 coding)
5411 ((and compress (string-match "decoding" prop))
5412 (format "(%s | %s >%%s)" coding compress))
5413 (compress
5414 (format "(%s <%%s | %s)" compress coding))
5415 ((string-match "decoding" prop)
5416 (format "%s >%%s" coding))
5417 (t
5418 (format "%s <%%s" coding))))))
5419
5420;;; Integration of eshell.el:
5421
5422(eval-when-compile
5423 (defvar eshell-path-env))
5424
5425;; eshell.el keeps the path in `eshell-path-env'. We must change it
5426;; when `default-directory' points to another host.
5427(defun tramp-eshell-directory-change ()
5428 "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
5429 (setq eshell-path-env
5430 (if (file-remote-p default-directory)
5431 (with-parsed-tramp-file-name default-directory nil
5432 (mapconcat
5433 'identity
5434 (tramp-get-remote-path v)
5435 ":"))
5436 (getenv "PATH"))))
5437
5438(eval-after-load "esh-util"
5439 '(progn
5440 (tramp-eshell-directory-change)
5441 (add-hook 'eshell-directory-change-hook
5442 'tramp-eshell-directory-change)
5443 (add-hook 'tramp-unload-hook
5444 (lambda ()
5445 (remove-hook 'eshell-directory-change-hook
5446 'tramp-eshell-directory-change)))))
5447
5448(add-hook 'tramp-unload-hook
5449 (lambda ()
5450 (unload-feature 'tramp-sh 'force)))
5451
5452(provide 'tramp-sh)
5453
5454;;; TODO:
5455
5456;; * Don't use globbing for directories with many files, as this is
5457;; likely to produce long command lines, and some shells choke on
5458;; long command lines.
5459;; * Make it work for different encodings, and for different file name
5460;; encodings, too. (Daniel Pittman)
5461;; * Don't search for perl5 and perl. Instead, only search for perl and
5462;; then look if it's the right version (with `perl -v').
5463;; * When editing a remote CVS controlled file as a different user, VC
5464;; gets confused about the file locking status. Try to find out why
5465;; the workaround doesn't work.
5466;; * Allow out-of-band methods as _last_ multi-hop. Open a connection
5467;; until the last but one hop via `start-file-process'. Apply it
5468;; also for ftp and smb.
5469;; * WIBNI if we had a command "trampclient"? If I was editing in
5470;; some shell with root priviledges, it would be nice if I could
5471;; just call
5472;; trampclient filename.c
5473;; as an editor, and the _current_ shell would connect to an Emacs
5474;; server and would be used in an existing non-priviledged Emacs
5475;; session for doing the editing in question.
5476;; That way, I need not tell Emacs my password again and be afraid
5477;; that it makes it into core dumps or other ugly stuff (I had Emacs
5478;; once display a just typed password in the context of a keyboard
5479;; sequence prompt for a question immediately following in a shell
5480;; script run within Emacs -- nasty).
5481;; And if I have some ssh session running to a different computer,
5482;; having the possibility of passing a local file there to a local
5483;; Emacs session (in case I can arrange for a connection back) would
5484;; be nice.
5485;; Likely the corresponding Tramp server should not allow the
5486;; equivalent of the emacsclient -eval option in order to make this
5487;; reasonably unproblematic. And maybe trampclient should have some
5488;; way of passing credentials, like by using an SSL socket or
5489;; something. (David Kastrup)
5490;; * Reconnect directly to a compliant shell without first going
5491;; through the user's default shell. (Pete Forman)
5492;; * How can I interrupt the remote process with a signal
5493;; (interrupt-process seems not to work)? (Markus Triska)
5494;; * Avoid the local shell entirely for starting remote processes. If
5495;; so, I think even a signal, when delivered directly to the local
5496;; SSH instance, would correctly be propagated to the remote process
5497;; automatically; possibly SSH would have to be started with
5498;; "-t". (Markus Triska)
5499;; * It makes me wonder if tramp couldn't fall back to ssh when scp
5500;; isn't on the remote host. (Mark A. Hershberger)
5501;; * Use lsh instead of ssh. (Alfred M. Szmidt)
5502;; * Optimize out-of-band copying, when both methods are scp-like (not
5503;; rsync).
5504;; * Keep a second connection open for out-of-band methods like scp or
5505;; rsync.
5506;; * Try telnet+curl as new method. It might be useful for busybox,
5507;; without built-in uuencode/uudecode.
5508
5509;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 48af7d8120a..e48a8b321fd 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -30,17 +30,20 @@
30 30
31(eval-when-compile (require 'cl)) ; block, return 31(eval-when-compile (require 'cl)) ; block, return
32(require 'tramp) 32(require 'tramp)
33(require 'tramp-cache) 33
34(require 'tramp-compat) 34;; We call several `tramp-handle-*' functions directly. So we must
35;; reqire that package as well.
36(require 'tramp-sh)
35 37
36;; Define SMB method ... 38;; Define SMB method ...
37(defcustom tramp-smb-method "smb" 39;;;###tramp-autoload
38 "*Method to connect SAMBA and M$ SMB servers." 40(defconst tramp-smb-method "smb"
39 :group 'tramp 41 "*Method to connect SAMBA and M$ SMB servers.")
40 :type 'string)
41 42
42;; ... and add it to the method list. 43;; ... and add it to the method list.
43(add-to-list 'tramp-methods (cons tramp-smb-method nil)) 44;;;###tramp-autoload
45(unless (memq system-type '(cygwin windows-nt))
46 (add-to-list 'tramp-methods (cons tramp-smb-method nil)))
44 47
45;; Add a default for `tramp-default-method-alist'. Rule: If there is 48;; Add a default for `tramp-default-method-alist'. Rule: If there is
46;; a domain in USER, it must be the SMB method. 49;; a domain in USER, it must be the SMB method.
@@ -205,11 +208,13 @@ See `tramp-actions-before-shell' for more info.")
205 "Alist of handler functions for Tramp SMB method. 208 "Alist of handler functions for Tramp SMB method.
206Operations not mentioned here will be handled by the default Emacs primitives.") 209Operations not mentioned here will be handled by the default Emacs primitives.")
207 210
208(defun tramp-smb-file-name-p (filename) 211;;;###tramp-autoload
212(defsubst tramp-smb-file-name-p (filename)
209 "Check if it's a filename for SMB servers." 213 "Check if it's a filename for SMB servers."
210 (let ((v (tramp-dissect-file-name filename))) 214 (let ((v (tramp-dissect-file-name filename)))
211 (string= (tramp-file-name-method v) tramp-smb-method))) 215 (string= (tramp-file-name-method v) tramp-smb-method)))
212 216
217;;;###tramp-autoload
213(defun tramp-smb-file-name-handler (operation &rest args) 218(defun tramp-smb-file-name-handler (operation &rest args)
214 "Invoke the SMB related OPERATION. 219 "Invoke the SMB related OPERATION.
215First arg specifies the OPERATION, second arg is a list of arguments to 220First arg specifies the OPERATION, second arg is a list of arguments to
@@ -219,8 +224,10 @@ pass to the OPERATION."
219 (save-match-data (apply (cdr fn) args)) 224 (save-match-data (apply (cdr fn) args))
220 (tramp-run-real-handler operation args)))) 225 (tramp-run-real-handler operation args))))
221 226
222(add-to-list 'tramp-foreign-file-name-handler-alist 227;;;###tramp-autoload
223 (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) 228(unless (memq system-type '(cygwin windows-nt))
229 (add-to-list 'tramp-foreign-file-name-handler-alist
230 (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
224 231
225 232
226;; File name primitives. 233;; File name primitives.
@@ -784,7 +791,7 @@ PRESERVE-UID-GID is completely ignored."
784 (if (tramp-smb-get-cifs-capabilities v) 791 (if (tramp-smb-get-cifs-capabilities v)
785 (format 792 (format
786 "posix_mkdir \"%s\" %s" 793 "posix_mkdir \"%s\" %s"
787 file (tramp-decimal-to-octal (default-file-modes))) 794 file (tramp-compat-decimal-to-octal (default-file-modes)))
788 (format "mkdir \"%s\"" file))) 795 (format "mkdir \"%s\"" file)))
789 ;; We must also flush the cache of the directory, because 796 ;; We must also flush the cache of the directory, because
790 ;; `file-attributes' reads the values from there. 797 ;; `file-attributes' reads the values from there.
@@ -893,7 +900,7 @@ target of the symlink differ."
893 (unless (tramp-smb-send-command 900 (unless (tramp-smb-send-command
894 v (format "chmod \"%s\" %s" 901 v (format "chmod \"%s\" %s"
895 (tramp-smb-get-localname v) 902 (tramp-smb-get-localname v)
896 (tramp-decimal-to-octal mode))) 903 (tramp-compat-decimal-to-octal mode)))
897 (tramp-error 904 (tramp-error
898 v 'file-error "Error while changing file's mode %s" filename))))) 905 v 'file-error "Error while changing file's mode %s" filename)))))
899 906
@@ -1397,6 +1404,9 @@ Returns nil if an error message has appeared."
1397 (tramp-message vec 6 "\n%s" (buffer-string)) 1404 (tramp-message vec 6 "\n%s" (buffer-string))
1398 (not err)))) 1405 (not err))))
1399 1406
1407(add-hook 'tramp-unload-hook
1408 (lambda ()
1409 (unload-feature 'tramp-smb 'force)))
1400 1410
1401(provide 'tramp-smb) 1411(provide 'tramp-smb)
1402 1412
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index a9f816be815..fe6862c9240 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -50,6 +50,7 @@
50 "Return the byte that is encoded as CHAR." 50 "Return the byte that is encoded as CHAR."
51 (cdr (assq char tramp-uu-b64-char-to-byte))) 51 (cdr (assq char tramp-uu-b64-char-to-byte)))
52 52
53;;;###tramp-autoload
53(defun tramp-uuencode-region (beg end) 54(defun tramp-uuencode-region (beg end)
54 "UU-encode the region between BEG and END." 55 "UU-encode the region between BEG and END."
55 ;; First we base64 encode the region, then we transmogrify that into 56 ;; First we base64 encode the region, then we transmogrify that into
@@ -87,6 +88,10 @@
87 (goto-char beg) 88 (goto-char beg)
88 (insert "begin 600 xxx\n")))) 89 (insert "begin 600 xxx\n"))))
89 90
91(add-hook 'tramp-unload-hook
92 (lambda ()
93 (unload-feature 'tramp-uu 'force)))
94
90(provide 'tramp-uu) 95(provide 'tramp-uu)
91 96
92;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6 97;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d5d1606c617..3a3b3ad35e0 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3,11 +3,10 @@
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; (copyright statements below in code to be updated with the above notice)
7
8;; Author: Kai Großjohann <kai.grossjohann@gmx.net> 6;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
9;; Michael Albinus <michael.albinus@gmx.de> 7;; Michael Albinus <michael.albinus@gmx.de>
10;; Keywords: comm, processes 8;; Keywords: comm, processes
9;; Package: tramp
11 10
12;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
13 12
@@ -59,117 +58,7 @@
59 58
60;;; Code: 59;;; Code:
61 60
62;; Since Emacs 23.1, loading messages have been disabled during
63;; autoload. However, loading Tramp takes a while, and it could
64;; happen while typing a filename in the minibuffer. Therefore, Tramp
65;; shall inform about.
66(when (and load-in-progress (null (current-message)))
67 (message "Loading tramp..."))
68
69;; The Tramp version number and bug report address, as prepared by configure.
70(require 'trampver)
71(add-hook 'tramp-unload-hook
72 (lambda ()
73 (when (featurep 'trampver)
74 (unload-feature 'trampver 'force))))
75
76(require 'tramp-compat) 61(require 'tramp-compat)
77(add-hook 'tramp-unload-hook
78 (lambda ()
79 (when (featurep 'tramp-compat)
80 (unload-feature 'tramp-compat 'force))))
81
82(require 'format-spec)
83;; As long as password.el is not part of (X)Emacs, it shouldn't
84;; be mandatory
85(if (featurep 'xemacs)
86 (load "password" 'noerror)
87 (or (require 'password-cache nil 'noerror)
88 (require 'password nil 'noerror))) ; from No Gnus, also in tar ball
89
90(require 'shell)
91(require 'advice)
92
93(eval-and-compile
94 (if (featurep 'xemacs)
95 (load "auth-source" 'noerror)
96 (require 'auth-source nil 'noerror)))
97
98;; Requiring 'tramp-cache results in an endless loop.
99(autoload 'tramp-get-file-property "tramp-cache")
100(autoload 'tramp-set-file-property "tramp-cache")
101(autoload 'tramp-flush-file-property "tramp-cache")
102(autoload 'tramp-flush-directory-property "tramp-cache")
103(autoload 'tramp-get-connection-property "tramp-cache")
104(autoload 'tramp-set-connection-property "tramp-cache")
105(autoload 'tramp-flush-connection-property "tramp-cache")
106(autoload 'tramp-parse-connection-properties "tramp-cache")
107(add-hook 'tramp-unload-hook
108 (lambda ()
109 (when (featurep 'tramp-cache)
110 (unload-feature 'tramp-cache 'force))))
111
112(autoload 'tramp-uuencode-region "tramp-uu"
113 "Implementation of `uuencode' in Lisp.")
114(add-hook 'tramp-unload-hook
115 (lambda ()
116 (when (featurep 'tramp-uu)
117 (unload-feature 'tramp-uu 'force))))
118
119(autoload 'uudecode-decode-region "uudecode")
120
121;; The following Tramp packages must be loaded after tramp.el, because
122;; they require it as well.
123(eval-after-load "tramp"
124 '(dolist
125 (feature
126 (list
127
128 ;; Tramp interactive commands.
129 'tramp-cmds
130
131 ;; Load foreign FTP method.
132 (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
133
134 ;; tramp-smb uses "smbclient" from Samba. Not available
135 ;; under Cygwin and Windows, because they don't offer
136 ;; "smbclient". And even not necessary there, because Emacs
137 ;; supports UNC file names like "//host/share/localname".
138 (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
139
140 ;; Load foreign FISH method.
141 'tramp-fish
142
143 ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
144 ;; on some system types. We don't call `dbus-ping', because
145 ;; this would load dbus.el.
146 (when (and (featurep 'dbusbind)
147 (condition-case nil
148 (tramp-compat-funcall 'dbus-get-unique-name :session)
149 (error nil))
150 (tramp-compat-process-running-p "gvfs-fuse-daemon"))
151 'tramp-gvfs)
152
153 ;; Load gateways. It needs `make-network-process' from Emacs 22.
154 (when (functionp 'make-network-process) 'tramp-gw)
155
156 ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
157 ;; (from Emacs 23.2).
158 (when (and (locate-library "epa") (locate-library "imap-hash"))
159 'tramp-imap)))
160
161 (when feature
162 ;; We have used just some basic tests, whether a package shall
163 ;; be added. There might still be other errors during loading,
164 ;; which we will catch here.
165 (catch 'tramp-loading
166 (require feature)
167 (add-hook 'tramp-unload-hook
168 `(lambda ()
169 (when (featurep (quote ,feature))
170 (unload-feature (quote ,feature) 'force)))))
171 (unless (featurep feature)
172 (message "Loading %s failed, ignoring this package" feature)))))
173 62
174;;; User Customizable Internal Variables: 63;;; User Customizable Internal Variables:
175 64
@@ -286,379 +175,8 @@ See the variable `tramp-encoding-shell' for more information."
286 :group 'tramp 175 :group 'tramp
287 :type 'string) 176 :type 'string)
288 177
289(defcustom tramp-inline-compress-start-size 4096 178;;;###tramp-autoload
290 "*The minimum size of compressing where inline transfer. 179(defvar tramp-methods nil
291When inline transfer, compress transfered data of file
292whose size is this value or above (up to `tramp-copy-size-limit').
293If it is nil, no compression at all will be applied."
294 :group 'tramp
295 :type '(choice (const nil) integer))
296
297(defcustom tramp-copy-size-limit 10240
298 "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
299If it is nil, inline out-of-the-band copy will be used without a check."
300 :group 'tramp
301 :type '(choice (const nil) integer))
302
303(defcustom tramp-terminal-type "dumb"
304 "*Value of TERM environment variable for logging in to remote host.
305Because Tramp wants to parse the output of the remote shell, it is easily
306confused by ANSI color escape sequences and suchlike. Often, shell init
307files conditionalize this setup based on the TERM environment variable."
308 :group 'tramp
309 :type 'string)
310
311;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for
312;; root users. It uses the `$' character for other users. In order
313;; to guarantee a proper prompt, we use "#$" for the prompt.
314
315(defvar tramp-end-of-output
316 (format
317 "///%s#$"
318 (md5 (concat (prin1-to-string process-environment) (current-time-string))))
319 "String used to recognize end of output.
320The '$' character at the end is quoted; the string cannot be
321detected as prompt when being sent on echoing hosts, therefore.")
322
323(defconst tramp-initial-end-of-output "#$ "
324 "Prompt when establishing a connection.")
325
326(defvar tramp-methods
327 `(("rcp" (tramp-login-program "rsh")
328 (tramp-login-args (("%h") ("-l" "%u")))
329 (tramp-remote-sh "/bin/sh")
330 (tramp-copy-program "rcp")
331 (tramp-copy-args (("-p" "%k") ("-r")))
332 (tramp-copy-keep-date t)
333 (tramp-copy-recursive t)
334 (tramp-password-end-of-line nil))
335 ("scp" (tramp-login-program "ssh")
336 (tramp-login-args (("-l" "%u") ("-p" "%p")
337 ("-e" "none") ("%h")))
338 (tramp-async-args (("-q")))
339 (tramp-remote-sh "/bin/sh")
340 (tramp-copy-program "scp")
341 (tramp-copy-args (("-P" "%p") ("-p" "%k")
342 ("-q") ("-r")))
343 (tramp-copy-keep-date t)
344 (tramp-copy-recursive t)
345 (tramp-password-end-of-line nil)
346 (tramp-gw-args (("-o"
347 "GlobalKnownHostsFile=/dev/null")
348 ("-o" "UserKnownHostsFile=/dev/null")
349 ("-o" "StrictHostKeyChecking=no")))
350 (tramp-default-port 22))
351 ("scp1" (tramp-login-program "ssh")
352 (tramp-login-args (("-l" "%u") ("-p" "%p")
353 ("-1") ("-e" "none") ("%h")))
354 (tramp-async-args (("-q")))
355 (tramp-remote-sh "/bin/sh")
356 (tramp-copy-program "scp")
357 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
358 ("-q") ("-r")))
359 (tramp-copy-keep-date t)
360 (tramp-copy-recursive t)
361 (tramp-password-end-of-line nil)
362 (tramp-gw-args (("-o"
363 "GlobalKnownHostsFile=/dev/null")
364 ("-o" "UserKnownHostsFile=/dev/null")
365 ("-o" "StrictHostKeyChecking=no")))
366 (tramp-default-port 22))
367 ("scp2" (tramp-login-program "ssh")
368 (tramp-login-args (("-l" "%u") ("-p" "%p")
369 ("-2") ("-e" "none") ("%h")))
370 (tramp-async-args (("-q")))
371 (tramp-remote-sh "/bin/sh")
372 (tramp-copy-program "scp")
373 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
374 ("-q") ("-r")))
375 (tramp-copy-keep-date t)
376 (tramp-copy-recursive t)
377 (tramp-password-end-of-line nil)
378 (tramp-gw-args (("-o"
379 "GlobalKnownHostsFile=/dev/null")
380 ("-o" "UserKnownHostsFile=/dev/null")
381 ("-o" "StrictHostKeyChecking=no")))
382 (tramp-default-port 22))
383 ("scp1_old"
384 (tramp-login-program "ssh1")
385 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
386 ("-e" "none")))
387 (tramp-remote-sh "/bin/sh")
388 (tramp-copy-program "scp1")
389 (tramp-copy-args (("-p" "%k") ("-r")))
390 (tramp-copy-keep-date t)
391 (tramp-copy-recursive t)
392 (tramp-password-end-of-line nil))
393 ("scp2_old"
394 (tramp-login-program "ssh2")
395 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
396 ("-e" "none")))
397 (tramp-remote-sh "/bin/sh")
398 (tramp-copy-program "scp2")
399 (tramp-copy-args (("-p" "%k") ("-r")))
400 (tramp-copy-keep-date t)
401 (tramp-copy-recursive t)
402 (tramp-password-end-of-line nil))
403 ("sftp" (tramp-login-program "ssh")
404 (tramp-login-args (("-l" "%u") ("-p" "%p")
405 ("-e" "none") ("%h")))
406 (tramp-async-args (("-q")))
407 (tramp-remote-sh "/bin/sh")
408 (tramp-copy-program "sftp")
409 (tramp-copy-args nil)
410 (tramp-copy-keep-date nil)
411 (tramp-password-end-of-line nil))
412 ("rsync" (tramp-login-program "ssh")
413 (tramp-login-args (("-l" "%u") ("-p" "%p")
414 ("-e" "none") ("%h")))
415 (tramp-async-args (("-q")))
416 (tramp-remote-sh "/bin/sh")
417 (tramp-copy-program "rsync")
418 (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
419 (tramp-copy-keep-date t)
420 (tramp-copy-keep-tmpfile t)
421 (tramp-copy-recursive t)
422 (tramp-password-end-of-line nil))
423 ("rsyncc"
424 (tramp-login-program "ssh")
425 (tramp-login-args (("-l" "%u") ("-p" "%p")
426 ("-o" "ControlPath=%t.%%r@%%h:%%p")
427 ("-o" "ControlMaster=yes")
428 ("-e" "none") ("%h")))
429 (tramp-async-args (("-q")))
430 (tramp-remote-sh "/bin/sh")
431 (tramp-copy-program "rsync")
432 (tramp-copy-args (("-t" "%k") ("-r")))
433 (tramp-copy-env (("RSYNC_RSH")
434 (,(concat
435 "ssh"
436 " -o ControlPath=%t.%%r@%%h:%%p"
437 " -o ControlMaster=auto"))))
438 (tramp-copy-keep-date t)
439 (tramp-copy-keep-tmpfile t)
440 (tramp-copy-recursive t)
441 (tramp-password-end-of-line nil))
442 ("remcp" (tramp-login-program "remsh")
443 (tramp-login-args (("%h") ("-l" "%u")))
444 (tramp-remote-sh "/bin/sh")
445 (tramp-copy-program "rcp")
446 (tramp-copy-args (("-p" "%k")))
447 (tramp-copy-keep-date t)
448 (tramp-password-end-of-line nil))
449 ("rsh" (tramp-login-program "rsh")
450 (tramp-login-args (("%h") ("-l" "%u")))
451 (tramp-remote-sh "/bin/sh")
452 (tramp-copy-program nil)
453 (tramp-copy-args nil)
454 (tramp-copy-keep-date nil)
455 (tramp-password-end-of-line nil))
456 ("ssh" (tramp-login-program "ssh")
457 (tramp-login-args (("-l" "%u") ("-p" "%p")
458 ("-e" "none") ("%h")))
459 (tramp-async-args (("-q")))
460 (tramp-remote-sh "/bin/sh")
461 (tramp-copy-program nil)
462 (tramp-copy-args nil)
463 (tramp-copy-keep-date nil)
464 (tramp-password-end-of-line nil)
465 (tramp-gw-args (("-o"
466 "GlobalKnownHostsFile=/dev/null")
467 ("-o" "UserKnownHostsFile=/dev/null")
468 ("-o" "StrictHostKeyChecking=no")))
469 (tramp-default-port 22))
470 ("ssh1" (tramp-login-program "ssh")
471 (tramp-login-args (("-l" "%u") ("-p" "%p")
472 ("-1") ("-e" "none") ("%h")))
473 (tramp-async-args (("-q")))
474 (tramp-remote-sh "/bin/sh")
475 (tramp-copy-program nil)
476 (tramp-copy-args nil)
477 (tramp-copy-keep-date nil)
478 (tramp-password-end-of-line nil)
479 (tramp-gw-args (("-o"
480 "GlobalKnownHostsFile=/dev/null")
481 ("-o" "UserKnownHostsFile=/dev/null")
482 ("-o" "StrictHostKeyChecking=no")))
483 (tramp-default-port 22))
484 ("ssh2" (tramp-login-program "ssh")
485 (tramp-login-args (("-l" "%u") ("-p" "%p")
486 ("-2") ("-e" "none") ("%h")))
487 (tramp-async-args (("-q")))
488 (tramp-remote-sh "/bin/sh")
489 (tramp-copy-program nil)
490 (tramp-copy-args nil)
491 (tramp-copy-keep-date nil)
492 (tramp-password-end-of-line nil)
493 (tramp-gw-args (("-o"
494 "GlobalKnownHostsFile=/dev/null")
495 ("-o" "UserKnownHostsFile=/dev/null")
496 ("-o" "StrictHostKeyChecking=no")))
497 (tramp-default-port 22))
498 ("ssh1_old"
499 (tramp-login-program "ssh1")
500 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
501 ("-e" "none")))
502 (tramp-async-args (("-q")))
503 (tramp-remote-sh "/bin/sh")
504 (tramp-copy-program nil)
505 (tramp-copy-args nil)
506 (tramp-copy-keep-date nil)
507 (tramp-password-end-of-line nil))
508 ("ssh2_old"
509 (tramp-login-program "ssh2")
510 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
511 ("-e" "none")))
512 (tramp-remote-sh "/bin/sh")
513 (tramp-copy-program nil)
514 (tramp-copy-args nil)
515 (tramp-copy-keep-date nil)
516 (tramp-password-end-of-line nil))
517 ("remsh" (tramp-login-program "remsh")
518 (tramp-login-args (("%h") ("-l" "%u")))
519 (tramp-remote-sh "/bin/sh")
520 (tramp-copy-program nil)
521 (tramp-copy-args nil)
522 (tramp-copy-keep-date nil)
523 (tramp-password-end-of-line nil))
524 ("telnet"
525 (tramp-login-program "telnet")
526 (tramp-login-args (("%h") ("%p")))
527 (tramp-remote-sh "/bin/sh")
528 (tramp-copy-program nil)
529 (tramp-copy-args nil)
530 (tramp-copy-keep-date nil)
531 (tramp-password-end-of-line nil)
532 (tramp-default-port 23))
533 ("su" (tramp-login-program "su")
534 (tramp-login-args (("-") ("%u")))
535 (tramp-remote-sh "/bin/sh")
536 (tramp-copy-program nil)
537 (tramp-copy-args nil)
538 (tramp-copy-keep-date nil)
539 (tramp-password-end-of-line nil))
540 ("sudo" (tramp-login-program "sudo")
541 (tramp-login-args (("-u" "%u")
542 ("-s") ("-H") ("-p" "Password:")))
543 (tramp-remote-sh "/bin/sh")
544 (tramp-copy-program nil)
545 (tramp-copy-args nil)
546 (tramp-copy-keep-date nil)
547 (tramp-password-end-of-line nil))
548 ("scpc" (tramp-login-program "ssh")
549 (tramp-login-args (("-l" "%u") ("-p" "%p")
550 ("-o" "ControlPath=%t.%%r@%%h:%%p")
551 ("-o" "ControlMaster=yes")
552 ("-e" "none") ("%h")))
553 (tramp-async-args (("-q")))
554 (tramp-remote-sh "/bin/sh")
555 (tramp-copy-program "scp")
556 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
557 ("-o" "ControlPath=%t.%%r@%%h:%%p")
558 ("-o" "ControlMaster=auto")))
559 (tramp-copy-keep-date t)
560 (tramp-password-end-of-line nil)
561 (tramp-gw-args (("-o"
562 "GlobalKnownHostsFile=/dev/null")
563 ("-o" "UserKnownHostsFile=/dev/null")
564 ("-o" "StrictHostKeyChecking=no")))
565 (tramp-default-port 22))
566 ("scpx" (tramp-login-program "ssh")
567 (tramp-login-args (("-l" "%u") ("-p" "%p")
568 ("-e" "none") ("-t" "-t")
569 ("%h") ("/bin/sh")))
570 (tramp-async-args (("-q")))
571 (tramp-remote-sh "/bin/sh")
572 (tramp-copy-program "scp")
573 (tramp-copy-args (("-p" "%k")))
574 (tramp-copy-keep-date t)
575 (tramp-password-end-of-line nil)
576 (tramp-gw-args (("-o"
577 "GlobalKnownHostsFile=/dev/null")
578 ("-o" "UserKnownHostsFile=/dev/null")
579 ("-o" "StrictHostKeyChecking=no")))
580 (tramp-default-port 22))
581 ("sshx" (tramp-login-program "ssh")
582 (tramp-login-args (("-l" "%u") ("-p" "%p")
583 ("-e" "none") ("-t" "-t")
584 ("%h") ("/bin/sh")))
585 (tramp-async-args (("-q")))
586 (tramp-remote-sh "/bin/sh")
587 (tramp-copy-program nil)
588 (tramp-copy-args nil)
589 (tramp-copy-keep-date nil)
590 (tramp-password-end-of-line nil)
591 (tramp-gw-args (("-o"
592 "GlobalKnownHostsFile=/dev/null")
593 ("-o" "UserKnownHostsFile=/dev/null")
594 ("-o" "StrictHostKeyChecking=no")))
595 (tramp-default-port 22))
596 ("krlogin"
597 (tramp-login-program "krlogin")
598 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
599 (tramp-remote-sh "/bin/sh")
600 (tramp-copy-program nil)
601 (tramp-copy-args nil)
602 (tramp-copy-keep-date nil)
603 (tramp-password-end-of-line nil))
604 ("plink" (tramp-login-program "plink")
605 (tramp-login-args (("-l" "%u") ("-P" "%p")
606 ("-ssh") ("%h")))
607 (tramp-remote-sh "/bin/sh")
608 (tramp-copy-program nil)
609 (tramp-copy-args nil)
610 (tramp-copy-keep-date nil)
611 (tramp-password-end-of-line "xy") ;see docstring for "xy"
612 (tramp-default-port 22))
613 ("plink1"
614 (tramp-login-program "plink")
615 (tramp-login-args (("-l" "%u") ("-P" "%p")
616 ("-1" "-ssh") ("%h")))
617 (tramp-remote-sh "/bin/sh")
618 (tramp-copy-program nil)
619 (tramp-copy-args nil)
620 (tramp-copy-keep-date nil)
621 (tramp-password-end-of-line "xy") ;see docstring for "xy"
622 (tramp-default-port 22))
623 ("plinkx"
624 (tramp-login-program "plink")
625 ;; ("%h") must be a single element, see
626 ;; `tramp-compute-multi-hops'.
627 (tramp-login-args (("-load") ("%h") ("-t")
628 (,(format
629 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
630 tramp-terminal-type
631 tramp-initial-end-of-output))
632 ("/bin/sh")))
633 (tramp-remote-sh "/bin/sh")
634 (tramp-copy-program nil)
635 (tramp-copy-args nil)
636 (tramp-copy-keep-date nil)
637 (tramp-password-end-of-line nil))
638 ("pscp" (tramp-login-program "plink")
639 (tramp-login-args (("-l" "%u") ("-P" "%p")
640 ("-ssh") ("%h")))
641 (tramp-remote-sh "/bin/sh")
642 (tramp-copy-program "pscp")
643 (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
644 (tramp-copy-keep-date t)
645 (tramp-password-end-of-line "xy") ;see docstring for "xy"
646 (tramp-default-port 22))
647 ("psftp" (tramp-login-program "plink")
648 (tramp-login-args (("-l" "%u") ("-P" "%p")
649 ("-ssh") ("%h")))
650 (tramp-remote-sh "/bin/sh")
651 (tramp-copy-program "pscp")
652 (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
653 (tramp-copy-keep-date t)
654 (tramp-password-end-of-line "xy")) ;see docstring for "xy"
655 ("fcp" (tramp-login-program "fsh")
656 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
657 (tramp-remote-sh "/bin/sh -i")
658 (tramp-copy-program "fcp")
659 (tramp-copy-args (("-p" "%k")))
660 (tramp-copy-keep-date t)
661 (tramp-password-end-of-line nil)))
662 "*Alist of methods for remote files. 180 "*Alist of methods for remote files.
663This is a list of entries of the form (NAME PARAM1 PARAM2 ...). 181This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
664Each NAME stands for a remote access method. Each PARAM is a 182Each NAME stands for a remote access method. Each PARAM is a
@@ -800,8 +318,7 @@ Also see `tramp-default-method-alist'."
800 :group 'tramp 318 :group 'tramp
801 :type 'string) 319 :type 'string)
802 320
803(defcustom tramp-default-method-alist 321(defcustom tramp-default-method-alist nil
804 '(("\\`localhost\\'" "\\`root\\'" "su"))
805 "*Default method to use for specific host/user pairs. 322 "*Default method to use for specific host/user pairs.
806This is an alist of items (HOST USER METHOD). The first matching item 323This is an alist of items (HOST USER METHOD). The first matching item
807specifies the method to use for a file name which does not specify a 324specifies the method to use for a file name which does not specify a
@@ -818,8 +335,7 @@ See `tramp-methods' for a list of possibilities for METHOD."
818 (regexp :tag "User regexp") 335 (regexp :tag "User regexp")
819 (string :tag "Method")))) 336 (string :tag "Method"))))
820 337
821(defcustom tramp-default-user 338(defcustom tramp-default-user nil
822 nil
823 "*Default user to use for transferring files. 339 "*Default user to use for transferring files.
824It is nil by default; otherwise settings in configuration files like 340It is nil by default; otherwise settings in configuration files like
825\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'. 341\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
@@ -828,10 +344,7 @@ This variable is regarded as obsolete, and will be removed soon."
828 :group 'tramp 344 :group 'tramp
829 :type '(choice (const nil) string)) 345 :type '(choice (const nil) string))
830 346
831(defcustom tramp-default-user-alist 347(defcustom tramp-default-user-alist nil
832 `(("\\`su\\(do\\)?\\'" nil "root")
833 ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
834 nil ,(user-login-name)))
835 "*Default user to use for specific method/host pairs. 348 "*Default user to use for specific method/host pairs.
836This is an alist of items (METHOD HOST USER). The first matching item 349This is an alist of items (METHOD HOST USER). The first matching item
837specifies the user to use for a file name which does not specify a 350specifies the user to use for a file name which does not specify a
@@ -846,8 +359,7 @@ empty string for the method name."
846 (regexp :tag "Host regexp") 359 (regexp :tag "Host regexp")
847 (string :tag "User")))) 360 (string :tag "User"))))
848 361
849(defcustom tramp-default-host 362(defcustom tramp-default-host (system-name)
850 (system-name)
851 "*Default host to use for transferring files. 363 "*Default host to use for transferring files.
852Useful for su and sudo methods mostly." 364Useful for su and sudo methods mostly."
853 :group 'tramp 365 :group 'tramp
@@ -877,39 +389,6 @@ interpreted as a regular expression which always matches."
877 "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$") 389 "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$")
878 "*Host names which are regarded as local host.") 390 "*Host names which are regarded as local host.")
879 391
880(defconst tramp-completion-function-alist-rsh
881 '((tramp-parse-rhosts "/etc/hosts.equiv")
882 (tramp-parse-rhosts "~/.rhosts"))
883 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
884
885(defconst tramp-completion-function-alist-ssh
886 '((tramp-parse-rhosts "/etc/hosts.equiv")
887 (tramp-parse-rhosts "/etc/shosts.equiv")
888 (tramp-parse-shosts "/etc/ssh_known_hosts")
889 (tramp-parse-sconfig "/etc/ssh_config")
890 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
891 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
892 (tramp-parse-rhosts "~/.rhosts")
893 (tramp-parse-rhosts "~/.shosts")
894 (tramp-parse-shosts "~/.ssh/known_hosts")
895 (tramp-parse-sconfig "~/.ssh/config")
896 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
897 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
898 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
899
900(defconst tramp-completion-function-alist-telnet
901 '((tramp-parse-hosts "/etc/hosts"))
902 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
903
904(defconst tramp-completion-function-alist-su
905 '((tramp-parse-passwd "/etc/passwd"))
906 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
907
908(defconst tramp-completion-function-alist-putty
909 '((tramp-parse-putty
910 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
911 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
912
913(defvar tramp-completion-function-alist nil 392(defvar tramp-completion-function-alist nil
914 "*Alist of methods for remote files. 393 "*Alist of methods for remote files.
915This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\). 394This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
@@ -930,63 +409,6 @@ names from FILE for completion. The following predefined FUNCTIONs exists:
930FUNCTION can also be a customer defined function. For more details see 409FUNCTION can also be a customer defined function. For more details see
931the info pages.") 410the info pages.")
932 411
933(eval-after-load "tramp"
934 '(progn
935 (tramp-set-completion-function
936 "rcp" tramp-completion-function-alist-rsh)
937 (tramp-set-completion-function
938 "scp" tramp-completion-function-alist-ssh)
939 (tramp-set-completion-function
940 "scp1" tramp-completion-function-alist-ssh)
941 (tramp-set-completion-function
942 "scp2" tramp-completion-function-alist-ssh)
943 (tramp-set-completion-function
944 "scp1_old" tramp-completion-function-alist-ssh)
945 (tramp-set-completion-function
946 "scp2_old" tramp-completion-function-alist-ssh)
947 (tramp-set-completion-function
948 "rsync" tramp-completion-function-alist-ssh)
949 (tramp-set-completion-function
950 "rsyncc" tramp-completion-function-alist-ssh)
951 (tramp-set-completion-function
952 "remcp" tramp-completion-function-alist-rsh)
953 (tramp-set-completion-function
954 "rsh" tramp-completion-function-alist-rsh)
955 (tramp-set-completion-function
956 "ssh" tramp-completion-function-alist-ssh)
957 (tramp-set-completion-function
958 "ssh1" tramp-completion-function-alist-ssh)
959 (tramp-set-completion-function
960 "ssh2" tramp-completion-function-alist-ssh)
961 (tramp-set-completion-function
962 "ssh1_old" tramp-completion-function-alist-ssh)
963 (tramp-set-completion-function
964 "ssh2_old" tramp-completion-function-alist-ssh)
965 (tramp-set-completion-function
966 "remsh" tramp-completion-function-alist-rsh)
967 (tramp-set-completion-function
968 "telnet" tramp-completion-function-alist-telnet)
969 (tramp-set-completion-function
970 "su" tramp-completion-function-alist-su)
971 (tramp-set-completion-function
972 "sudo" tramp-completion-function-alist-su)
973 (tramp-set-completion-function
974 "scpx" tramp-completion-function-alist-ssh)
975 (tramp-set-completion-function
976 "sshx" tramp-completion-function-alist-ssh)
977 (tramp-set-completion-function
978 "krlogin" tramp-completion-function-alist-rsh)
979 (tramp-set-completion-function
980 "plink" tramp-completion-function-alist-ssh)
981 (tramp-set-completion-function
982 "plink1" tramp-completion-function-alist-ssh)
983 (tramp-set-completion-function
984 "plinkx" tramp-completion-function-alist-putty)
985 (tramp-set-completion-function
986 "pscp" tramp-completion-function-alist-ssh)
987 (tramp-set-completion-function
988 "fcp" tramp-completion-function-alist-ssh)))
989
990(defconst tramp-echo-mark-marker "_echo" 412(defconst tramp-echo-mark-marker "_echo"
991 "String marker to surround echoed commands.") 413 "String marker to surround echoed commands.")
992 414
@@ -1035,55 +457,6 @@ The default value is to use the same value as `tramp-rsh-end-of-line'."
1035 :group 'tramp 457 :group 'tramp
1036 :type 'string) 458 :type 'string)
1037 459
1038;; "getconf PATH" yields:
1039;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
1040;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
1041;; GNU/Linux (Debian, Suse): /bin:/usr/bin
1042;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
1043;; IRIX64: /usr/bin
1044(defcustom tramp-remote-path
1045 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
1046 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
1047 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
1048 "*List of directories to search for executables on remote host.
1049For every remote host, this variable will be set buffer local,
1050keeping the list of existing directories on that host.
1051
1052You can use `~' in this list, but when searching for a shell which groks
1053tilde expansion, all directory names starting with `~' will be ignored.
1054
1055`Default Directories' represent the list of directories given by
1056the command \"getconf PATH\". It is recommended to use this
1057entry on top of this list, because these are the default
1058directories for POSIX compatible commands.
1059
1060`Private Directories' are the settings of the $PATH environment,
1061as given in your `~/.profile'."
1062 :group 'tramp
1063 :type '(repeat (choice
1064 (const :tag "Default Directories" tramp-default-remote-path)
1065 (const :tag "Private Directories" tramp-own-remote-path)
1066 (string :tag "Directory"))))
1067
1068(defcustom tramp-remote-process-environment
1069 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
1070 ,(format "TERM=%s" tramp-terminal-type)
1071 "EMACS=t" ;; Deprecated.
1072 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
1073 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
1074 "autocorrect=" "correct=")
1075
1076 "*List of environment variables to be set on the remote host.
1077
1078Each element should be a string of the form ENVVARNAME=VALUE. An
1079entry ENVVARNAME= diables the corresponding environment variable,
1080which might have been set in the init files like ~/.profile.
1081
1082Special handling is applied to the PATH environment, which should
1083not be set here. Instead of, it should be set via `tramp-remote-path'."
1084 :group 'tramp
1085 :type '(repeat string))
1086
1087(defcustom tramp-login-prompt-regexp 460(defcustom tramp-login-prompt-regexp
1088 ".*ogin\\( .*\\)?: *" 461 ".*ogin\\( .*\\)?: *"
1089 "*Regexp matching login-like prompts. 462 "*Regexp matching login-like prompts.
@@ -1211,15 +584,13 @@ The answer will be provided by `tramp-action-process-alive',
1211 :group 'tramp 584 :group 'tramp
1212 :type 'regexp) 585 :type 'regexp)
1213 586
1214(defcustom tramp-temp-name-prefix "tramp." 587(defconst tramp-temp-name-prefix "tramp."
1215 "*Prefix to use for temporary files. 588 "*Prefix to use for temporary files.
1216If this is a relative file name (such as \"tramp.\"), it is considered 589If this is a relative file name (such as \"tramp.\"), it is considered
1217relative to the directory name returned by the function 590relative to the directory name returned by the function
1218`tramp-compat-temporary-file-directory' (which see). It may also be an 591`tramp-compat-temporary-file-directory' (which see). It may also be an
1219absolute file name; don't forget to include a prefix for the filename 592absolute file name; don't forget to include a prefix for the filename
1220part, though." 593part, though.")
1221 :group 'tramp
1222 :type 'string)
1223 594
1224(defconst tramp-temp-buffer-name " *tramp temp*" 595(defconst tramp-temp-buffer-name " *tramp temp*"
1225 "Buffer name for a temporary buffer. 596 "Buffer name for a temporary buffer.
@@ -1230,22 +601,6 @@ It shall be used in combination with `generate-new-buffer-name'.")
1230Useful for \"rsync\" like methods.") 601Useful for \"rsync\" like methods.")
1231(make-variable-buffer-local 'tramp-temp-buffer-file-name) 602(make-variable-buffer-local 'tramp-temp-buffer-file-name)
1232 603
1233(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
1234 "*Alist specifying extra arguments to pass to the remote shell.
1235Entries are (REGEXP . ARGS) where REGEXP is a regular expression
1236matching the shell file name and ARGS is a string specifying the
1237arguments.
1238
1239This variable is only used when Tramp needs to start up another shell
1240for tilde expansion. The extra arguments should typically prevent the
1241shell from reading its init file."
1242 :group 'tramp
1243 ;; This might be the wrong way to test whether the widget type
1244 ;; `alist' is available. Who knows the right way to test it?
1245 :type (if (get 'alist 'widget-type)
1246 '(alist :key-type string :value-type string)
1247 '(repeat (cons string string))))
1248
1249;; XEmacs is distributed with few Lisp packages. Further packages are 604;; XEmacs is distributed with few Lisp packages. Further packages are
1250;; installed using EFS. If we use a unified filename format, then 605;; installed using EFS. If we use a unified filename format, then
1251;; Tramp is required in addition to EFS. (But why can't Tramp just 606;; Tramp is required in addition to EFS. (But why can't Tramp just
@@ -1304,8 +659,7 @@ Used in `tramp-make-tramp-file-name'.")
1304 "*Regexp matching delimeter between method and user or host names. 659 "*Regexp matching delimeter between method and user or host names.
1305Derived from `tramp-postfix-method-format'.") 660Derived from `tramp-postfix-method-format'.")
1306 661
1307(defconst tramp-user-regexp 662(defconst tramp-user-regexp "[^:/ \t]+"
1308 "[^:/ \t]+"
1309 "*Regexp matching user names.") 663 "*Regexp matching user names.")
1310 664
1311(defconst tramp-prefix-domain-format "%" 665(defconst tramp-prefix-domain-format "%"
@@ -1316,8 +670,7 @@ Derived from `tramp-postfix-method-format'.")
1316 "*Regexp matching delimeter between user and domain names. 670 "*Regexp matching delimeter between user and domain names.
1317Derived from `tramp-prefix-domain-format'.") 671Derived from `tramp-prefix-domain-format'.")
1318 672
1319(defconst tramp-domain-regexp 673(defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+"
1320 "[-a-zA-Z0-9_.]+"
1321 "*Regexp matching domain names.") 674 "*Regexp matching domain names.")
1322 675
1323(defconst tramp-user-with-domain-regexp 676(defconst tramp-user-with-domain-regexp
@@ -1326,8 +679,7 @@ Derived from `tramp-prefix-domain-format'.")
1326 "\\(" tramp-domain-regexp "\\)") 679 "\\(" tramp-domain-regexp "\\)")
1327 "*Regexp matching user names with domain names.") 680 "*Regexp matching user names with domain names.")
1328 681
1329(defconst tramp-postfix-user-format 682(defconst tramp-postfix-user-format "@"
1330 "@"
1331 "*String matching delimeter between user and host names. 683 "*String matching delimeter between user and host names.
1332Used in `tramp-make-tramp-file-name'.") 684Used in `tramp-make-tramp-file-name'.")
1333 685
@@ -1336,8 +688,7 @@ Used in `tramp-make-tramp-file-name'.")
1336 "*Regexp matching delimeter between user and host names. 688 "*Regexp matching delimeter between user and host names.
1337Derived from `tramp-postfix-user-format'.") 689Derived from `tramp-postfix-user-format'.")
1338 690
1339(defconst tramp-host-regexp 691(defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
1340 "[a-zA-Z0-9_.-]+"
1341 "*Regexp matching host names.") 692 "*Regexp matching host names.")
1342 693
1343(defconst tramp-prefix-ipv6-format 694(defconst tramp-prefix-ipv6-format
@@ -1385,8 +736,7 @@ Derived from `tramp-postfix-ipv6-format'.")
1385 "*Regexp matching delimeter between host names and port numbers. 736 "*Regexp matching delimeter between host names and port numbers.
1386Derived from `tramp-prefix-port-format'.") 737Derived from `tramp-prefix-port-format'.")
1387 738
1388(defconst tramp-port-regexp 739(defconst tramp-port-regexp "[0-9]+"
1389 "[0-9]+"
1390 "*Regexp matching port numbers.") 740 "*Regexp matching port numbers.")
1391 741
1392(defconst tramp-host-with-port-regexp 742(defconst tramp-host-with-port-regexp
@@ -1408,8 +758,7 @@ Used in `tramp-make-tramp-file-name'.")
1408 "*Regexp matching delimeter between host names and localnames. 758 "*Regexp matching delimeter between host names and localnames.
1409Derived from `tramp-postfix-host-format'.") 759Derived from `tramp-postfix-host-format'.")
1410 760
1411(defconst tramp-localname-regexp 761(defconst tramp-localname-regexp ".*$"
1412 ".*$"
1413 "*Regexp matching localnames.") 762 "*Regexp matching localnames.")
1414 763
1415;; File name format. 764;; File name format.
@@ -1457,15 +806,13 @@ Tramp. See `tramp-file-name-structure' for more explanations.
1457On W32 systems, the volume letter must be ignored.") 806On W32 systems, the volume letter must be ignored.")
1458 807
1459;;;###autoload 808;;;###autoload
1460(defconst tramp-file-name-regexp-separate 809(defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]"
1461 "\\`/\\[.*\\]"
1462 "Value for `tramp-file-name-regexp' for separate remoting. 810 "Value for `tramp-file-name-regexp' for separate remoting.
1463XEmacs uses a separate filename syntax for Tramp and EFS. 811XEmacs uses a separate filename syntax for Tramp and EFS.
1464See `tramp-file-name-structure' for more explanations.") 812See `tramp-file-name-structure' for more explanations.")
1465 813
1466;;;###autoload 814;;;###autoload
1467(defconst tramp-file-name-regexp-url 815(defconst tramp-file-name-regexp-url "\\`/[^/:]+://"
1468 "\\`/[^/:]+://"
1469 "Value for `tramp-file-name-regexp' for URL-like remoting. 816 "Value for `tramp-file-name-regexp' for URL-like remoting.
1470See `tramp-file-name-structure' for more explanations.") 817See `tramp-file-name-structure' for more explanations.")
1471 818
@@ -1539,38 +886,6 @@ updated after changing this variable.
1539 886
1540Also see `tramp-file-name-structure'.") 887Also see `tramp-file-name-structure'.")
1541 888
1542(defconst tramp-actions-before-shell
1543 '((tramp-login-prompt-regexp tramp-action-login)
1544 (tramp-password-prompt-regexp tramp-action-password)
1545 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1546 (shell-prompt-pattern tramp-action-succeed)
1547 (tramp-shell-prompt-pattern tramp-action-succeed)
1548 (tramp-yesno-prompt-regexp tramp-action-yesno)
1549 (tramp-yn-prompt-regexp tramp-action-yn)
1550 (tramp-terminal-prompt-regexp tramp-action-terminal)
1551 (tramp-process-alive-regexp tramp-action-process-alive))
1552 "List of pattern/action pairs.
1553Whenever a pattern matches, the corresponding action is performed.
1554Each item looks like (PATTERN ACTION).
1555
1556The PATTERN should be a symbol, a variable. The value of this
1557variable gives the regular expression to search for. Note that the
1558regexp must match at the end of the buffer, \"\\'\" is implicitly
1559appended to it.
1560
1561The ACTION should also be a symbol, but a function. When the
1562corresponding PATTERN matches, the ACTION function is called.")
1563
1564(defconst tramp-actions-copy-out-of-band
1565 '((tramp-password-prompt-regexp tramp-action-password)
1566 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1567 (tramp-copy-failed-regexp tramp-action-permission-denied)
1568 (tramp-process-alive-regexp tramp-action-out-of-band))
1569 "List of pattern/action pairs.
1570This list is used for copying/renaming with out-of-band methods.
1571
1572See `tramp-actions-before-shell' for more info.")
1573
1574;; Chunked sending kludge. We set this to 500 for black-listed constellations 889;; Chunked sending kludge. We set this to 500 for black-listed constellations
1575;; known to have a bug in `process-send-string'; some ssh connections appear 890;; known to have a bug in `process-send-string'; some ssh connections appear
1576;; to drop bytes when data is sent too quickly. There is also a connection 891;; to drop bytes when data is sent too quickly. There is also a connection
@@ -1676,437 +991,273 @@ means to use always cached values for the directory contents."
1676(defvar tramp-current-host nil 991(defvar tramp-current-host nil
1677 "Remote host for this *tramp* buffer.") 992 "Remote host for this *tramp* buffer.")
1678 993
1679(defconst tramp-uudecode
1680 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1681cat /tmp/tramp.$$
1682rm -f /tmp/tramp.$$"
1683 "Shell function to implement `uudecode' to standard output.
1684Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
1685for this or `uudecode -p', but some systems don't, and for them
1686we have this shell function.")
1687
1688(defconst tramp-perl-file-truename
1689 "%s -e '
1690use File::Spec;
1691use Cwd \"realpath\";
1692
1693sub recursive {
1694 my ($volume, @dirs) = @_;
1695 my $real = realpath(File::Spec->catpath(
1696 $volume, File::Spec->catdir(@dirs), \"\"));
1697 if ($real) {
1698 my ($vol, $dir) = File::Spec->splitpath($real, 1);
1699 return ($vol, File::Spec->splitdir($dir));
1700 }
1701 else {
1702 my $last = pop(@dirs);
1703 ($volume, @dirs) = recursive($volume, @dirs);
1704 push(@dirs, $last);
1705 return ($volume, @dirs);
1706 }
1707}
1708
1709$result = realpath($ARGV[0]);
1710if (!$result) {
1711 my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
1712 ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
1713
1714 $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
1715}
1716
1717if ($ARGV[0] =~ /\\/$/) {
1718 $result = $result . \"/\";
1719}
1720
1721print \"\\\"$result\\\"\\n\";
1722' \"$1\" 2>/dev/null"
1723 "Perl script to produce output suitable for use with `file-truename'
1724on the remote file system.
1725Escape sequence %s is replaced with name of Perl binary.
1726This string is passed to `format', so percent characters need to be doubled.")
1727
1728(defconst tramp-perl-file-name-all-completions
1729 "%s -e 'sub case {
1730 my $str = shift;
1731 if ($ARGV[2]) {
1732 return lc($str);
1733 }
1734 else {
1735 return $str;
1736 }
1737}
1738opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
1739@files = readdir(d); closedir(d);
1740foreach $f (@files) {
1741 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
1742 if (-d \"$ARGV[0]/$f\") {
1743 print \"$f/\\n\";
1744 }
1745 else {
1746 print \"$f\\n\";
1747 }
1748 }
1749}
1750print \"ok\\n\"
1751' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1752 "Perl script to produce output suitable for use with
1753`file-name-all-completions' on the remote file system. Escape
1754sequence %s is replaced with name of Perl binary. This string is
1755passed to `format', so percent characters need to be doubled.")
1756
1757;; Perl script to implement `file-attributes' in a Lisp `read'able
1758;; output. If you are hacking on this, note that you get *no* output
1759;; unless this spits out a complete line, including the '\n' at the
1760;; end.
1761;; The device number is returned as "-1", because there will be a virtual
1762;; device number set in `tramp-handle-file-attributes'.
1763(defconst tramp-perl-file-attributes
1764 "%s -e '
1765@stat = lstat($ARGV[0]);
1766if (!@stat) {
1767 print \"nil\\n\";
1768 exit 0;
1769}
1770if (($stat[2] & 0170000) == 0120000)
1771{
1772 $type = readlink($ARGV[0]);
1773 $type = \"\\\"$type\\\"\";
1774}
1775elsif (($stat[2] & 0170000) == 040000)
1776{
1777 $type = \"t\";
1778}
1779else
1780{
1781 $type = \"nil\"
1782};
1783$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1784$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1785printf(
1786 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\",
1787 $type,
1788 $stat[3],
1789 $uid,
1790 $gid,
1791 $stat[8] >> 16 & 0xffff,
1792 $stat[8] & 0xffff,
1793 $stat[9] >> 16 & 0xffff,
1794 $stat[9] & 0xffff,
1795 $stat[10] >> 16 & 0xffff,
1796 $stat[10] & 0xffff,
1797 $stat[7],
1798 $stat[2],
1799 $stat[1] >> 16 & 0xffff,
1800 $stat[1] & 0xffff
1801);' \"$1\" \"$2\" 2>/dev/null"
1802 "Perl script to produce output suitable for use with `file-attributes'
1803on the remote file system.
1804Escape sequence %s is replaced with name of Perl binary.
1805This string is passed to `format', so percent characters need to be doubled.")
1806
1807(defconst tramp-perl-directory-files-and-attributes
1808 "%s -e '
1809chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
1810opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
1811@list = readdir(DIR);
1812closedir(DIR);
1813$n = scalar(@list);
1814printf(\"(\\n\");
1815for($i = 0; $i < $n; $i++)
1816{
1817 $filename = $list[$i];
1818 @stat = lstat($filename);
1819 if (($stat[2] & 0170000) == 0120000)
1820 {
1821 $type = readlink($filename);
1822 $type = \"\\\"$type\\\"\";
1823 }
1824 elsif (($stat[2] & 0170000) == 040000)
1825 {
1826 $type = \"t\";
1827 }
1828 else
1829 {
1830 $type = \"nil\"
1831 };
1832 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1833 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1834 printf(
1835 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
1836 $filename,
1837 $type,
1838 $stat[3],
1839 $uid,
1840 $gid,
1841 $stat[8] >> 16 & 0xffff,
1842 $stat[8] & 0xffff,
1843 $stat[9] >> 16 & 0xffff,
1844 $stat[9] & 0xffff,
1845 $stat[10] >> 16 & 0xffff,
1846 $stat[10] & 0xffff,
1847 $stat[7],
1848 $stat[2],
1849 $stat[1] >> 16 & 0xffff,
1850 $stat[1] & 0xffff,
1851 $stat[0] >> 16 & 0xffff,
1852 $stat[0] & 0xffff);
1853}
1854printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
1855 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1856output.
1857Escape sequence %s is replaced with name of Perl binary.
1858This string is passed to `format', so percent characters need to be doubled.")
1859
1860;; ;; These two use uu encoding.
1861;; (defvar tramp-perl-encode "%s -e'\
1862;; print qq(begin 644 xxx\n);
1863;; my $s = q();
1864;; my $res = q();
1865;; while (read(STDIN, $s, 45)) {
1866;; print pack(q(u), $s);
1867;; }
1868;; print qq(`\n);
1869;; print qq(end\n);
1870;; '"
1871;; "Perl program to use for encoding a file.
1872;; Escape sequence %s is replaced with name of Perl binary.")
1873
1874;; (defvar tramp-perl-decode "%s -ne '
1875;; print unpack q(u), $_;
1876;; '"
1877;; "Perl program to use for decoding a file.
1878;; Escape sequence %s is replaced with name of Perl binary.")
1879
1880;; These two use base64 encoding.
1881(defconst tramp-perl-encode-with-module
1882 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
1883 "Perl program to use for encoding a file.
1884Escape sequence %s is replaced with name of Perl binary.
1885This string is passed to `format', so percent characters need to be doubled.
1886This implementation requires the MIME::Base64 Perl module to be installed
1887on the remote host.")
1888
1889(defconst tramp-perl-decode-with-module
1890 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
1891 "Perl program to use for decoding a file.
1892Escape sequence %s is replaced with name of Perl binary.
1893This string is passed to `format', so percent characters need to be doubled.
1894This implementation requires the MIME::Base64 Perl module to be installed
1895on the remote host.")
1896
1897(defconst tramp-perl-encode
1898 "%s -e '
1899# This script contributed by Juanma Barranquero <lektu@terra.es>.
1900# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
1901# Free Software Foundation, Inc.
1902use strict;
1903
1904my %%trans = do {
1905 my $i = 0;
1906 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
1907 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
1908};
1909
1910binmode(\\*STDIN);
1911
1912# We read in chunks of 54 bytes, to generate output lines
1913# of 72 chars (plus end of line)
1914$/ = \\54;
1915
1916while (my $data = <STDIN>) {
1917 my $pad = q();
1918
1919 # Only for the last chunk, and only if did not fill the last three-byte packet
1920 if (eof) {
1921 my $mod = length($data) %% 3;
1922 $pad = q(=) x (3 - $mod) if $mod;
1923 }
1924
1925 # Not the fastest method, but it is simple: unpack to binary string, split
1926 # by groups of 6 bits and convert back from binary to byte; then map into
1927 # the translation table
1928 print
1929 join q(),
1930 map($trans{$_},
1931 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1932 $pad,
1933 qq(\\n);
1934}' 2>/dev/null"
1935 "Perl program to use for encoding a file.
1936Escape sequence %s is replaced with name of Perl binary.
1937This string is passed to `format', so percent characters need to be doubled.")
1938
1939(defconst tramp-perl-decode
1940 "%s -e '
1941# This script contributed by Juanma Barranquero <lektu@terra.es>.
1942# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
1943# Free Software Foundation, Inc.
1944use strict;
1945
1946my %%trans = do {
1947 my $i = 0;
1948 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
1949 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
1950};
1951
1952my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
1953
1954binmode(\\*STDOUT);
1955
1956# We are going to accumulate into $pending to accept any line length
1957# (we do not check they are <= 76 chars as the RFC says)
1958my $pending = q();
1959
1960while (my $data = <STDIN>) {
1961 chomp $data;
1962
1963 # If we find one or two =, we have reached the end and
1964 # any following data is to be discarded
1965 my $finished = $data =~ s/(==?).*/$1/;
1966 $pending .= $data;
1967
1968 my $len = length($pending);
1969 my $chunk = substr($pending, 0, $len & ~3);
1970 $pending = substr($pending, $len & ~3 + 1);
1971
1972 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
1973 # split in 8-bit chunks and convert back to char.
1974 print join q(),
1975 map $bytes{$_},
1976 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1977
1978 last if $finished;
1979}' 2>/dev/null"
1980 "Perl program to use for decoding a file.
1981Escape sequence %s is replaced with name of Perl binary.
1982This string is passed to `format', so percent characters need to be doubled.")
1983
1984(defconst tramp-vc-registered-read-file-names
1985 "echo \"(\"
1986while read file; do
1987 if %s \"$file\"; then
1988 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
1989 else
1990 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
1991 fi
1992 if %s \"$file\"; then
1993 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
1994 else
1995 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
1996 fi
1997done
1998echo \")\""
1999 "Script to check existence of VC related files.
2000It must be send formatted with two strings; the tests for file
2001existence, and file readability. Input shall be read via
2002here-document, otherwise the command could exceed maximum length
2003of command line.")
2004
2005(defconst tramp-file-mode-type-map
2006 '((0 . "-") ; Normal file (SVID-v2 and XPG2)
2007 (1 . "p") ; fifo
2008 (2 . "c") ; character device
2009 (3 . "m") ; multiplexed character device (v7)
2010 (4 . "d") ; directory
2011 (5 . "?") ; Named special file (XENIX)
2012 (6 . "b") ; block device
2013 (7 . "?") ; multiplexed block device (v7)
2014 (8 . "-") ; regular file
2015 (9 . "n") ; network special file (HP-UX)
2016 (10 . "l") ; symlink
2017 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
2018 (12 . "s") ; socket
2019 (13 . "D") ; door special (Solaris)
2020 (14 . "w")) ; whiteout (BSD)
2021 "A list of file types returned from the `stat' system call.
2022This is used to map a mode number to a permission string.")
2023
2024;; New handlers should be added here. The following operations can be
2025;; handled using the normal primitives: file-name-sans-versions,
2026;; get-file-buffer.
2027(defconst tramp-file-name-handler-alist
2028 '((load . tramp-handle-load)
2029 (make-symbolic-link . tramp-handle-make-symbolic-link)
2030 (file-name-as-directory . tramp-handle-file-name-as-directory)
2031 (file-name-directory . tramp-handle-file-name-directory)
2032 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
2033 (file-truename . tramp-handle-file-truename)
2034 (file-exists-p . tramp-handle-file-exists-p)
2035 (file-directory-p . tramp-handle-file-directory-p)
2036 (file-executable-p . tramp-handle-file-executable-p)
2037 (file-readable-p . tramp-handle-file-readable-p)
2038 (file-regular-p . tramp-handle-file-regular-p)
2039 (file-symlink-p . tramp-handle-file-symlink-p)
2040 (file-writable-p . tramp-handle-file-writable-p)
2041 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
2042 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
2043 (file-attributes . tramp-handle-file-attributes)
2044 (file-modes . tramp-handle-file-modes)
2045 (directory-files . tramp-handle-directory-files)
2046 (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
2047 (file-name-all-completions . tramp-handle-file-name-all-completions)
2048 (file-name-completion . tramp-handle-file-name-completion)
2049 (add-name-to-file . tramp-handle-add-name-to-file)
2050 (copy-file . tramp-handle-copy-file)
2051 (copy-directory . tramp-handle-copy-directory)
2052 (rename-file . tramp-handle-rename-file)
2053 (set-file-modes . tramp-handle-set-file-modes)
2054 (set-file-times . tramp-handle-set-file-times)
2055 (make-directory . tramp-handle-make-directory)
2056 (delete-directory . tramp-handle-delete-directory)
2057 (delete-file . tramp-handle-delete-file)
2058 (directory-file-name . tramp-handle-directory-file-name)
2059 ;; `executable-find' is not official yet.
2060 (executable-find . tramp-handle-executable-find)
2061 (start-file-process . tramp-handle-start-file-process)
2062 (process-file . tramp-handle-process-file)
2063 (shell-command . tramp-handle-shell-command)
2064 (insert-directory . tramp-handle-insert-directory)
2065 (expand-file-name . tramp-handle-expand-file-name)
2066 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
2067 (file-local-copy . tramp-handle-file-local-copy)
2068 (file-remote-p . tramp-handle-file-remote-p)
2069 (insert-file-contents . tramp-handle-insert-file-contents)
2070 (insert-file-contents-literally
2071 . tramp-handle-insert-file-contents-literally)
2072 (write-region . tramp-handle-write-region)
2073 (find-backup-file-name . tramp-handle-find-backup-file-name)
2074 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
2075 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
2076 (dired-compress-file . tramp-handle-dired-compress-file)
2077 (dired-recursive-delete-directory
2078 . tramp-handle-dired-recursive-delete-directory)
2079 (dired-uncache . tramp-handle-dired-uncache)
2080 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
2081 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
2082 (file-selinux-context . tramp-handle-file-selinux-context)
2083 (set-file-selinux-context . tramp-handle-set-file-selinux-context)
2084 (vc-registered . tramp-handle-vc-registered))
2085 "Alist of handler functions.
2086Operations not mentioned here will be handled by the normal Emacs functions.")
2087
2088;; Handlers for partial Tramp file names. For Emacs just
2089;; `file-name-all-completions' is needed.
2090;;;###autoload 994;;;###autoload
2091(defconst tramp-completion-file-name-handler-alist 995(defconst tramp-completion-file-name-handler-alist
2092 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) 996 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
2093 (file-name-completion . tramp-completion-handle-file-name-completion)) 997 (file-name-completion . tramp-completion-handle-file-name-completion))
2094 "Alist of completion handler functions. 998 "Alist of completion handler functions.
2095Used for file names matching `tramp-file-name-regexp'. Operations not 999Used for file names matching `tramp-file-name-regexp'. Operations
2096mentioned here will be handled by `tramp-file-name-handler-alist' or the 1000not mentioned here will be handled by Tramp's file name handler
2097normal Emacs functions.") 1001functions, or the normal Emacs functions.")
2098 1002
2099;; Handlers for foreign methods, like FTP or SMB, shall be plugged here. 1003;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
2100(defvar tramp-foreign-file-name-handler-alist 1004;;;###tramp-autoload
2101 ;; (identity . tramp-sh-file-name-handler) should always be the last 1005(defvar tramp-foreign-file-name-handler-alist nil
2102 ;; entry, because `identity' always matches.
2103 '((identity . tramp-sh-file-name-handler))
2104 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially. 1006 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
2105If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by 1007If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
2106calling HANDLER.") 1008calling HANDLER.")
2107 1009
2108;;; Internal functions which must come first: 1010;;; Internal functions which must come first:
2109 1011
1012
1013;; ------------------------------------------------------------
1014;; -- Tramp file names --
1015;; ------------------------------------------------------------
1016;; Conversion functions between external representation and
1017;; internal data structure. Convenience functions for internal
1018;; data structure.
1019
1020(defun tramp-file-name-p (vec)
1021 "Check, whether VEC is a Tramp object."
1022 (and (vectorp vec) (= 4 (length vec))))
1023
1024(defun tramp-file-name-method (vec)
1025 "Return method component of VEC."
1026 (and (tramp-file-name-p vec) (aref vec 0)))
1027
1028(defun tramp-file-name-user (vec)
1029 "Return user component of VEC."
1030 (and (tramp-file-name-p vec) (aref vec 1)))
1031
1032(defun tramp-file-name-host (vec)
1033 "Return host component of VEC."
1034 (and (tramp-file-name-p vec) (aref vec 2)))
1035
1036(defun tramp-file-name-localname (vec)
1037 "Return localname component of VEC."
1038 (and (tramp-file-name-p vec) (aref vec 3)))
1039
1040;; The user part of a Tramp file name vector can be of kind
1041;; "user%domain". Sometimes, we must extract these parts.
1042(defun tramp-file-name-real-user (vec)
1043 "Return the user name of VEC without domain."
1044 (save-match-data
1045 (let ((user (tramp-file-name-user vec)))
1046 (if (and (stringp user)
1047 (string-match tramp-user-with-domain-regexp user))
1048 (match-string 1 user)
1049 user))))
1050
1051(defun tramp-file-name-domain (vec)
1052 "Return the domain name of VEC."
1053 (save-match-data
1054 (let ((user (tramp-file-name-user vec)))
1055 (and (stringp user)
1056 (string-match tramp-user-with-domain-regexp user)
1057 (match-string 2 user)))))
1058
1059;; The host part of a Tramp file name vector can be of kind
1060;; "host#port". Sometimes, we must extract these parts.
1061(defun tramp-file-name-real-host (vec)
1062 "Return the host name of VEC without port."
1063 (save-match-data
1064 (let ((host (tramp-file-name-host vec)))
1065 (if (and (stringp host)
1066 (string-match tramp-host-with-port-regexp host))
1067 (match-string 1 host)
1068 host))))
1069
1070(defun tramp-file-name-port (vec)
1071 "Return the port number of VEC."
1072 (save-match-data
1073 (let ((host (tramp-file-name-host vec)))
1074 (and (stringp host)
1075 (string-match tramp-host-with-port-regexp host)
1076 (string-to-number (match-string 2 host))))))
1077
1078;;;###tramp-autoload
1079(defun tramp-tramp-file-p (name)
1080 "Return t if NAME is a string with Tramp file name syntax."
1081 (save-match-data
1082 (and (stringp name) (string-match tramp-file-name-regexp name))))
1083
1084(defun tramp-find-method (method user host)
1085 "Return the right method string to use.
1086This is METHOD, if non-nil. Otherwise, do a lookup in
1087`tramp-default-method-alist'."
1088 (or method
1089 (let ((choices tramp-default-method-alist)
1090 lmethod item)
1091 (while choices
1092 (setq item (pop choices))
1093 (when (and (string-match (or (nth 0 item) "") (or host ""))
1094 (string-match (or (nth 1 item) "") (or user "")))
1095 (setq lmethod (nth 2 item))
1096 (setq choices nil)))
1097 lmethod)
1098 tramp-default-method))
1099
1100(defun tramp-find-user (method user host)
1101 "Return the right user string to use.
1102This is USER, if non-nil. Otherwise, do a lookup in
1103`tramp-default-user-alist'."
1104 (or user
1105 (let ((choices tramp-default-user-alist)
1106 luser item)
1107 (while choices
1108 (setq item (pop choices))
1109 (when (and (string-match (or (nth 0 item) "") (or method ""))
1110 (string-match (or (nth 1 item) "") (or host "")))
1111 (setq luser (nth 2 item))
1112 (setq choices nil)))
1113 luser)
1114 tramp-default-user))
1115
1116(defun tramp-find-host (method user host)
1117 "Return the right host string to use.
1118This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
1119 (or (and (> (length host) 0) host)
1120 tramp-default-host))
1121
1122(defun tramp-dissect-file-name (name &optional nodefault)
1123 "Return a `tramp-file-name' structure.
1124The structure consists of remote method, remote user, remote host
1125and localname (file name on remote host). If NODEFAULT is
1126non-nil, the file name parts are not expanded to their default
1127values."
1128 (save-match-data
1129 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
1130 (unless match (error "Not a Tramp file name: %s" name))
1131 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
1132 (user (match-string (nth 2 tramp-file-name-structure) name))
1133 (host (match-string (nth 3 tramp-file-name-structure) name))
1134 (localname (match-string (nth 4 tramp-file-name-structure) name)))
1135 (when host
1136 (when (string-match tramp-prefix-ipv6-regexp host)
1137 (setq host (replace-match "" nil t host)))
1138 (when (string-match tramp-postfix-ipv6-regexp host)
1139 (setq host (replace-match "" nil t host))))
1140 (if nodefault
1141 (vector method user host localname)
1142 (vector
1143 (tramp-find-method method user host)
1144 (tramp-find-user method user host)
1145 (tramp-find-host method user host)
1146 localname))))))
1147
1148(defun tramp-buffer-name (vec)
1149 "A name for the connection buffer VEC."
1150 ;; We must use `tramp-file-name-real-host', because for gateway
1151 ;; methods the default port will be expanded later on, which would
1152 ;; tamper the name.
1153 (let ((method (tramp-file-name-method vec))
1154 (user (tramp-file-name-user vec))
1155 (host (tramp-file-name-real-host vec)))
1156 (if (not (zerop (length user)))
1157 (format "*tramp/%s %s@%s*" method user host)
1158 (format "*tramp/%s %s*" method host))))
1159
1160(defun tramp-make-tramp-file-name (method user host localname)
1161 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
1162 (concat tramp-prefix-format
1163 (when (not (zerop (length method)))
1164 (concat method tramp-postfix-method-format))
1165 (when (not (zerop (length user)))
1166 (concat user tramp-postfix-user-format))
1167 (when host
1168 (if (string-match tramp-ipv6-regexp host)
1169 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
1170 host))
1171 tramp-postfix-host-format
1172 (when localname localname)))
1173
1174(defun tramp-completion-make-tramp-file-name (method user host localname)
1175 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
1176It must not be a complete Tramp file name, but as long as there are
1177necessary only. This function will be used in file name completion."
1178 (concat tramp-prefix-format
1179 (when (not (zerop (length method)))
1180 (concat method tramp-postfix-method-format))
1181 (when (not (zerop (length user)))
1182 (concat user tramp-postfix-user-format))
1183 (when (not (zerop (length host)))
1184 (concat
1185 (if (string-match tramp-ipv6-regexp host)
1186 (concat
1187 tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
1188 host)
1189 tramp-postfix-host-format))
1190 (when localname localname)))
1191
1192(defun tramp-get-buffer (vec)
1193 "Get the connection buffer to be used for VEC."
1194 (or (get-buffer (tramp-buffer-name vec))
1195 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
1196 (setq buffer-undo-list t)
1197 (setq default-directory
1198 (tramp-make-tramp-file-name
1199 (tramp-file-name-method vec)
1200 (tramp-file-name-user vec)
1201 (tramp-file-name-host vec)
1202 "/"))
1203 (current-buffer))))
1204
1205(defun tramp-get-connection-buffer (vec)
1206 "Get the connection buffer to be used for VEC.
1207In case a second asynchronous communication has been started, it is different
1208from `tramp-get-buffer'."
1209 (or (tramp-get-connection-property vec "process-buffer" nil)
1210 (tramp-get-buffer vec)))
1211
1212(defun tramp-get-connection-process (vec)
1213 "Get the connection process to be used for VEC.
1214In case a second asynchronous communication has been started, it is different
1215from the default one."
1216 (get-process
1217 (or (tramp-get-connection-property vec "process-name" nil)
1218 (tramp-buffer-name vec))))
1219
1220(defun tramp-debug-buffer-name (vec)
1221 "A name for the debug buffer for VEC."
1222 ;; We must use `tramp-file-name-real-host', because for gateway
1223 ;; methods the default port will be expanded later on, which would
1224 ;; tamper the name.
1225 (let ((method (tramp-file-name-method vec))
1226 (user (tramp-file-name-user vec))
1227 (host (tramp-file-name-real-host vec)))
1228 (if (not (zerop (length user)))
1229 (format "*debug tramp/%s %s@%s*" method user host)
1230 (format "*debug tramp/%s %s*" method host))))
1231
1232(defconst tramp-debug-outline-regexp
1233 "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #"
1234 "Used for highlighting Tramp debug buffers in `outline-mode'.")
1235
1236(defun tramp-debug-outline-level ()
1237 "Return the depth to which a statement is nested in the outline.
1238Point must be at the beginning of a header line.
1239
1240The outline level is equal to the verbosity of the Tramp message."
1241 (1+ (string-to-number (match-string 1))))
1242
1243(defun tramp-get-debug-buffer (vec)
1244 "Get the debug buffer for VEC."
1245 (with-current-buffer
1246 (get-buffer-create (tramp-debug-buffer-name vec))
1247 (when (bobp)
1248 (setq buffer-undo-list t)
1249 ;; Activate `outline-mode'. This runs `text-mode-hook' and
1250 ;; `outline-mode-hook'. We must prevent that local processes
1251 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
1252 ;; Furthermore, `outline-regexp' must have the correct value
1253 ;; already, because it is used by `font-lock-compile-keywords'.
1254 (let ((default-directory (tramp-compat-temporary-file-directory))
1255 (outline-regexp tramp-debug-outline-regexp))
1256 (outline-mode))
1257 (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
1258 (set (make-local-variable 'outline-level) 'tramp-debug-outline-level))
1259 (current-buffer)))
1260
2110(defsubst tramp-debug-message (vec fmt-string &rest args) 1261(defsubst tramp-debug-message (vec fmt-string &rest args)
2111 "Append message to debug buffer. 1262 "Append message to debug buffer.
2112Message is formatted with FMT-STRING as control string and the remaining 1263Message is formatted with FMT-STRING as control string and the remaining
@@ -2173,36 +1324,34 @@ is greater than or equal 4.
2173Calls functions `message' and `tramp-debug-message' with FMT-STRING as 1324Calls functions `message' and `tramp-debug-message' with FMT-STRING as
2174control string and the remaining ARGS to actually emit the message (if 1325control string and the remaining ARGS to actually emit the message (if
2175applicable)." 1326applicable)."
2176 (condition-case nil 1327 (ignore-errors
2177 (when (<= level tramp-verbose) 1328 (when (<= level tramp-verbose)
2178 ;; Match data must be preserved! 1329 ;; Match data must be preserved!
2179 (save-match-data 1330 (save-match-data
2180 ;; Display only when there is a minimum level. 1331 ;; Display only when there is a minimum level.
2181 (when (and tramp-message-show-message (<= level 3)) 1332 (when (and tramp-message-show-message (<= level 3))
2182 (apply 'message 1333 (apply 'message
2183 (concat 1334 (concat
2184 (cond 1335 (cond
2185 ((= level 0) "") 1336 ((= level 0) "")
2186 ((= level 1) "") 1337 ((= level 1) "")
2187 ((= level 2) "Warning: ") 1338 ((= level 2) "Warning: ")
2188 (t "Tramp: ")) 1339 (t "Tramp: "))
2189 fmt-string) 1340 fmt-string)
2190 args)) 1341 args))
2191 ;; Log only when there is a minimum level. 1342 ;; Log only when there is a minimum level.
2192 (when (>= tramp-verbose 4) 1343 (when (>= tramp-verbose 4)
2193 (when (and vec-or-proc 1344 (when (and vec-or-proc
2194 (processp vec-or-proc) 1345 (processp vec-or-proc)
2195 (buffer-name (process-buffer vec-or-proc))) 1346 (buffer-name (process-buffer vec-or-proc)))
2196 (with-current-buffer (process-buffer vec-or-proc) 1347 (with-current-buffer (process-buffer vec-or-proc)
2197 ;; Translate proc to vec. 1348 ;; Translate proc to vec.
2198 (setq vec-or-proc (tramp-dissect-file-name default-directory)))) 1349 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
2199 (when (and vec-or-proc (vectorp vec-or-proc)) 1350 (when (and vec-or-proc (vectorp vec-or-proc))
2200 (apply 'tramp-debug-message 1351 (apply 'tramp-debug-message
2201 vec-or-proc 1352 vec-or-proc
2202 (concat (format "(%d) # " level) fmt-string) 1353 (concat (format "(%d) # " level) fmt-string)
2203 args))))) 1354 args)))))))
2204 ;; Suppress all errors.
2205 (error nil)))
2206 1355
2207(defsubst tramp-error (vec-or-proc signal fmt-string &rest args) 1356(defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
2208 "Emit an error. 1357 "Emit an error.
@@ -2264,46 +1413,14 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
2264 1413
2265(put 'with-parsed-tramp-file-name 'lisp-indent-function 2) 1414(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
2266(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) 1415(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
2267(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) 1416(tramp-compat-font-lock-add-keywords
2268 1417 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
2269(defmacro with-file-property (vec file property &rest body)
2270 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
2271FILE must be a local file name on a connection identified via VEC."
2272 `(if (file-name-absolute-p ,file)
2273 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
2274 (when (eq value 'undef)
2275 ;; We cannot pass @body as parameter to
2276 ;; `tramp-set-file-property' because it mangles our
2277 ;; debug messages.
2278 (setq value (progn ,@body))
2279 (tramp-set-file-property ,vec ,file ,property value))
2280 value)
2281 ,@body))
2282
2283(put 'with-file-property 'lisp-indent-function 3)
2284(put 'with-file-property 'edebug-form-spec t)
2285(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
2286
2287(defmacro with-connection-property (key property &rest body)
2288 "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
2289 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
2290 (when (eq value 'undef)
2291 ;; We cannot pass ,@body as parameter to
2292 ;; `tramp-set-connection-property' because it mangles our debug
2293 ;; messages.
2294 (setq value (progn ,@body))
2295 (tramp-set-connection-property ,key ,property value))
2296 value))
2297
2298(put 'with-connection-property 'lisp-indent-function 2)
2299(put 'with-connection-property 'edebug-form-spec t)
2300(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
2301 1418
2302(defun tramp-progress-reporter-update (reporter &optional value) 1419(defun tramp-progress-reporter-update (reporter &optional value)
2303 (let* ((parameters (cdr reporter)) 1420 (let* ((parameters (cdr reporter))
2304 (message (aref parameters 3))) 1421 (message (aref parameters 3)))
2305 (when (string-match message (or (current-message) "")) 1422 (when (string-match message (or (current-message) ""))
2306 (funcall 'progress-reporter-update reporter value)))) 1423 (tramp-compat-funcall 'progress-reporter-update reporter value))))
2307 1424
2308(defmacro with-progress-reporter (vec level message &rest body) 1425(defmacro with-progress-reporter (vec level message &rest body)
2309 "Executes BODY, spinning a progress reporter with MESSAGE. 1426 "Executes BODY, spinning a progress reporter with MESSAGE.
@@ -2317,11 +1434,10 @@ progress reporter."
2317 (when (and tramp-message-show-message 1434 (when (and tramp-message-show-message
2318 ;; Display only when there is a minimum level. 1435 ;; Display only when there is a minimum level.
2319 (<= ,level (min tramp-verbose 3))) 1436 (<= ,level (min tramp-verbose 3)))
2320 (condition-case nil 1437 (ignore-errors
2321 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) 1438 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
2322 tm (when pr 1439 tm (when pr
2323 (run-at-time 3 0.1 'tramp-progress-reporter-update pr))) 1440 (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
2324 (error nil)))
2325 (unwind-protect 1441 (unwind-protect
2326 ;; Execute the body. Unset `tramp-message-show-message' when 1442 ;; Execute the body. Unset `tramp-message-show-message' when
2327 ;; the timer object is created, in order to suppress 1443 ;; the timer object is created, in order to suppress
@@ -2335,7 +1451,8 @@ progress reporter."
2335 1451
2336(put 'with-progress-reporter 'lisp-indent-function 3) 1452(put 'with-progress-reporter 'lisp-indent-function 3)
2337(put 'with-progress-reporter 'edebug-form-spec t) 1453(put 'with-progress-reporter 'edebug-form-spec t)
2338(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>")) 1454(tramp-compat-font-lock-add-keywords
1455 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
2339 1456
2340(eval-and-compile ;; Silence compiler. 1457(eval-and-compile ;; Silence compiler.
2341 (if (memq system-type '(cygwin windows-nt)) 1458 (if (memq system-type '(cygwin windows-nt))
@@ -2352,34 +1469,6 @@ letter into the file name. This function removes it."
2352 1469
2353 (defalias 'tramp-drop-volume-letter 'identity))) 1470 (defalias 'tramp-drop-volume-letter 'identity)))
2354 1471
2355(defsubst tramp-make-tramp-temp-file (vec)
2356 "Create a temporary file on the remote host identified by VEC.
2357Return the local name of the temporary file."
2358 (let ((prefix
2359 (tramp-make-tramp-file-name
2360 (tramp-file-name-method vec)
2361 (tramp-file-name-user vec)
2362 (tramp-file-name-host vec)
2363 (tramp-drop-volume-letter
2364 (expand-file-name
2365 tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
2366 result)
2367 (while (not result)
2368 ;; `make-temp-file' would be the natural choice for
2369 ;; implementation. But it calls `write-region' internally,
2370 ;; which also needs a temporary file - we would end in an
2371 ;; infinite loop.
2372 (setq result (make-temp-name prefix))
2373 (if (file-exists-p result)
2374 (setq result nil)
2375 ;; This creates the file by side effect.
2376 (set-file-times result)
2377 (set-file-modes result (tramp-octal-to-decimal "0700"))))
2378
2379 ;; Return the local part.
2380 (with-parsed-tramp-file-name result nil localname)))
2381
2382
2383;;; Config Manipulation Functions: 1472;;; Config Manipulation Functions:
2384 1473
2385(defun tramp-set-completion-function (method function-list) 1474(defun tramp-set-completion-function (method function-list)
@@ -2414,7 +1503,7 @@ Example:
2414 ;; Windows registry. 1503 ;; Windows registry.
2415 (and (memq system-type '(cygwin windows-nt)) 1504 (and (memq system-type '(cygwin windows-nt))
2416 (zerop 1505 (zerop
2417 (tramp-local-call-process 1506 (tramp-compat-call-process
2418 "reg" nil nil nil "query" (nth 1 (car v))))) 1507 "reg" nil nil nil "query" (nth 1 (car v)))))
2419 ;; Configuration file. 1508 ;; Configuration file.
2420 (file-exists-p (nth 1 (car v))))) 1509 (file-exists-p (nth 1 (car v)))))
@@ -2502,279 +1591,6 @@ been set up by `rfn-eshadow-setup-minibuffer'."
2502 (remove-hook 'rfn-eshadow-update-overlay-hook 1591 (remove-hook 'rfn-eshadow-update-overlay-hook
2503 'tramp-rfn-eshadow-update-overlay)))) 1592 'tramp-rfn-eshadow-update-overlay))))
2504 1593
2505
2506;;; Integration of eshell.el:
2507
2508(eval-when-compile
2509 (defvar eshell-path-env))
2510
2511;; eshell.el keeps the path in `eshell-path-env'. We must change it
2512;; when `default-directory' points to another host.
2513(defun tramp-eshell-directory-change ()
2514 "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
2515 (setq eshell-path-env
2516 (if (file-remote-p default-directory)
2517 (with-parsed-tramp-file-name default-directory nil
2518 (mapconcat
2519 'identity
2520 (tramp-get-remote-path v)
2521 ":"))
2522 (getenv "PATH"))))
2523
2524(eval-after-load "esh-util"
2525 '(progn
2526 (tramp-eshell-directory-change)
2527 (add-hook 'eshell-directory-change-hook
2528 'tramp-eshell-directory-change)
2529 (add-hook 'tramp-unload-hook
2530 (lambda ()
2531 (remove-hook 'eshell-directory-change-hook
2532 'tramp-eshell-directory-change)))))
2533
2534
2535;;; File Name Handler Functions:
2536
2537(defun tramp-handle-make-symbolic-link
2538 (filename linkname &optional ok-if-already-exists)
2539 "Like `make-symbolic-link' for Tramp files.
2540If LINKNAME is a non-Tramp file, it is used verbatim as the target of
2541the symlink. If LINKNAME is a Tramp file, only the localname component is
2542used as the target of the symlink.
2543
2544If LINKNAME is a Tramp file and the localname component is relative, then
2545it is expanded first, before the localname component is taken. Note that
2546this can give surprising results if the user/host for the source and
2547target of the symlink differ."
2548 (with-parsed-tramp-file-name linkname l
2549 (let ((ln (tramp-get-remote-ln l))
2550 (cwd (tramp-run-real-handler
2551 'file-name-directory (list l-localname))))
2552 (unless ln
2553 (tramp-error
2554 l 'file-error
2555 "Making a symbolic link. ln(1) does not exist on the remote host."))
2556
2557 ;; Do the 'confirm if exists' thing.
2558 (when (file-exists-p linkname)
2559 ;; What to do?
2560 (if (or (null ok-if-already-exists) ; not allowed to exist
2561 (and (numberp ok-if-already-exists)
2562 (not (yes-or-no-p
2563 (format
2564 "File %s already exists; make it a link anyway? "
2565 l-localname)))))
2566 (tramp-error
2567 l 'file-already-exists "File %s already exists" l-localname)
2568 (delete-file linkname)))
2569
2570 ;; If FILENAME is a Tramp name, use just the localname component.
2571 (when (tramp-tramp-file-p filename)
2572 (setq filename
2573 (tramp-file-name-localname
2574 (tramp-dissect-file-name (expand-file-name filename)))))
2575
2576 (tramp-flush-file-property l (file-name-directory l-localname))
2577 (tramp-flush-file-property l l-localname)
2578
2579 ;; Right, they are on the same host, regardless of user, method, etc.
2580 ;; We now make the link on the remote machine. This will occur as the user
2581 ;; that FILENAME belongs to.
2582 (zerop
2583 (tramp-send-command-and-check
2584 l
2585 (format
2586 "cd %s && %s -sf %s %s"
2587 (tramp-shell-quote-argument cwd)
2588 ln
2589 (tramp-shell-quote-argument filename)
2590 (tramp-shell-quote-argument l-localname))
2591 t)))))
2592
2593(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2594 "Like `load' for Tramp files."
2595 (with-parsed-tramp-file-name (expand-file-name file) nil
2596 (unless nosuffix
2597 (cond ((file-exists-p (concat file ".elc"))
2598 (setq file (concat file ".elc")))
2599 ((file-exists-p (concat file ".el"))
2600 (setq file (concat file ".el")))))
2601 (when must-suffix
2602 ;; The first condition is always true for absolute file names.
2603 ;; Included for safety's sake.
2604 (unless (or (file-name-directory file)
2605 (string-match "\\.elc?\\'" file))
2606 (tramp-error
2607 v 'file-error
2608 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2609 (unless noerror
2610 (when (not (file-exists-p file))
2611 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2612 (if (not (file-exists-p file))
2613 nil
2614 (let ((tramp-message-show-message (not nomessage)))
2615 (with-progress-reporter v 0 (format "Loading %s" file)
2616 (let ((local-copy (file-local-copy file)))
2617 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2618 (unwind-protect
2619 (load local-copy noerror t t)
2620 (delete-file local-copy)))))
2621 t)))
2622
2623;; Localname manipulation functions that grok Tramp localnames...
2624(defun tramp-handle-file-name-as-directory (file)
2625 "Like `file-name-as-directory' but aware of Tramp files."
2626 ;; `file-name-as-directory' would be sufficient except localname is
2627 ;; the empty string.
2628 (let ((v (tramp-dissect-file-name file t)))
2629 ;; Run the command on the localname portion only.
2630 (tramp-make-tramp-file-name
2631 (tramp-file-name-method v)
2632 (tramp-file-name-user v)
2633 (tramp-file-name-host v)
2634 (tramp-run-real-handler
2635 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
2636
2637(defun tramp-handle-file-name-directory (file)
2638 "Like `file-name-directory' but aware of Tramp files."
2639 ;; Everything except the last filename thing is the directory. We
2640 ;; cannot apply `with-parsed-tramp-file-name', because this expands
2641 ;; the remote file name parts. This is a problem when we are in
2642 ;; file name completion.
2643 (let ((v (tramp-dissect-file-name file t)))
2644 ;; Run the command on the localname portion only.
2645 (tramp-make-tramp-file-name
2646 (tramp-file-name-method v)
2647 (tramp-file-name-user v)
2648 (tramp-file-name-host v)
2649 (tramp-run-real-handler
2650 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
2651
2652(defun tramp-handle-file-name-nondirectory (file)
2653 "Like `file-name-nondirectory' but aware of Tramp files."
2654 (with-parsed-tramp-file-name file nil
2655 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
2656
2657(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2658 "Like `file-truename' for Tramp files."
2659 (with-parsed-tramp-file-name (expand-file-name filename) nil
2660 (with-file-property v localname "file-truename"
2661 (let ((result nil)) ; result steps in reverse order
2662 (tramp-message v 4 "Finding true name for `%s'" filename)
2663 (cond
2664 ;; Use GNU readlink --canonicalize-missing where available.
2665 ((tramp-get-remote-readlink v)
2666 (setq result
2667 (tramp-send-command-and-read
2668 v
2669 (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
2670 (tramp-get-remote-readlink v)
2671 (tramp-shell-quote-argument localname)))))
2672
2673 ;; Use Perl implementation.
2674 ((and (tramp-get-remote-perl v)
2675 (tramp-get-connection-property v "perl-file-spec" nil)
2676 (tramp-get-connection-property v "perl-cwd-realpath" nil))
2677 (tramp-maybe-send-script
2678 v tramp-perl-file-truename "tramp_perl_file_truename")
2679 (setq result
2680 (tramp-send-command-and-read
2681 v
2682 (format "tramp_perl_file_truename %s"
2683 (tramp-shell-quote-argument localname)))))
2684
2685 ;; Do it yourself. We bind `directory-sep-char' here for
2686 ;; XEmacs on Windows, which would otherwise use backslash.
2687 (t (let* ((directory-sep-char ?/)
2688 (steps (tramp-compat-split-string localname "/"))
2689 (localnamedir (tramp-run-real-handler
2690 'file-name-as-directory (list localname)))
2691 (is-dir (string= localname localnamedir))
2692 (thisstep nil)
2693 (numchase 0)
2694 ;; Don't make the following value larger than
2695 ;; necessary. People expect an error message in a
2696 ;; timely fashion when something is wrong;
2697 ;; otherwise they might think that Emacs is hung.
2698 ;; Of course, correctness has to come first.
2699 (numchase-limit 20)
2700 symlink-target)
2701 (while (and steps (< numchase numchase-limit))
2702 (setq thisstep (pop steps))
2703 (tramp-message
2704 v 5 "Check %s"
2705 (mapconcat 'identity
2706 (append '("") (reverse result) (list thisstep))
2707 "/"))
2708 (setq symlink-target
2709 (nth 0 (file-attributes
2710 (tramp-make-tramp-file-name
2711 method user host
2712 (mapconcat 'identity
2713 (append '("")
2714 (reverse result)
2715 (list thisstep))
2716 "/")))))
2717 (cond ((string= "." thisstep)
2718 (tramp-message v 5 "Ignoring step `.'"))
2719 ((string= ".." thisstep)
2720 (tramp-message v 5 "Processing step `..'")
2721 (pop result))
2722 ((stringp symlink-target)
2723 ;; It's a symlink, follow it.
2724 (tramp-message v 5 "Follow symlink to %s" symlink-target)
2725 (setq numchase (1+ numchase))
2726 (when (file-name-absolute-p symlink-target)
2727 (setq result nil))
2728 ;; If the symlink was absolute, we'll get a string like
2729 ;; "/user@host:/some/target"; extract the
2730 ;; "/some/target" part from it.
2731 (when (tramp-tramp-file-p symlink-target)
2732 (unless (tramp-equal-remote filename symlink-target)
2733 (tramp-error
2734 v 'file-error
2735 "Symlink target `%s' on wrong host" symlink-target))
2736 (setq symlink-target localname))
2737 (setq steps
2738 (append (tramp-compat-split-string
2739 symlink-target "/")
2740 steps)))
2741 (t
2742 ;; It's a file.
2743 (setq result (cons thisstep result)))))
2744 (when (>= numchase numchase-limit)
2745 (tramp-error
2746 v 'file-error
2747 "Maximum number (%d) of symlinks exceeded" numchase-limit))
2748 (setq result (reverse result))
2749 ;; Combine list to form string.
2750 (setq result
2751 (if result
2752 (mapconcat 'identity (cons "" result) "/")
2753 "/"))
2754 (when (and is-dir (or (string= "" result)
2755 (not (string= (substring result -1) "/"))))
2756 (setq result (concat result "/"))))))
2757
2758 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
2759 (tramp-make-tramp-file-name method user host result)))))
2760
2761;; Basic functions.
2762
2763(defun tramp-handle-file-exists-p (filename)
2764 "Like `file-exists-p' for Tramp files."
2765 (with-parsed-tramp-file-name filename nil
2766 (with-file-property v localname "file-exists-p"
2767 (or (not (null (tramp-get-file-property
2768 v localname "file-attributes-integer" nil)))
2769 (not (null (tramp-get-file-property
2770 v localname "file-attributes-string" nil)))
2771 (zerop (tramp-send-command-and-check
2772 v
2773 (format
2774 "%s %s"
2775 (tramp-get-file-exists-command v)
2776 (tramp-shell-quote-argument localname))))))))
2777
2778;; Inodes don't exist for some file systems. Therefore we must 1594;; Inodes don't exist for some file systems. Therefore we must
2779;; generate virtual ones. Used in `find-buffer-visiting'. The method 1595;; generate virtual ones. Used in `find-buffer-visiting'. The method
2780;; applied might be not so efficient (Ange-FTP uses hashes). But 1596;; applied might be not so efficient (Ange-FTP uses hashes). But
@@ -2791,1638 +1607,12 @@ target of the symlink differ."
2791(defvar tramp-devices nil 1607(defvar tramp-devices nil
2792 "Keeps virtual device numbers.") 1608 "Keeps virtual device numbers.")
2793 1609
2794;; CCC: This should check for an error condition and signal failure
2795;; when something goes wrong.
2796;; Daniel Pittman <daniel@danann.net>
2797(defun tramp-handle-file-attributes (filename &optional id-format)
2798 "Like `file-attributes' for Tramp files."
2799 (unless id-format (setq id-format 'integer))
2800 ;; Don't modify `last-coding-system-used' by accident.
2801 (let ((last-coding-system-used last-coding-system-used))
2802 (with-parsed-tramp-file-name (expand-file-name filename) nil
2803 (with-file-property v localname (format "file-attributes-%s" id-format)
2804 (save-excursion
2805 (tramp-convert-file-attributes
2806 v
2807 (cond
2808 ((tramp-get-remote-stat v)
2809 (tramp-do-file-attributes-with-stat v localname id-format))
2810 ((tramp-get-remote-perl v)
2811 (tramp-do-file-attributes-with-perl v localname id-format))
2812 (t
2813 (tramp-do-file-attributes-with-ls v localname id-format)))))))))
2814
2815(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
2816 "Implement `file-attributes' for Tramp files using the ls(1) command."
2817 (let (symlinkp dirp
2818 res-inode res-filemodes res-numlinks
2819 res-uid res-gid res-size res-symlink-target)
2820 (tramp-message vec 5 "file attributes with ls: %s" localname)
2821 (tramp-send-command
2822 vec
2823 (format "(%s %s || %s -h %s) && %s %s %s"
2824 (tramp-get-file-exists-command vec)
2825 (tramp-shell-quote-argument localname)
2826 (tramp-get-test-command vec)
2827 (tramp-shell-quote-argument localname)
2828 (tramp-get-ls-command vec)
2829 (if (eq id-format 'integer) "-ildn" "-ild")
2830 (tramp-shell-quote-argument localname)))
2831 ;; parse `ls -l' output ...
2832 (with-current-buffer (tramp-get-buffer vec)
2833 (when (> (buffer-size) 0)
2834 (goto-char (point-min))
2835 ;; ... inode
2836 (setq res-inode
2837 (condition-case err
2838 (read (current-buffer))
2839 (invalid-read-syntax
2840 (when (and (equal (cadr err)
2841 "Integer constant overflow in reader")
2842 (string-match
2843 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
2844 (car (cddr err))))
2845 (let* ((big (read (substring (car (cddr err)) 0
2846 (match-beginning 1))))
2847 (small (read (match-string 1 (car (cddr err)))))
2848 (twiddle (/ small 65536)))
2849 (cons (+ big twiddle)
2850 (- small (* twiddle 65536))))))))
2851 ;; ... file mode flags
2852 (setq res-filemodes (symbol-name (read (current-buffer))))
2853 ;; ... number links
2854 (setq res-numlinks (read (current-buffer)))
2855 ;; ... uid and gid
2856 (setq res-uid (read (current-buffer)))
2857 (setq res-gid (read (current-buffer)))
2858 (if (eq id-format 'integer)
2859 (progn
2860 (unless (numberp res-uid) (setq res-uid -1))
2861 (unless (numberp res-gid) (setq res-gid -1)))
2862 (progn
2863 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
2864 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
2865 ;; ... size
2866 (setq res-size (read (current-buffer)))
2867 ;; From the file modes, figure out other stuff.
2868 (setq symlinkp (eq ?l (aref res-filemodes 0)))
2869 (setq dirp (eq ?d (aref res-filemodes 0)))
2870 ;; if symlink, find out file name pointed to
2871 (when symlinkp
2872 (search-forward "-> ")
2873 (setq res-symlink-target
2874 (buffer-substring (point) (tramp-compat-line-end-position))))
2875 ;; return data gathered
2876 (list
2877 ;; 0. t for directory, string (name linked to) for symbolic
2878 ;; link, or nil.
2879 (or dirp res-symlink-target)
2880 ;; 1. Number of links to file.
2881 res-numlinks
2882 ;; 2. File uid.
2883 res-uid
2884 ;; 3. File gid.
2885 res-gid
2886 ;; 4. Last access time, as a list of two integers. First
2887 ;; integer has high-order 16 bits of time, second has low 16
2888 ;; bits.
2889 ;; 5. Last modification time, likewise.
2890 ;; 6. Last status change time, likewise.
2891 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2892 ;; 7. Size in bytes (-1, if number is out of range).
2893 res-size
2894 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2895 res-filemodes
2896 ;; 9. t if file's gid would change if file were deleted and
2897 ;; recreated. Will be set in `tramp-convert-file-attributes'
2898 t
2899 ;; 10. inode number.
2900 res-inode
2901 ;; 11. Device number. Will be replaced by a virtual device number.
2902 -1
2903 )))))
2904
2905(defun tramp-do-file-attributes-with-perl
2906 (vec localname &optional id-format)
2907 "Implement `file-attributes' for Tramp files using a Perl script."
2908 (tramp-message vec 5 "file attributes with perl: %s" localname)
2909 (tramp-maybe-send-script
2910 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
2911 (tramp-send-command-and-read
2912 vec
2913 (format "tramp_perl_file_attributes %s %s"
2914 (tramp-shell-quote-argument localname) id-format)))
2915
2916(defun tramp-do-file-attributes-with-stat
2917 (vec localname &optional id-format)
2918 "Implement `file-attributes' for Tramp files using stat(1) command."
2919 (tramp-message vec 5 "file attributes with stat: %s" localname)
2920 (tramp-send-command-and-read
2921 vec
2922 (format
2923 ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
2924 ;; parse correctly the sequence "((". Therefore, we add a space.
2925 "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)"
2926 (tramp-get-file-exists-command vec)
2927 (tramp-shell-quote-argument localname)
2928 (tramp-get-test-command vec)
2929 (tramp-shell-quote-argument localname)
2930 (tramp-get-remote-stat vec)
2931 (if (eq id-format 'integer) "%u" "\"%U\"")
2932 (if (eq id-format 'integer) "%g" "\"%G\"")
2933 (tramp-shell-quote-argument localname))))
2934
2935(defun tramp-handle-set-visited-file-modtime (&optional time-list)
2936 "Like `set-visited-file-modtime' for Tramp files."
2937 (unless (buffer-file-name)
2938 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2939 (buffer-name)))
2940 (if time-list
2941 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2942 (let ((f (buffer-file-name))
2943 coding-system-used)
2944 (with-parsed-tramp-file-name f nil
2945 (let* ((attr (file-attributes f))
2946 ;; '(-1 65535) means file doesn't exists yet.
2947 (modtime (or (nth 5 attr) '(-1 65535))))
2948 (when (boundp 'last-coding-system-used)
2949 (setq coding-system-used (symbol-value 'last-coding-system-used)))
2950 ;; We use '(0 0) as a don't-know value. See also
2951 ;; `tramp-do-file-attributes-with-ls'.
2952 (if (not (equal modtime '(0 0)))
2953 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2954 (progn
2955 (tramp-send-command
2956 v
2957 (format "%s -ild %s"
2958 (tramp-get-ls-command v)
2959 (tramp-shell-quote-argument localname)))
2960 (setq attr (buffer-substring (point)
2961 (progn (end-of-line) (point)))))
2962 (tramp-set-file-property
2963 v localname "visited-file-modtime-ild" attr))
2964 (when (boundp 'last-coding-system-used)
2965 (set 'last-coding-system-used coding-system-used))
2966 nil)))))
2967
2968;; This function makes the same assumption as
2969;; `tramp-handle-set-visited-file-modtime'.
2970(defun tramp-handle-verify-visited-file-modtime (buf)
2971 "Like `verify-visited-file-modtime' for Tramp files.
2972At the time `verify-visited-file-modtime' calls this function, we
2973already know that the buffer is visiting a file and that
2974`visited-file-modtime' does not return 0. Do not call this
2975function directly, unless those two cases are already taken care
2976of."
2977 (with-current-buffer buf
2978 (let ((f (buffer-file-name)))
2979 ;; There is no file visiting the buffer, or the buffer has no
2980 ;; recorded last modification time, or there is no established
2981 ;; connection.
2982 (if (or (not f)
2983 (eq (visited-file-modtime) 0)
2984 (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
2985 t
2986 (with-parsed-tramp-file-name f nil
2987 (tramp-flush-file-property v localname)
2988 (let* ((attr (file-attributes f))
2989 (modtime (nth 5 attr))
2990 (mt (visited-file-modtime)))
2991
2992 (cond
2993 ;; File exists, and has a known modtime.
2994 ((and attr (not (equal modtime '(0 0))))
2995 (< (abs (tramp-time-diff
2996 modtime
2997 ;; For compatibility, deal with both the old
2998 ;; (HIGH . LOW) and the new (HIGH LOW) return
2999 ;; values of `visited-file-modtime'.
3000 (if (atom (cdr mt))
3001 (list (car mt) (cdr mt))
3002 mt)))
3003 2))
3004 ;; Modtime has the don't know value.
3005 (attr
3006 (tramp-send-command
3007 v
3008 (format "%s -ild %s"
3009 (tramp-get-ls-command v)
3010 (tramp-shell-quote-argument localname)))
3011 (with-current-buffer (tramp-get-buffer v)
3012 (setq attr (buffer-substring
3013 (point) (progn (end-of-line) (point)))))
3014 (equal
3015 attr
3016 (tramp-get-file-property
3017 v localname "visited-file-modtime-ild" "")))
3018 ;; If file does not exist, say it is not modified if and
3019 ;; only if that agrees with the buffer's record.
3020 (t (equal mt '(-1 65535))))))))))
3021
3022(defun tramp-handle-set-file-modes (filename mode)
3023 "Like `set-file-modes' for Tramp files."
3024 (with-parsed-tramp-file-name filename nil
3025 (tramp-flush-file-property v localname)
3026 (unless (zerop (tramp-send-command-and-check
3027 v
3028 (format "chmod %s %s"
3029 (tramp-decimal-to-octal mode)
3030 (tramp-shell-quote-argument localname))))
3031 ;; FIXME: extract the proper text from chmod's stderr.
3032 (tramp-error
3033 v 'file-error "Error while changing file's mode %s" filename))))
3034
3035(defun tramp-handle-set-file-times (filename &optional time)
3036 "Like `set-file-times' for Tramp files."
3037 (zerop
3038 (if (file-remote-p filename)
3039 (with-parsed-tramp-file-name filename nil
3040 (tramp-flush-file-property v localname)
3041 (let ((time (if (or (null time) (equal time '(0 0)))
3042 (current-time)
3043 time))
3044 ;; With GNU Emacs, `format-time-string' has an optional
3045 ;; parameter UNIVERSAL. This is preferred, because we
3046 ;; could handle the case when the remote host is
3047 ;; located in a different time zone as the local host.
3048 (utc (not (featurep 'xemacs))))
3049 (tramp-send-command-and-check
3050 v (format "%s touch -t %s %s"
3051 (if utc "TZ=UTC; export TZ;" "")
3052 (if utc
3053 (format-time-string "%Y%m%d%H%M.%S" time t)
3054 (format-time-string "%Y%m%d%H%M.%S" time))
3055 (tramp-shell-quote-argument localname)))))
3056
3057 ;; We handle also the local part, because in older Emacsen,
3058 ;; without `set-file-times', this function is an alias for this.
3059 ;; We are local, so we don't need the UTC settings.
3060 (tramp-local-call-process
3061 "touch" nil nil nil "-t"
3062 (format-time-string "%Y%m%d%H%M.%S" time)
3063 (tramp-shell-quote-argument filename)))))
3064
3065(defun tramp-set-file-uid-gid (filename &optional uid gid)
3066 "Set the ownership for FILENAME.
3067If UID and GID are provided, these values are used; otherwise uid
3068and gid of the corresponding user is taken. Both parameters must be integers."
3069 ;; Modern Unices allow chown only for root. So we might need
3070 ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
3071 ;; working with su(do)? when it is needed, so it shall succeed in
3072 ;; the majority of cases.
3073 ;; Don't modify `last-coding-system-used' by accident.
3074 (let ((last-coding-system-used last-coding-system-used))
3075 (if (file-remote-p filename)
3076 (with-parsed-tramp-file-name filename nil
3077 (if (and (zerop (user-uid)) (tramp-local-host-p v))
3078 ;; If we are root on the local host, we can do it directly.
3079 (tramp-set-file-uid-gid localname uid gid)
3080 (let ((uid (or (and (integerp uid) uid)
3081 (tramp-get-remote-uid v 'integer)))
3082 (gid (or (and (integerp gid) gid)
3083 (tramp-get-remote-gid v 'integer))))
3084 (tramp-send-command
3085 v (format
3086 "chown %d:%d %s" uid gid
3087 (tramp-shell-quote-argument localname))))))
3088
3089 ;; We handle also the local part, because there doesn't exist
3090 ;; `set-file-uid-gid'. On W32 "chown" might not work.
3091 (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
3092 (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
3093 (tramp-local-call-process
3094 "chown" nil nil nil
3095 (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
3096
3097(defun tramp-remote-selinux-p (vec)
3098 "Check, whether SELINUX is enabled on the remote host."
3099 (with-connection-property (tramp-get-connection-process vec) "selinux-p"
3100 (let ((result (tramp-find-executable
3101 vec "getenforce" (tramp-get-remote-path vec) t t)))
3102 (and result
3103 (string-equal
3104 (tramp-send-command-and-read
3105 vec (format "echo \\\"`%S`\\\"" result))
3106 "Enforcing")))))
3107
3108(defun tramp-handle-file-selinux-context (filename)
3109 "Like `file-selinux-context' for Tramp files."
3110 (with-parsed-tramp-file-name filename nil
3111 (with-file-property v localname "file-selinux-context"
3112 (let ((context '(nil nil nil nil))
3113 (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
3114 "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
3115 (when (and (tramp-remote-selinux-p v)
3116 (zerop (tramp-send-command-and-check
3117 v (format
3118 "%s -d -Z %s"
3119 (tramp-get-ls-command v)
3120 (tramp-shell-quote-argument localname)))))
3121 (with-current-buffer (tramp-get-connection-buffer v)
3122 (goto-char (point-min))
3123 (when (re-search-forward regexp (tramp-compat-line-end-position) t)
3124 (setq context (list (match-string 1) (match-string 2)
3125 (match-string 3) (match-string 4))))))
3126 ;; Return the context.
3127 context))))
3128
3129(defun tramp-handle-set-file-selinux-context (filename context)
3130 "Like `set-file-selinux-context' for Tramp files."
3131 (with-parsed-tramp-file-name filename nil
3132 (if (and (consp context)
3133 (tramp-remote-selinux-p v)
3134 (zerop (tramp-send-command-and-check
3135 v (format "chcon %s %s %s %s %s"
3136 (if (stringp (nth 0 context))
3137 (format "--user=%s" (nth 0 context)) "")
3138 (if (stringp (nth 1 context))
3139 (format "--role=%s" (nth 1 context)) "")
3140 (if (stringp (nth 2 context))
3141 (format "--type=%s" (nth 2 context)) "")
3142 (if (stringp (nth 3 context))
3143 (format "--range=%s" (nth 3 context)) "")
3144 (tramp-shell-quote-argument localname)))))
3145 (tramp-set-file-property v localname "file-selinux-context" context)
3146 (tramp-set-file-property v localname "file-selinux-context" 'undef)))
3147 ;; We always return nil.
3148 nil)
3149
3150;; Simple functions using the `test' command.
3151
3152(defun tramp-handle-file-executable-p (filename)
3153 "Like `file-executable-p' for Tramp files."
3154 (with-parsed-tramp-file-name filename nil
3155 (with-file-property v localname "file-executable-p"
3156 ;; Examine `file-attributes' cache to see if request can be
3157 ;; satisfied without remote operation.
3158 (or (tramp-check-cached-permissions v ?x)
3159 (zerop (tramp-run-test "-x" filename))))))
3160
3161(defun tramp-handle-file-readable-p (filename)
3162 "Like `file-readable-p' for Tramp files."
3163 (with-parsed-tramp-file-name filename nil
3164 (with-file-property v localname "file-readable-p"
3165 ;; Examine `file-attributes' cache to see if request can be
3166 ;; satisfied without remote operation.
3167 (or (tramp-check-cached-permissions v ?r)
3168 (zerop (tramp-run-test "-r" filename))))))
3169
3170;; When the remote shell is started, it looks for a shell which groks
3171;; tilde expansion. Here, we assume that all shells which grok tilde
3172;; expansion will also provide a `test' command which groks `-nt' (for
3173;; newer than). If this breaks, tell me about it and I'll try to do
3174;; something smarter about it.
3175(defun tramp-handle-file-newer-than-file-p (file1 file2)
3176 "Like `file-newer-than-file-p' for Tramp files."
3177 (cond ((not (file-exists-p file1))
3178 nil)
3179 ((not (file-exists-p file2))
3180 t)
3181 ;; We are sure both files exist at this point.
3182 (t
3183 (save-excursion
3184 ;; We try to get the mtime of both files. If they are not
3185 ;; equal to the "dont-know" value, then we subtract the times
3186 ;; and obtain the result.
3187 (let ((fa1 (file-attributes file1))
3188 (fa2 (file-attributes file2)))
3189 (if (and (not (equal (nth 5 fa1) '(0 0)))
3190 (not (equal (nth 5 fa2) '(0 0))))
3191 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
3192 ;; If one of them is the dont-know value, then we can
3193 ;; still try to run a shell command on the remote host.
3194 ;; However, this only works if both files are Tramp
3195 ;; files and both have the same method, same user, same
3196 ;; host.
3197 (unless (tramp-equal-remote file1 file2)
3198 (with-parsed-tramp-file-name
3199 (if (tramp-tramp-file-p file1) file1 file2) nil
3200 (tramp-error
3201 v 'file-error
3202 "Files %s and %s must have same method, user, host"
3203 file1 file2)))
3204 (with-parsed-tramp-file-name file1 nil
3205 (zerop (tramp-run-test2
3206 (tramp-get-test-nt-command v) file1 file2)))))))))
3207
3208;; Functions implemented using the basic functions above.
3209
3210(defun tramp-handle-file-modes (filename)
3211 "Like `file-modes' for Tramp files."
3212 (let ((truename (or (file-truename filename) filename)))
3213 (when (file-exists-p truename)
3214 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
3215
3216(defun tramp-default-file-modes (filename) 1610(defun tramp-default-file-modes (filename)
3217 "Return file modes of FILENAME as integer. 1611 "Return file modes of FILENAME as integer.
3218If the file modes of FILENAME cannot be determined, return the 1612If the file modes of FILENAME cannot be determined, return the
3219value of `default-file-modes', without execute permissions." 1613value of `default-file-modes', without execute permissions."
3220 (or (file-modes filename) 1614 (or (file-modes filename)
3221 (logand (default-file-modes) (tramp-octal-to-decimal "0666")))) 1615 (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
3222
3223(defun tramp-handle-file-directory-p (filename)
3224 "Like `file-directory-p' for Tramp files."
3225 ;; Care must be taken that this function returns `t' for symlinks
3226 ;; pointing to directories. Surely the most obvious implementation
3227 ;; would be `test -d', but that returns false for such symlinks.
3228 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
3229 ;; I now think he's right. So we could be using `test -d', couldn't
3230 ;; we?
3231 ;;
3232 ;; Alternatives: `cd %s', `test -d %s'
3233 (with-parsed-tramp-file-name filename nil
3234 (with-file-property v localname "file-directory-p"
3235 (zerop (tramp-run-test "-d" filename)))))
3236
3237(defun tramp-handle-file-regular-p (filename)
3238 "Like `file-regular-p' for Tramp files."
3239 (and (file-exists-p filename)
3240 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
3241
3242(defun tramp-handle-file-symlink-p (filename)
3243 "Like `file-symlink-p' for Tramp files."
3244 (with-parsed-tramp-file-name filename nil
3245 (let ((x (car (file-attributes filename))))
3246 (when (stringp x)
3247 ;; When Tramp is running on VMS, then `file-name-absolute-p'
3248 ;; might do weird things.
3249 (if (file-name-absolute-p x)
3250 (tramp-make-tramp-file-name method user host x)
3251 x)))))
3252
3253(defun tramp-handle-file-writable-p (filename)
3254 "Like `file-writable-p' for Tramp files."
3255 (with-parsed-tramp-file-name filename nil
3256 (with-file-property v localname "file-writable-p"
3257 (if (file-exists-p filename)
3258 ;; Examine `file-attributes' cache to see if request can be
3259 ;; satisfied without remote operation.
3260 (or (tramp-check-cached-permissions v ?w)
3261 (zerop (tramp-run-test "-w" filename)))
3262 ;; If file doesn't exist, check if directory is writable.
3263 (and (zerop (tramp-run-test
3264 "-d" (file-name-directory filename)))
3265 (zerop (tramp-run-test
3266 "-w" (file-name-directory filename))))))))
3267
3268(defun tramp-handle-file-ownership-preserved-p (filename)
3269 "Like `file-ownership-preserved-p' for Tramp files."
3270 (with-parsed-tramp-file-name filename nil
3271 (with-file-property v localname "file-ownership-preserved-p"
3272 (let ((attributes (file-attributes filename)))
3273 ;; Return t if the file doesn't exist, since it's true that no
3274 ;; information would be lost by an (attempted) delete and create.
3275 (or (null attributes)
3276 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
3277
3278;; Other file name ops.
3279
3280(defun tramp-handle-directory-file-name (directory)
3281 "Like `directory-file-name' for Tramp files."
3282 ;; If localname component of filename is "/", leave it unchanged.
3283 ;; Otherwise, remove any trailing slash from localname component.
3284 ;; Method, host, etc, are unchanged. Does it make sense to try
3285 ;; to avoid parsing the filename?
3286 (with-parsed-tramp-file-name directory nil
3287 (if (and (not (zerop (length localname)))
3288 (eq (aref localname (1- (length localname))) ?/)
3289 (not (string= localname "/")))
3290 (substring directory 0 -1)
3291 directory)))
3292
3293;; Directory listings.
3294
3295(defun tramp-handle-directory-files
3296 (directory &optional full match nosort files-only)
3297 "Like `directory-files' for Tramp files."
3298 ;; FILES-ONLY is valid for XEmacs only.
3299 (when (file-directory-p directory)
3300 (setq directory (file-name-as-directory (expand-file-name directory)))
3301 (let ((temp (nreverse (file-name-all-completions "" directory)))
3302 result item)
3303
3304 (while temp
3305 (setq item (directory-file-name (pop temp)))
3306 (when (and (or (null match) (string-match match item))
3307 (or (null files-only)
3308 ;; Files only.
3309 (and (equal files-only t) (file-regular-p item))
3310 ;; Directories only.
3311 (file-directory-p item)))
3312 (push (if full (concat directory item) item)
3313 result)))
3314 (if nosort result (sort result 'string<)))))
3315
3316(defun tramp-handle-directory-files-and-attributes
3317 (directory &optional full match nosort id-format)
3318 "Like `directory-files-and-attributes' for Tramp files."
3319 (unless id-format (setq id-format 'integer))
3320 (when (file-directory-p directory)
3321 (setq directory (expand-file-name directory))
3322 (let* ((temp
3323 (copy-tree
3324 (with-parsed-tramp-file-name directory nil
3325 (with-file-property
3326 v localname
3327 (format "directory-files-and-attributes-%s" id-format)
3328 (save-excursion
3329 (mapcar
3330 (lambda (x)
3331 (cons (car x)
3332 (tramp-convert-file-attributes v (cdr x))))
3333 (cond
3334 ((tramp-get-remote-stat v)
3335 (tramp-do-directory-files-and-attributes-with-stat
3336 v localname id-format))
3337 ((tramp-get-remote-perl v)
3338 (tramp-do-directory-files-and-attributes-with-perl
3339 v localname id-format)))))))))
3340 result item)
3341
3342 (while temp
3343 (setq item (pop temp))
3344 (when (or (null match) (string-match match (car item)))
3345 (when full
3346 (setcar item (expand-file-name (car item) directory)))
3347 (push item result)))
3348
3349 (if nosort
3350 result
3351 (sort result (lambda (x y) (string< (car x) (car y))))))))
3352
3353(defun tramp-do-directory-files-and-attributes-with-perl
3354 (vec localname &optional id-format)
3355 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
3356 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
3357 (tramp-maybe-send-script
3358 vec tramp-perl-directory-files-and-attributes
3359 "tramp_perl_directory_files_and_attributes")
3360 (let ((object
3361 (tramp-send-command-and-read
3362 vec
3363 (format "tramp_perl_directory_files_and_attributes %s %s"
3364 (tramp-shell-quote-argument localname) id-format))))
3365 (when (stringp object) (tramp-error vec 'file-error object))
3366 object))
3367
3368(defun tramp-do-directory-files-and-attributes-with-stat
3369 (vec localname &optional id-format)
3370 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
3371 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
3372 (tramp-send-command-and-read
3373 vec
3374 (format
3375 (concat
3376 ;; We must care about filenames with spaces, or starting with
3377 ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
3378 ;; but it does not work on all remote systems. Therefore, we
3379 ;; quote the filenames via sed.
3380 "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
3381 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); "
3382 "echo \")\"")
3383 (tramp-shell-quote-argument localname)
3384 (tramp-get-ls-command vec)
3385 (tramp-get-remote-stat vec)
3386 (if (eq id-format 'integer) "%u" "\"%U\"")
3387 (if (eq id-format 'integer) "%g" "\"%G\""))))
3388
3389;; This function should return "foo/" for directories and "bar" for
3390;; files.
3391(defun tramp-handle-file-name-all-completions (filename directory)
3392 "Like `file-name-all-completions' for Tramp files."
3393 (unless (save-match-data (string-match "/" filename))
3394 (with-parsed-tramp-file-name (expand-file-name directory) nil
3395
3396 (all-completions
3397 filename
3398 (mapcar
3399 'list
3400 (or
3401 ;; Try cache first
3402 (and
3403 ;; Ignore if expired
3404 (or (not (integerp tramp-completion-reread-directory-timeout))
3405 (<= (tramp-time-diff
3406 (current-time)
3407 (tramp-get-file-property
3408 v localname "last-completion" '(0 0 0)))
3409 tramp-completion-reread-directory-timeout))
3410
3411 ;; Try cache entries for filename, filename with last
3412 ;; character removed, filename with last two characters
3413 ;; removed, ..., and finally the empty string - all
3414 ;; concatenated to the local directory name
3415
3416 ;; This is inefficient for very long filenames, pity
3417 ;; `reduce' is not available...
3418 (car
3419 (apply
3420 'append
3421 (mapcar
3422 (lambda (x)
3423 (let ((cache-hit
3424 (tramp-get-file-property
3425 v
3426 (concat localname (substring filename 0 x))
3427 "file-name-all-completions"
3428 nil)))
3429 (when cache-hit (list cache-hit))))
3430 (tramp-compat-number-sequence (length filename) 0 -1)))))
3431
3432 ;; Cache expired or no matching cache entry found so we need
3433 ;; to perform a remote operation
3434 (let (result)
3435 ;; Get a list of directories and files, including reliably
3436 ;; tagging the directories with a trailing '/'. Because I
3437 ;; rock. --daniel@danann.net
3438
3439 ;; Changed to perform `cd' in the same remote op and only
3440 ;; get entries starting with `filename'. Capture any `cd'
3441 ;; error messages. Ensure any `cd' and `echo' aliases are
3442 ;; ignored.
3443 (tramp-send-command
3444 v
3445 (if (tramp-get-remote-perl v)
3446 (progn
3447 (tramp-maybe-send-script
3448 v tramp-perl-file-name-all-completions
3449 "tramp_perl_file_name_all_completions")
3450 (format "tramp_perl_file_name_all_completions %s %s %d"
3451 (tramp-shell-quote-argument localname)
3452 (tramp-shell-quote-argument filename)
3453 (if (symbol-value
3454 ;; `read-file-name-completion-ignore-case'
3455 ;; is introduced with Emacs 22.1.
3456 (if (boundp
3457 'read-file-name-completion-ignore-case)
3458 'read-file-name-completion-ignore-case
3459 'completion-ignore-case))
3460 1 0)))
3461
3462 (format (concat
3463 "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
3464 ;; `ls' with wildcard might fail with `Argument
3465 ;; list too long' error in some corner cases; if
3466 ;; `ls' fails after `cd' succeeded, chances are
3467 ;; that's the case, so let's retry without
3468 ;; wildcard. This will return "too many" entries
3469 ;; but that isn't harmful.
3470 " || %s -a 2>/dev/null)"
3471 " | while read f; do"
3472 " if %s -d \"$f\" 2>/dev/null;"
3473 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
3474 " && \\echo ok) || \\echo fail")
3475 (tramp-shell-quote-argument localname)
3476 (tramp-get-ls-command v)
3477 ;; When `filename' is empty, just `ls' without
3478 ;; filename argument is more efficient than `ls *'
3479 ;; for very large directories and might avoid the
3480 ;; `Argument list too long' error.
3481 ;;
3482 ;; With and only with wildcard, we need to add
3483 ;; `-d' to prevent `ls' from descending into
3484 ;; sub-directories.
3485 (if (zerop (length filename))
3486 "."
3487 (concat (tramp-shell-quote-argument filename) "* -d"))
3488 (tramp-get-ls-command v)
3489 (tramp-get-test-command v))))
3490
3491 ;; Now grab the output.
3492 (with-current-buffer (tramp-get-buffer v)
3493 (goto-char (point-max))
3494
3495 ;; Check result code, found in last line of output
3496 (forward-line -1)
3497 (if (looking-at "^fail$")
3498 (progn
3499 ;; Grab error message from line before last line
3500 ;; (it was put there by `cd 2>&1')
3501 (forward-line -1)
3502 (tramp-error
3503 v 'file-error
3504 "tramp-handle-file-name-all-completions: %s"
3505 (buffer-substring
3506 (point) (tramp-compat-line-end-position))))
3507 ;; For peace of mind, if buffer doesn't end in `fail'
3508 ;; then it should end in `ok'. If neither are in the
3509 ;; buffer something went seriously wrong on the remote
3510 ;; side.
3511 (unless (looking-at "^ok$")
3512 (tramp-error
3513 v 'file-error
3514 "\
3515tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
3516 (tramp-shell-quote-argument localname) (buffer-string))))
3517
3518 (while (zerop (forward-line -1))
3519 (push (buffer-substring
3520 (point) (tramp-compat-line-end-position))
3521 result)))
3522
3523 ;; Because the remote op went through OK we know the
3524 ;; directory we `cd'-ed to exists
3525 (tramp-set-file-property
3526 v localname "file-exists-p" t)
3527
3528 ;; Because the remote op went through OK we know every
3529 ;; file listed by `ls' exists.
3530 (mapc (lambda (entry)
3531 (tramp-set-file-property
3532 v (concat localname entry) "file-exists-p" t))
3533 result)
3534
3535 (tramp-set-file-property
3536 v localname "last-completion" (current-time))
3537
3538 ;; Store result in the cache
3539 (tramp-set-file-property
3540 v (concat localname filename)
3541 "file-name-all-completions"
3542 result))))))))
3543
3544(defun tramp-handle-file-name-completion
3545 (filename directory &optional predicate)
3546 "Like `file-name-completion' for Tramp files."
3547 (unless (tramp-tramp-file-p directory)
3548 (error
3549 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
3550 directory))
3551 (try-completion
3552 filename
3553 (mapcar 'list (file-name-all-completions filename directory))
3554 (when predicate
3555 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
3556
3557;; cp, mv and ln
3558
3559(defun tramp-handle-add-name-to-file
3560 (filename newname &optional ok-if-already-exists)
3561 "Like `add-name-to-file' for Tramp files."
3562 (unless (tramp-equal-remote filename newname)
3563 (with-parsed-tramp-file-name
3564 (if (tramp-tramp-file-p filename) filename newname) nil
3565 (tramp-error
3566 v 'file-error
3567 "add-name-to-file: %s"
3568 "only implemented for same method, same user, same host")))
3569 (with-parsed-tramp-file-name filename v1
3570 (with-parsed-tramp-file-name newname v2
3571 (let ((ln (when v1 (tramp-get-remote-ln v1))))
3572 (when (and (not ok-if-already-exists)
3573 (file-exists-p newname)
3574 (not (numberp ok-if-already-exists))
3575 (y-or-n-p
3576 (format
3577 "File %s already exists; make it a new name anyway? "
3578 newname)))
3579 (tramp-error
3580 v2 'file-error
3581 "add-name-to-file: file %s already exists" newname))
3582 (tramp-flush-file-property v2 (file-name-directory v2-localname))
3583 (tramp-flush-file-property v2 v2-localname)
3584 (tramp-barf-unless-okay
3585 v1
3586 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
3587 (tramp-shell-quote-argument v2-localname))
3588 "error with add-name-to-file, see buffer `%s' for details"
3589 (buffer-name))))))
3590
3591(defun tramp-handle-copy-file
3592 (filename newname &optional ok-if-already-exists keep-date
3593 preserve-uid-gid preserve-selinux-context)
3594 "Like `copy-file' for Tramp files."
3595 (setq filename (expand-file-name filename))
3596 (setq newname (expand-file-name newname))
3597 (cond
3598 ;; At least one file a Tramp file?
3599 ((or (tramp-tramp-file-p filename)
3600 (tramp-tramp-file-p newname))
3601 (tramp-do-copy-or-rename-file
3602 'copy filename newname ok-if-already-exists keep-date
3603 preserve-uid-gid preserve-selinux-context))
3604 ;; Compat section.
3605 (preserve-selinux-context
3606 (tramp-run-real-handler
3607 'copy-file
3608 (list filename newname ok-if-already-exists keep-date
3609 preserve-uid-gid preserve-selinux-context)))
3610 (preserve-uid-gid
3611 (tramp-run-real-handler
3612 'copy-file
3613 (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
3614 (t
3615 (tramp-run-real-handler
3616 'copy-file (list filename newname ok-if-already-exists keep-date)))))
3617
3618(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
3619 "Like `copy-directory' for Tramp files."
3620 (let ((t1 (tramp-tramp-file-p dirname))
3621 (t2 (tramp-tramp-file-p newname)))
3622 (with-parsed-tramp-file-name (if t1 dirname newname) nil
3623 (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
3624 ;; When DIRNAME and NEWNAME are remote, they must have
3625 ;; the same method.
3626 (or (null t1) (null t2)
3627 (string-equal
3628 (tramp-file-name-method (tramp-dissect-file-name dirname))
3629 (tramp-file-name-method (tramp-dissect-file-name newname)))))
3630 ;; scp or rsync DTRT.
3631 (progn
3632 (setq dirname (directory-file-name (expand-file-name dirname))
3633 newname (directory-file-name (expand-file-name newname)))
3634 (if (and (file-directory-p newname)
3635 (not (string-equal (file-name-nondirectory dirname)
3636 (file-name-nondirectory newname))))
3637 (setq newname
3638 (expand-file-name
3639 (file-name-nondirectory dirname) newname)))
3640 (if (not (file-directory-p (file-name-directory newname)))
3641 (make-directory (file-name-directory newname) parents))
3642 (tramp-do-copy-or-rename-file-out-of-band
3643 'copy dirname newname keep-date))
3644 ;; We must do it file-wise.
3645 (tramp-run-real-handler
3646 'copy-directory (list dirname newname keep-date parents)))
3647
3648 ;; When newname did exist, we have wrong cached values.
3649 (when t2
3650 (with-parsed-tramp-file-name newname nil
3651 (tramp-flush-file-property v (file-name-directory localname))
3652 (tramp-flush-file-property v localname))))))
3653
3654(defun tramp-handle-rename-file
3655 (filename newname &optional ok-if-already-exists)
3656 "Like `rename-file' for Tramp files."
3657 ;; Check if both files are local -- invoke normal rename-file.
3658 ;; Otherwise, use Tramp from local system.
3659 (setq filename (expand-file-name filename))
3660 (setq newname (expand-file-name newname))
3661 ;; At least one file a Tramp file?
3662 (if (or (tramp-tramp-file-p filename)
3663 (tramp-tramp-file-p newname))
3664 (tramp-do-copy-or-rename-file
3665 'rename filename newname ok-if-already-exists t t)
3666 (tramp-run-real-handler
3667 'rename-file (list filename newname ok-if-already-exists))))
3668
3669(defun tramp-do-copy-or-rename-file
3670 (op filename newname &optional ok-if-already-exists keep-date
3671 preserve-uid-gid preserve-selinux-context)
3672 "Copy or rename a remote file.
3673OP must be `copy' or `rename' and indicates the operation to perform.
3674FILENAME specifies the file to copy or rename, NEWNAME is the name of
3675the new file (for copy) or the new name of the file (for rename).
3676OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
3677KEEP-DATE means to make sure that NEWNAME has the same timestamp
3678as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3679the uid and gid if both files are on the same host.
3680PRESERVE-SELINUX-CONTEXT activates selinux commands.
3681
3682This function is invoked by `tramp-handle-copy-file' and
3683`tramp-handle-rename-file'. It is an error if OP is neither of `copy'
3684and `rename'. FILENAME and NEWNAME must be absolute file names."
3685 (unless (memq op '(copy rename))
3686 (error "Unknown operation `%s', must be `copy' or `rename'" op))
3687 (let ((t1 (tramp-tramp-file-p filename))
3688 (t2 (tramp-tramp-file-p newname))
3689 (context (and preserve-selinux-context
3690 (apply 'file-selinux-context (list filename))))
3691 pr tm)
3692
3693 (with-parsed-tramp-file-name (if t1 filename newname) nil
3694 (when (and (not ok-if-already-exists) (file-exists-p newname))
3695 (tramp-error
3696 v 'file-already-exists "File %s already exists" newname))
3697
3698 (with-progress-reporter
3699 v 0 (format "%s %s to %s"
3700 (if (eq op 'copy) "Copying" "Renaming")
3701 filename newname)
3702
3703 (cond
3704 ;; Both are Tramp files.
3705 ((and t1 t2)
3706 (with-parsed-tramp-file-name filename v1
3707 (with-parsed-tramp-file-name newname v2
3708 (cond
3709 ;; Shortcut: if method, host, user are the same for
3710 ;; both files, we invoke `cp' or `mv' on the remote
3711 ;; host directly.
3712 ((tramp-equal-remote filename newname)
3713 (tramp-do-copy-or-rename-file-directly
3714 op filename newname
3715 ok-if-already-exists keep-date preserve-uid-gid))
3716
3717 ;; Try out-of-band operation.
3718 ((tramp-method-out-of-band-p
3719 v1 (nth 7 (file-attributes filename)))
3720 (tramp-do-copy-or-rename-file-out-of-band
3721 op filename newname keep-date))
3722
3723 ;; No shortcut was possible. So we copy the file
3724 ;; first. If the operation was `rename', we go back
3725 ;; and delete the original file (if the copy was
3726 ;; successful). The approach is simple-minded: we
3727 ;; create a new buffer, insert the contents of the
3728 ;; source file into it, then write out the buffer to
3729 ;; the target file. The advantage is that it doesn't
3730 ;; matter which filename handlers are used for the
3731 ;; source and target file.
3732 (t
3733 (tramp-do-copy-or-rename-file-via-buffer
3734 op filename newname keep-date))))))
3735
3736 ;; One file is a Tramp file, the other one is local.
3737 ((or t1 t2)
3738 (cond
3739 ;; Fast track on local machine.
3740 ((tramp-local-host-p v)
3741 (tramp-do-copy-or-rename-file-directly
3742 op filename newname
3743 ok-if-already-exists keep-date preserve-uid-gid))
3744
3745 ;; If the Tramp file has an out-of-band method, the
3746 ;; corresponding copy-program can be invoked.
3747 ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
3748 (tramp-do-copy-or-rename-file-out-of-band
3749 op filename newname keep-date))
3750
3751 ;; Use the inline method via a Tramp buffer.
3752 (t (tramp-do-copy-or-rename-file-via-buffer
3753 op filename newname keep-date))))
3754
3755 (t
3756 ;; One of them must be a Tramp file.
3757 (error "Tramp implementation says this cannot happen")))
3758
3759 ;; Handle `preserve-selinux-context'.
3760 (when context (apply 'set-file-selinux-context (list newname context)))
3761
3762 ;; In case of `rename', we must flush the cache of the source file.
3763 (when (and t1 (eq op 'rename))
3764 (with-parsed-tramp-file-name filename v1
3765 (tramp-flush-file-property v1 (file-name-directory localname))
3766 (tramp-flush-file-property v1 localname)))
3767
3768 ;; When newname did exist, we have wrong cached values.
3769 (when t2
3770 (with-parsed-tramp-file-name newname v2
3771 (tramp-flush-file-property v2 (file-name-directory localname))
3772 (tramp-flush-file-property v2 localname)))))))
3773
3774(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
3775 "Use an Emacs buffer to copy or rename a file.
3776First arg OP is either `copy' or `rename' and indicates the operation.
3777FILENAME is the source file, NEWNAME the target file.
3778KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
3779 (with-temp-buffer
3780 ;; We must disable multibyte, because binary data shall not be
3781 ;; converted.
3782 (set-buffer-multibyte nil)
3783 (let ((coding-system-for-read 'binary)
3784 (jka-compr-inhibit t))
3785 (insert-file-contents-literally filename))
3786 ;; We don't want the target file to be compressed, so we let-bind
3787 ;; `jka-compr-inhibit' to t.
3788 (let ((coding-system-for-write 'binary)
3789 (jka-compr-inhibit t))
3790 (write-region (point-min) (point-max) newname)))
3791 ;; KEEP-DATE handling.
3792 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
3793 ;; Set the mode.
3794 (set-file-modes newname (tramp-default-file-modes filename))
3795 ;; If the operation was `rename', delete the original file.
3796 (unless (eq op 'copy) (delete-file filename)))
3797
3798(defun tramp-do-copy-or-rename-file-directly
3799 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
3800 "Invokes `cp' or `mv' on the remote system.
3801OP must be one of `copy' or `rename', indicating `cp' or `mv',
3802respectively. FILENAME specifies the file to copy or rename,
3803NEWNAME is the name of the new file (for copy) or the new name of
3804the file (for rename). Both files must reside on the same host.
3805KEEP-DATE means to make sure that NEWNAME has the same timestamp
3806as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3807the uid and gid from FILENAME."
3808 (let ((t1 (tramp-tramp-file-p filename))
3809 (t2 (tramp-tramp-file-p newname))
3810 (file-times (nth 5 (file-attributes filename)))
3811 (file-modes (tramp-default-file-modes filename)))
3812 (with-parsed-tramp-file-name (if t1 filename newname) nil
3813 (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
3814 ((eq op 'copy) "cp -f")
3815 ((eq op 'rename) "mv -f")
3816 (t (tramp-error
3817 v 'file-error
3818 "Unknown operation `%s', must be `copy' or `rename'"
3819 op))))
3820 (localname1
3821 (if t1
3822 (tramp-file-name-handler 'file-remote-p filename 'localname)
3823 filename))
3824 (localname2
3825 (if t2
3826 (tramp-file-name-handler 'file-remote-p newname 'localname)
3827 newname))
3828 (prefix (file-remote-p (if t1 filename newname)))
3829 cmd-result)
3830
3831 (cond
3832 ;; Both files are on a remote host, with same user.
3833 ((and t1 t2)
3834 (setq cmd-result
3835 (tramp-send-command-and-check
3836 v
3837 (format "%s %s %s" cmd
3838 (tramp-shell-quote-argument localname1)
3839 (tramp-shell-quote-argument localname2))))
3840 (with-current-buffer (tramp-get-buffer v)
3841 (goto-char (point-min))
3842 (unless
3843 (or
3844 (and keep-date
3845 ;; Mask cp -f error.
3846 (re-search-forward
3847 tramp-operation-not-permitted-regexp nil t))
3848 (zerop cmd-result))
3849 (tramp-error-with-buffer
3850 nil v 'file-error
3851 "Copying directly failed, see buffer `%s' for details."
3852 (buffer-name)))))
3853
3854 ;; We are on the local host.
3855 ((or t1 t2)
3856 (cond
3857 ;; We can do it directly.
3858 ((let (file-name-handler-alist)
3859 (and (file-readable-p localname1)
3860 (file-writable-p (file-name-directory localname2))
3861 (or (file-directory-p localname2)
3862 (file-writable-p localname2))))
3863 (if (eq op 'copy)
3864 (tramp-compat-copy-file
3865 localname1 localname2 ok-if-already-exists
3866 keep-date preserve-uid-gid)
3867 (tramp-run-real-handler
3868 'rename-file (list localname1 localname2 ok-if-already-exists))))
3869
3870 ;; We can do it directly with `tramp-send-command'
3871 ((and (file-readable-p (concat prefix localname1))
3872 (file-writable-p
3873 (file-name-directory (concat prefix localname2)))
3874 (or (file-directory-p (concat prefix localname2))
3875 (file-writable-p (concat prefix localname2))))
3876 (tramp-do-copy-or-rename-file-directly
3877 op (concat prefix localname1) (concat prefix localname2)
3878 ok-if-already-exists keep-date t)
3879 ;; We must change the ownership to the local user.
3880 (tramp-set-file-uid-gid
3881 (concat prefix localname2)
3882 (tramp-get-local-uid 'integer)
3883 (tramp-get-local-gid 'integer)))
3884
3885 ;; We need a temporary file in between.
3886 (t
3887 ;; Create the temporary file.
3888 (let ((tmpfile (tramp-compat-make-temp-file localname1)))
3889 (unwind-protect
3890 (progn
3891 (cond
3892 (t1
3893 (or
3894 (zerop
3895 (tramp-send-command-and-check
3896 v (format
3897 "%s %s %s" cmd
3898 (tramp-shell-quote-argument localname1)
3899 (tramp-shell-quote-argument tmpfile))))
3900 (tramp-error-with-buffer
3901 nil v 'file-error
3902 "Copying directly failed, see buffer `%s' for details."
3903 (tramp-get-buffer v)))
3904 ;; We must change the ownership as remote user.
3905 ;; Since this does not work reliable, we also
3906 ;; give read permissions.
3907 (set-file-modes
3908 (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
3909 (tramp-set-file-uid-gid
3910 (concat prefix tmpfile)
3911 (tramp-get-local-uid 'integer)
3912 (tramp-get-local-gid 'integer)))
3913 (t2
3914 (if (eq op 'copy)
3915 (tramp-compat-copy-file
3916 localname1 tmpfile t
3917 keep-date preserve-uid-gid)
3918 (tramp-run-real-handler
3919 'rename-file
3920 (list localname1 tmpfile t)))
3921 ;; We must change the ownership as local user.
3922 ;; Since this does not work reliable, we also
3923 ;; give read permissions.
3924 (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
3925 (tramp-set-file-uid-gid
3926 tmpfile
3927 (tramp-get-remote-uid v 'integer)
3928 (tramp-get-remote-gid v 'integer))))
3929
3930 ;; Move the temporary file to its destination.
3931 (cond
3932 (t2
3933 (or
3934 (zerop
3935 (tramp-send-command-and-check
3936 v (format
3937 "cp -f -p %s %s"
3938 (tramp-shell-quote-argument tmpfile)
3939 (tramp-shell-quote-argument localname2))))
3940 (tramp-error-with-buffer
3941 nil v 'file-error
3942 "Copying directly failed, see buffer `%s' for details."
3943 (tramp-get-buffer v))))
3944 (t1
3945 (tramp-run-real-handler
3946 'rename-file
3947 (list tmpfile localname2 ok-if-already-exists)))))
3948
3949 ;; Save exit.
3950 (condition-case nil
3951 (delete-file tmpfile)
3952 (error)))))))))
3953
3954 ;; Set the time and mode. Mask possible errors.
3955 (condition-case nil
3956 (when keep-date
3957 (set-file-times newname file-times)
3958 (set-file-modes newname file-modes))
3959 (error)))))
3960
3961(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
3962 "Invoke rcp program to copy.
3963The method used must be an out-of-band method."
3964 (let ((t1 (tramp-tramp-file-p filename))
3965 (t2 (tramp-tramp-file-p newname))
3966 copy-program copy-args copy-env copy-keep-date port spec
3967 source target)
3968
3969 (with-parsed-tramp-file-name (if t1 filename newname) nil
3970 (if (and t1 t2)
3971
3972 ;; Both are Tramp files. We shall optimize it, when the
3973 ;; methods for filename and newname are the same.
3974 (let* ((dir-flag (file-directory-p filename))
3975 (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
3976 (if dir-flag
3977 (setq tmpfile
3978 (expand-file-name
3979 (file-name-nondirectory newname) tmpfile)))
3980 (unwind-protect
3981 (progn
3982 (tramp-do-copy-or-rename-file-out-of-band
3983 op filename tmpfile keep-date)
3984 (tramp-do-copy-or-rename-file-out-of-band
3985 'rename tmpfile newname keep-date))
3986 ;; Save exit.
3987 (condition-case nil
3988 (if dir-flag
3989 (tramp-compat-delete-directory
3990 (expand-file-name ".." tmpfile) 'recursive)
3991 (delete-file tmpfile))
3992 (error))))
3993
3994 ;; Expand hops. Might be necessary for gateway methods.
3995 (setq v (car (tramp-compute-multi-hops v)))
3996 (aset v 3 localname)
3997
3998 ;; Check which ones of source and target are Tramp files.
3999 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
4000 target (funcall
4001 (if (and (file-directory-p filename)
4002 (string-equal
4003 (file-name-nondirectory filename)
4004 (file-name-nondirectory newname)))
4005 'file-name-directory
4006 'identity)
4007 (if t2 (tramp-make-copy-program-file-name v) newname)))
4008
4009 ;; Check for port number. Until now, there's no need for handling
4010 ;; like method, user, host.
4011 (setq host (tramp-file-name-real-host v)
4012 port (tramp-file-name-port v)
4013 port (or (and port (number-to-string port)) ""))
4014
4015 ;; Compose copy command.
4016 (setq spec (format-spec-make
4017 ?h host ?u user ?p port
4018 ?t (tramp-get-connection-property
4019 (tramp-get-connection-process v) "temp-file" "")
4020 ?k (if keep-date " " ""))
4021 copy-program (tramp-get-method-parameter
4022 method 'tramp-copy-program)
4023 copy-keep-date (tramp-get-method-parameter
4024 method 'tramp-copy-keep-date)
4025 copy-args
4026 (delq
4027 nil
4028 (mapcar
4029 (lambda (x)
4030 (setq
4031 x
4032 ;; " " is indication for keep-date argument.
4033 (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
4034 (unless (member "" x) (mapconcat 'identity x " ")))
4035 (tramp-get-method-parameter method 'tramp-copy-args)))
4036 copy-env
4037 (delq
4038 nil
4039 (mapcar
4040 (lambda (x)
4041 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
4042 (unless (member "" x) (mapconcat 'identity x " ")))
4043 (tramp-get-method-parameter method 'tramp-copy-env))))
4044
4045 ;; Check for program.
4046 (when (and (fboundp 'executable-find)
4047 (not (let ((default-directory
4048 (tramp-compat-temporary-file-directory)))
4049 (executable-find copy-program))))
4050 (tramp-error
4051 v 'file-error "Cannot find copy program: %s" copy-program))
4052
4053 ;; Set variables for computing the prompt for reading
4054 ;; password.
4055 (setq tramp-current-method (tramp-file-name-method v)
4056 tramp-current-user (tramp-file-name-user v)
4057 tramp-current-host (tramp-file-name-host v))
4058
4059 (unwind-protect
4060 (with-temp-buffer
4061 ;; The default directory must be remote.
4062 (let ((default-directory
4063 (file-name-directory (if t1 filename newname)))
4064 (process-environment (copy-sequence process-environment)))
4065 ;; Set the transfer process properties.
4066 (tramp-set-connection-property
4067 v "process-name" (buffer-name (current-buffer)))
4068 (tramp-set-connection-property
4069 v "process-buffer" (current-buffer))
4070 (while copy-env
4071 (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
4072 (setenv (pop copy-env) (pop copy-env)))
4073
4074 ;; Use an asynchronous process. By this, password can
4075 ;; be handled. The default directory must be local, in
4076 ;; order to apply the correct `copy-program'. We don't
4077 ;; set a timeout, because the copying of large files can
4078 ;; last longer than 60 secs.
4079 (let ((p (let ((default-directory
4080 (tramp-compat-temporary-file-directory)))
4081 (apply 'start-process
4082 (tramp-get-connection-property
4083 v "process-name" nil)
4084 (tramp-get-connection-property
4085 v "process-buffer" nil)
4086 copy-program
4087 (append copy-args (list source target))))))
4088 (tramp-message
4089 v 6 "%s" (mapconcat 'identity (process-command p) " "))
4090 (tramp-set-process-query-on-exit-flag p nil)
4091 (tramp-process-actions p v tramp-actions-copy-out-of-band))))
4092
4093 ;; Reset the transfer process properties.
4094 (tramp-set-connection-property v "process-name" nil)
4095 (tramp-set-connection-property v "process-buffer" nil))
4096
4097 ;; Handle KEEP-DATE argument.
4098 (when (and keep-date (not copy-keep-date))
4099 (set-file-times newname (nth 5 (file-attributes filename))))
4100
4101 ;; Set the mode.
4102 (unless (and keep-date copy-keep-date)
4103 (ignore-errors
4104 (set-file-modes newname (tramp-default-file-modes filename)))))
4105
4106 ;; If the operation was `rename', delete the original file.
4107 (unless (eq op 'copy)
4108 (if (file-regular-p filename)
4109 (delete-file filename)
4110 (tramp-compat-delete-directory filename 'recursive))))))
4111
4112(defun tramp-handle-make-directory (dir &optional parents)
4113 "Like `make-directory' for Tramp files."
4114 (setq dir (expand-file-name dir))
4115 (with-parsed-tramp-file-name dir nil
4116 (tramp-flush-directory-property v (file-name-directory localname))
4117 (save-excursion
4118 (tramp-barf-unless-okay
4119 v
4120 (format "%s %s"
4121 (if parents "mkdir -p" "mkdir")
4122 (tramp-shell-quote-argument localname))
4123 "Couldn't make directory %s" dir))))
4124
4125(defun tramp-handle-delete-directory (directory &optional recursive)
4126 "Like `delete-directory' for Tramp files."
4127 (setq directory (expand-file-name directory))
4128 (with-parsed-tramp-file-name directory nil
4129 (tramp-flush-file-property v (file-name-directory localname))
4130 (tramp-flush-directory-property v localname)
4131 (unless (zerop (tramp-send-command-and-check
4132 v
4133 (format
4134 "%s %s"
4135 (if recursive "rm -rf" "rmdir")
4136 (tramp-shell-quote-argument localname))))
4137 (tramp-error v 'file-error "Couldn't delete %s" directory))))
4138
4139(defun tramp-handle-delete-file (filename &optional trash)
4140 "Like `delete-file' for Tramp files."
4141 (setq filename (expand-file-name filename))
4142 (with-parsed-tramp-file-name filename nil
4143 (tramp-flush-file-property v (file-name-directory localname))
4144 (tramp-flush-file-property v localname)
4145 (unless
4146 (zerop
4147 (tramp-send-command-and-check
4148 v (format "%s %s"
4149 (or (and trash (tramp-get-remote-trash v)) "rm -f")
4150 (tramp-shell-quote-argument localname))))
4151 (tramp-error v 'file-error "Couldn't delete %s" filename))))
4152
4153;; Dired.
4154
4155;; CCC: This does not seem to be enough. Something dies when
4156;; we try and delete two directories under Tramp :/
4157(defun tramp-handle-dired-recursive-delete-directory (filename)
4158 "Recursively delete the directory given.
4159This is like `dired-recursive-delete-directory' for Tramp files."
4160 (with-parsed-tramp-file-name filename nil
4161 ;; Run a shell command 'rm -r <localname>'
4162 ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
4163 (unless (file-exists-p filename)
4164 (tramp-error v 'file-error "No such directory: %s" filename))
4165 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
4166 (tramp-send-command
4167 v
4168 (format "rm -rf %s" (tramp-shell-quote-argument localname))
4169 ;; Don't read the output, do it explicitely.
4170 nil t)
4171 ;; Wait for the remote system to return to us...
4172 ;; This might take a while, allow it plenty of time.
4173 (tramp-wait-for-output (tramp-get-connection-process v) 120)
4174 ;; Make sure that it worked...
4175 (tramp-flush-file-property v (file-name-directory localname))
4176 (tramp-flush-directory-property v localname)
4177 (and (file-exists-p filename)
4178 (tramp-error
4179 v 'file-error "Failed to recursively delete %s" filename))))
4180
4181(defun tramp-handle-dired-compress-file (file &rest ok-flag)
4182 "Like `dired-compress-file' for Tramp files."
4183 ;; OK-FLAG is valid for XEmacs only, but not implemented.
4184 ;; Code stolen mainly from dired-aux.el.
4185 (with-parsed-tramp-file-name file nil
4186 (tramp-flush-file-property v localname)
4187 (save-excursion
4188 (let ((suffixes
4189 (if (not (featurep 'xemacs))
4190 ;; Emacs case
4191 (symbol-value 'dired-compress-file-suffixes)
4192 ;; XEmacs has `dired-compression-method-alist', which is
4193 ;; transformed into `dired-compress-file-suffixes' structure.
4194 (mapcar
4195 (lambda (x)
4196 (list (concat (regexp-quote (nth 1 x)) "\\'")
4197 nil
4198 (mapconcat 'identity (nth 3 x) " ")))
4199 (symbol-value 'dired-compression-method-alist))))
4200 suffix)
4201 ;; See if any suffix rule matches this file name.
4202 (while suffixes
4203 (let (case-fold-search)
4204 (if (string-match (car (car suffixes)) localname)
4205 (setq suffix (car suffixes) suffixes nil))
4206 (setq suffixes (cdr suffixes))))
4207
4208 (cond ((file-symlink-p file)
4209 nil)
4210 ((and suffix (nth 2 suffix))
4211 ;; We found an uncompression rule.
4212 (with-progress-reporter v 0 (format "Uncompressing %s" file)
4213 (when (zerop
4214 (tramp-send-command-and-check
4215 v (concat (nth 2 suffix) " "
4216 (tramp-shell-quote-argument localname))))
4217 ;; `dired-remove-file' is not defined in XEmacs.
4218 (tramp-compat-funcall 'dired-remove-file file)
4219 (string-match (car suffix) file)
4220 (concat (substring file 0 (match-beginning 0))))))
4221 (t
4222 ;; We don't recognize the file as compressed, so compress it.
4223 ;; Try gzip.
4224 (with-progress-reporter v 0 (format "Compressing %s" file)
4225 (when (zerop
4226 (tramp-send-command-and-check
4227 v (concat "gzip -f "
4228 (tramp-shell-quote-argument localname))))
4229 ;; `dired-remove-file' is not defined in XEmacs.
4230 (tramp-compat-funcall 'dired-remove-file file)
4231 (cond ((file-exists-p (concat file ".gz"))
4232 (concat file ".gz"))
4233 ((file-exists-p (concat file ".z"))
4234 (concat file ".z"))
4235 (t nil))))))))))
4236
4237(defun tramp-handle-dired-uncache (dir &optional dir-p)
4238 "Like `dired-uncache' for Tramp files."
4239 ;; DIR-P is valid for XEmacs only.
4240 (with-parsed-tramp-file-name
4241 (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
4242 (tramp-flush-directory-property v localname)))
4243
4244;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
4245;; not sure at all that this is the right way to do it, but let's hope
4246;; it works for now, and wait for a guru to point out the Right Way to
4247;; achieve this.
4248;;(eval-when-compile
4249;; (unless (fboundp 'dired-insert-set-properties)
4250;; (fset 'dired-insert-set-properties 'ignore)))
4251;; Gerd suggests this:
4252(eval-when-compile (require 'dired))
4253;; Note that dired is required at run-time, too, when it is needed.
4254;; It is only needed on XEmacs for the function
4255;; `dired-insert-set-properties'.
4256
4257(defun tramp-handle-insert-directory
4258 (filename switches &optional wildcard full-directory-p)
4259 "Like `insert-directory' for Tramp files."
4260 (setq filename (expand-file-name filename))
4261 (with-parsed-tramp-file-name filename nil
4262 (if (and (featurep 'ls-lisp)
4263 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
4264 (tramp-run-real-handler
4265 'insert-directory (list filename switches wildcard full-directory-p))
4266 (when (stringp switches)
4267 (setq switches (split-string switches)))
4268 (when (and (member "--dired" switches)
4269 (not (tramp-get-ls-command-with-dired v)))
4270 (setq switches (delete "--dired" switches)))
4271 (when wildcard
4272 (setq wildcard (tramp-run-real-handler
4273 'file-name-nondirectory (list localname)))
4274 (setq localname (tramp-run-real-handler
4275 'file-name-directory (list localname))))
4276 (unless full-directory-p
4277 (setq switches (add-to-list 'switches "-d" 'append)))
4278 (setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
4279 (when wildcard
4280 (setq switches (concat switches " " wildcard)))
4281 (tramp-message
4282 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
4283 switches filename (if wildcard "yes" "no")
4284 (if full-directory-p "yes" "no"))
4285 ;; If `full-directory-p', we just say `ls -l FILENAME'.
4286 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
4287 (if full-directory-p
4288 (tramp-send-command
4289 v
4290 (format "%s %s %s 2>/dev/null"
4291 (tramp-get-ls-command v)
4292 switches
4293 (if wildcard
4294 localname
4295 (tramp-shell-quote-argument (concat localname ".")))))
4296 (tramp-barf-unless-okay
4297 v
4298 (format "cd %s" (tramp-shell-quote-argument
4299 (tramp-run-real-handler
4300 'file-name-directory (list localname))))
4301 "Couldn't `cd %s'"
4302 (tramp-shell-quote-argument
4303 (tramp-run-real-handler 'file-name-directory (list localname))))
4304 (tramp-send-command
4305 v
4306 (format "%s %s %s"
4307 (tramp-get-ls-command v)
4308 switches
4309 (if (or wildcard
4310 (zerop (length
4311 (tramp-run-real-handler
4312 'file-name-nondirectory (list localname)))))
4313 ""
4314 (tramp-shell-quote-argument
4315 (tramp-run-real-handler
4316 'file-name-nondirectory (list localname)))))))
4317 (let ((beg (point)))
4318 ;; We cannot use `insert-buffer-substring' because the Tramp
4319 ;; buffer changes its contents before insertion due to calling
4320 ;; `expand-file' and alike.
4321 (insert
4322 (with-current-buffer (tramp-get-buffer v)
4323 (buffer-string)))
4324
4325 ;; Check for "--dired" output.
4326 (forward-line -2)
4327 (when (looking-at "//SUBDIRED//")
4328 (forward-line -1))
4329 (when (looking-at "//DIRED//\\s-+")
4330 (let ((databeg (match-end 0))
4331 (end (tramp-compat-line-end-position)))
4332 ;; Now read the numeric positions of file names.
4333 (goto-char databeg)
4334 (while (< (point) end)
4335 (let ((start (+ beg (read (current-buffer))))
4336 (end (+ beg (read (current-buffer)))))
4337 (if (memq (char-after end) '(?\n ?\ ))
4338 ;; End is followed by \n or by " -> ".
4339 (put-text-property start end 'dired-filename t))))))
4340 ;; Remove trailing lines.
4341 (goto-char (tramp-compat-line-beginning-position))
4342 (while (looking-at "//")
4343 (forward-line 1)
4344 (delete-region (match-beginning 0) (point)))
4345
4346 ;; The inserted file could be from somewhere else.
4347 (when (and (not wildcard) (not full-directory-p))
4348 (goto-char (point-max))
4349 (when (file-symlink-p filename)
4350 (goto-char (search-backward "->" beg 'noerror)))
4351 (search-backward
4352 (if (zerop (length (file-name-nondirectory filename)))
4353 "."
4354 (file-name-nondirectory filename))
4355 beg 'noerror)
4356 (replace-match (file-relative-name filename) t))
4357
4358 (goto-char (point-max))))))
4359
4360(defun tramp-handle-unhandled-file-name-directory (filename)
4361 "Like `unhandled-file-name-directory' for Tramp files."
4362 ;; With Emacs 23, we could simply return `nil'. But we must keep it
4363 ;; for backward compatibility.
4364 (expand-file-name "~/"))
4365
4366;; Canonicalization of file names.
4367
4368(defun tramp-handle-expand-file-name (name &optional dir)
4369 "Like `expand-file-name' for Tramp files.
4370If the localname part of the given filename starts with \"/../\" then
4371the result will be a local, non-Tramp, filename."
4372 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
4373 (setq dir (or dir default-directory "/"))
4374 ;; Unless NAME is absolute, concat DIR and NAME.
4375 (unless (file-name-absolute-p name)
4376 (setq name (concat (file-name-as-directory dir) name)))
4377 ;; If NAME is not a Tramp file, run the real handler.
4378 (if (not (tramp-connectable-p name))
4379 (tramp-run-real-handler 'expand-file-name (list name nil))
4380 ;; Dissect NAME.
4381 (with-parsed-tramp-file-name name nil
4382 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
4383 (setq localname (concat "~/" localname)))
4384 ;; Tilde expansion if necessary. This needs a shell which
4385 ;; groks tilde expansion! The function `tramp-find-shell' is
4386 ;; supposed to find such a shell on the remote host. Please
4387 ;; tell me about it when this doesn't work on your system.
4388 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
4389 (let ((uname (match-string 1 localname))
4390 (fname (match-string 2 localname)))
4391 ;; We cannot simply apply "~/", because under sudo "~/" is
4392 ;; expanded to the local user home directory but to the
4393 ;; root home directory. On the other hand, using always
4394 ;; the default user name for tilde expansion is not
4395 ;; appropriate either, because ssh and companions might
4396 ;; use a user name from the config file.
4397 (when (and (string-equal uname "~")
4398 (string-match "\\`su\\(do\\)?\\'" method))
4399 (setq uname (concat uname user)))
4400 (setq uname
4401 (with-connection-property v uname
4402 (tramp-send-command
4403 v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
4404 (with-current-buffer (tramp-get-buffer v)
4405 (goto-char (point-min))
4406 (buffer-substring
4407 (point) (tramp-compat-line-end-position)))))
4408 (setq localname (concat uname fname))))
4409 ;; There might be a double slash, for example when "~/"
4410 ;; expands to "/". Remove this.
4411 (while (string-match "//" localname)
4412 (setq localname (replace-match "/" t t localname)))
4413 ;; No tilde characters in file name, do normal
4414 ;; `expand-file-name' (this does "/./" and "/../"). We bind
4415 ;; `directory-sep-char' here for XEmacs on Windows, which would
4416 ;; otherwise use backslash. `default-directory' is bound,
4417 ;; because on Windows there would be problems with UNC shares or
4418 ;; Cygwin mounts.
4419 (let ((directory-sep-char ?/)
4420 (default-directory (tramp-compat-temporary-file-directory)))
4421 (tramp-make-tramp-file-name
4422 method user host
4423 (tramp-drop-volume-letter
4424 (tramp-run-real-handler
4425 'expand-file-name (list localname))))))))
4426 1616
4427(defun tramp-replace-environment-variables (filename) 1617(defun tramp-replace-environment-variables (filename)
4428 "Replace environment variables in FILENAME. 1618 "Replace environment variables in FILENAME.
@@ -4439,38 +1629,6 @@ Return the string with the replaced variables."
4439 t nil filename))) 1629 t nil filename)))
4440 filename))) 1630 filename)))
4441 1631
4442(defun tramp-handle-substitute-in-file-name (filename)
4443 "Like `substitute-in-file-name' for Tramp files.
4444\"//\" and \"/~\" substitute only in the local filename part.
4445If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
4446beginning of local filename are not substituted."
4447 ;; First, we must replace environment variables.
4448 (setq filename (tramp-replace-environment-variables filename))
4449 (with-parsed-tramp-file-name filename nil
4450 (if (equal tramp-syntax 'url)
4451 ;; We need to check localname only. The other parts cannot contain
4452 ;; "//" or "/~".
4453 (if (and (> (length localname) 1)
4454 (or (string-match "//" localname)
4455 (string-match "/~" localname 1)))
4456 (tramp-run-real-handler 'substitute-in-file-name (list filename))
4457 (tramp-make-tramp-file-name
4458 (when method (substitute-in-file-name method))
4459 (when user (substitute-in-file-name user))
4460 (when host (substitute-in-file-name host))
4461 (when localname
4462 (tramp-run-real-handler
4463 'substitute-in-file-name (list localname)))))
4464 ;; Ignore in LOCALNAME everything before "//" or "/~".
4465 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
4466 (setq filename
4467 (concat (file-remote-p filename)
4468 (replace-match "\\1" nil nil localname)))
4469 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
4470 (when (string-match "~$" filename)
4471 (setq filename (concat filename "/"))))
4472 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
4473
4474;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, 1632;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
4475;; which calls corresponding functions (see minibuf.el). 1633;; which calls corresponding functions (see minibuf.el).
4476(when (fboundp 'minibuffer-electric-separator) 1634(when (fboundp 'minibuffer-electric-separator)
@@ -4500,406 +1658,9 @@ beginning of local filename are not substituted."
4500 '(minibuffer-electric-separator 1658 '(minibuffer-electric-separator
4501 minibuffer-electric-tilde))) 1659 minibuffer-electric-tilde)))
4502 1660
4503
4504;;; Remote commands:
4505
4506(defun tramp-handle-executable-find (command)
4507 "Like `executable-find' for Tramp files."
4508 (with-parsed-tramp-file-name default-directory nil
4509 (tramp-find-executable v command (tramp-get-remote-path v) t)))
4510
4511(defun tramp-process-sentinel (proc event)
4512 "Flush file caches."
4513 (unless (memq (process-status proc) '(run open))
4514 (let ((vec (tramp-get-connection-property proc "vector" nil)))
4515 (when vec
4516 (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event)
4517 (tramp-flush-directory-property vec "")))))
4518
4519;; We use BUFFER also as connection buffer during setup. Because of
4520;; this, its original contents must be saved, and restored once
4521;; connection has been setup.
4522(defun tramp-handle-start-file-process (name buffer program &rest args)
4523 "Like `start-file-process' for Tramp files."
4524 (with-parsed-tramp-file-name default-directory nil
4525 (unwind-protect
4526 ;; When PROGRAM is nil, we just provide a tty.
4527 (let ((command
4528 (when (stringp program)
4529 (format "cd %s; exec %s"
4530 (tramp-shell-quote-argument localname)
4531 (mapconcat 'tramp-shell-quote-argument
4532 (cons program args) " "))))
4533 (tramp-process-connection-type
4534 (or (null program) tramp-process-connection-type))
4535 (name1 name)
4536 (i 0))
4537 (unless buffer
4538 ;; BUFFER can be nil. We use a temporary buffer.
4539 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
4540 (while (get-process name1)
4541 ;; NAME must be unique as process name.
4542 (setq i (1+ i)
4543 name1 (format "%s<%d>" name i)))
4544 (setq name name1)
4545 ;; Set the new process properties.
4546 (tramp-set-connection-property v "process-name" name)
4547 (tramp-set-connection-property v "process-buffer" buffer)
4548 ;; Activate narrowing in order to save BUFFER contents.
4549 ;; Clear also the modification time; otherwise we might be
4550 ;; interrupted by `verify-visited-file-modtime'.
4551 (with-current-buffer (tramp-get-connection-buffer v)
4552 (clear-visited-file-modtime)
4553 (narrow-to-region (point-max) (point-max)))
4554 (if command
4555 ;; Send the command.
4556 (tramp-send-command v command nil t) ; nooutput
4557 ;; Check, whether a pty is associated.
4558 (tramp-maybe-open-connection v)
4559 (unless (process-get (tramp-get-connection-process v) 'remote-tty)
4560 (tramp-error
4561 v 'file-error "pty association is not supported for `%s'" name)))
4562 (let ((p (tramp-get-connection-process v)))
4563 ;; Set sentinel and query flag for this process.
4564 (tramp-set-connection-property p "vector" v)
4565 (set-process-sentinel p 'tramp-process-sentinel)
4566 (tramp-set-process-query-on-exit-flag p t)
4567 ;; Return process.
4568 p))
4569 ;; Save exit.
4570 (with-current-buffer (tramp-get-connection-buffer v)
4571 (if (string-match tramp-temp-buffer-name (buffer-name))
4572 (progn
4573 (set-process-buffer (tramp-get-connection-process v) nil)
4574 (kill-buffer (current-buffer)))
4575 (widen)
4576 (goto-char (point-max))))
4577 (tramp-set-connection-property v "process-name" nil)
4578 (tramp-set-connection-property v "process-buffer" nil))))
4579
4580(defun tramp-handle-process-file
4581 (program &optional infile destination display &rest args)
4582 "Like `process-file' for Tramp files."
4583 ;; The implementation is not complete yet.
4584 (when (and (numberp destination) (zerop destination))
4585 (error "Implementation does not handle immediate return"))
4586
4587 (with-parsed-tramp-file-name default-directory nil
4588 (let (command input tmpinput stderr tmpstderr outbuf ret)
4589 ;; Compute command.
4590 (setq command (mapconcat 'tramp-shell-quote-argument
4591 (cons program args) " "))
4592 ;; Determine input.
4593 (if (null infile)
4594 (setq input "/dev/null")
4595 (setq infile (expand-file-name infile))
4596 (if (tramp-equal-remote default-directory infile)
4597 ;; INFILE is on the same remote host.
4598 (setq input (with-parsed-tramp-file-name infile nil localname))
4599 ;; INFILE must be copied to remote host.
4600 (setq input (tramp-make-tramp-temp-file v)
4601 tmpinput (tramp-make-tramp-file-name method user host input))
4602 (copy-file infile tmpinput t)))
4603 (when input (setq command (format "%s <%s" command input)))
4604
4605 ;; Determine output.
4606 (cond
4607 ;; Just a buffer.
4608 ((bufferp destination)
4609 (setq outbuf destination))
4610 ;; A buffer name.
4611 ((stringp destination)
4612 (setq outbuf (get-buffer-create destination)))
4613 ;; (REAL-DESTINATION ERROR-DESTINATION)
4614 ((consp destination)
4615 ;; output.
4616 (cond
4617 ((bufferp (car destination))
4618 (setq outbuf (car destination)))
4619 ((stringp (car destination))
4620 (setq outbuf (get-buffer-create (car destination))))
4621 ((car destination)
4622 (setq outbuf (current-buffer))))
4623 ;; stderr.
4624 (cond
4625 ((stringp (cadr destination))
4626 (setcar (cdr destination) (expand-file-name (cadr destination)))
4627 (if (tramp-equal-remote default-directory (cadr destination))
4628 ;; stderr is on the same remote host.
4629 (setq stderr (with-parsed-tramp-file-name
4630 (cadr destination) nil localname))
4631 ;; stderr must be copied to remote host. The temporary
4632 ;; file must be deleted after execution.
4633 (setq stderr (tramp-make-tramp-temp-file v)
4634 tmpstderr (tramp-make-tramp-file-name
4635 method user host stderr))))
4636 ;; stderr to be discarded.
4637 ((null (cadr destination))
4638 (setq stderr "/dev/null"))))
4639 ;; 't
4640 (destination
4641 (setq outbuf (current-buffer))))
4642 (when stderr (setq command (format "%s 2>%s" command stderr)))
4643
4644 ;; Send the command. It might not return in time, so we protect
4645 ;; it. Call it in a subshell, in order to preserve working
4646 ;; directory.
4647 (condition-case nil
4648 (unwind-protect
4649 (setq ret
4650 (tramp-send-command-and-check
4651 v (format "\\cd %s; %s"
4652 (tramp-shell-quote-argument localname)
4653 command)
4654 t t))
4655 ;; We should show the output anyway.
4656 (when outbuf
4657 (with-current-buffer outbuf
4658 (insert
4659 (with-current-buffer (tramp-get-connection-buffer v)
4660 (buffer-string))))
4661 (when display (display-buffer outbuf))))
4662 ;; When the user did interrupt, we should do it also. We use
4663 ;; return code -1 as marker.
4664 (quit
4665 (kill-buffer (tramp-get-connection-buffer v))
4666 (setq ret -1))
4667 ;; Handle errors.
4668 (error
4669 (kill-buffer (tramp-get-connection-buffer v))
4670 (setq ret 1)))
4671
4672 ;; Provide error file.
4673 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
4674
4675 ;; Cleanup. We remove all file cache values for the connection,
4676 ;; because the remote process could have changed them.
4677 (when tmpinput (delete-file tmpinput))
4678
4679 ;; `process-file-side-effects' has been introduced with GNU
4680 ;; Emacs 23.2. If set to `nil', no remote file will be changed
4681 ;; by `program'. If it doesn't exist, we assume its default
4682 ;; value 't'.
4683 (unless (and (boundp 'process-file-side-effects)
4684 (not (symbol-value 'process-file-side-effects)))
4685 (tramp-flush-directory-property v ""))
4686
4687 ;; Return exit status.
4688 (if (equal ret -1)
4689 (keyboard-quit)
4690 ret))))
4691
4692(defun tramp-local-call-process
4693 (program &optional infile destination display &rest args)
4694 "Calls `call-process' on the local host.
4695This is needed because for some Emacs flavors Tramp has
4696defadviced `call-process' to behave like `process-file'. The
4697Lisp error raised when PROGRAM is nil is trapped also, returning 1."
4698 (let ((default-directory
4699 (if (file-remote-p default-directory)
4700 (tramp-compat-temporary-file-directory)
4701 default-directory)))
4702 (if (executable-find program)
4703 (apply 'call-process program infile destination display args)
4704 1)))
4705
4706(defun tramp-handle-call-process-region
4707 (start end program &optional delete buffer display &rest args)
4708 "Like `call-process-region' for Tramp files."
4709 (let ((tmpfile (tramp-compat-make-temp-file "")))
4710 (write-region start end tmpfile)
4711 (when delete (delete-region start end))
4712 (unwind-protect
4713 (apply 'call-process program tmpfile buffer display args)
4714 (delete-file tmpfile))))
4715
4716(defun tramp-handle-shell-command
4717 (command &optional output-buffer error-buffer)
4718 "Like `shell-command' for Tramp files."
4719 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
4720 ;; We cannot use `shell-file-name' and `shell-command-switch',
4721 ;; they are variables of the local host.
4722 (args (list
4723 (tramp-get-method-parameter
4724 (tramp-file-name-method
4725 (tramp-dissect-file-name default-directory))
4726 'tramp-remote-sh)
4727 "-c" (substring command 0 asynchronous)))
4728 current-buffer-p
4729 (output-buffer
4730 (cond
4731 ((bufferp output-buffer) output-buffer)
4732 ((stringp output-buffer) (get-buffer-create output-buffer))
4733 (output-buffer
4734 (setq current-buffer-p t)
4735 (current-buffer))
4736 (t (get-buffer-create
4737 (if asynchronous
4738 "*Async Shell Command*"
4739 "*Shell Command Output*")))))
4740 (error-buffer
4741 (cond
4742 ((bufferp error-buffer) error-buffer)
4743 ((stringp error-buffer) (get-buffer-create error-buffer))))
4744 (buffer
4745 (if (and (not asynchronous) error-buffer)
4746 (with-parsed-tramp-file-name default-directory nil
4747 (list output-buffer (tramp-make-tramp-temp-file v)))
4748 output-buffer))
4749 (p (get-buffer-process output-buffer)))
4750
4751 ;; Check whether there is another process running. Tramp does not
4752 ;; support 2 (asynchronous) processes in parallel.
4753 (when p
4754 (if (yes-or-no-p "A command is running. Kill it? ")
4755 (condition-case nil
4756 (kill-process p)
4757 (error nil))
4758 (error "Shell command in progress")))
4759
4760 (if current-buffer-p
4761 (progn
4762 (barf-if-buffer-read-only)
4763 (push-mark nil t))
4764 (with-current-buffer output-buffer
4765 (setq buffer-read-only nil)
4766 (erase-buffer)))
4767
4768 (if (and (not current-buffer-p) (integerp asynchronous))
4769 (prog1
4770 ;; Run the process.
4771 (apply 'start-file-process "*Async Shell*" buffer args)
4772 ;; Display output.
4773 (pop-to-buffer output-buffer)
4774 (setq mode-line-process '(":%s"))
4775 (require 'shell) (shell-mode))
4776
4777 (prog1
4778 ;; Run the process.
4779 (apply 'process-file (car args) nil buffer nil (cdr args))
4780 ;; Insert error messages if they were separated.
4781 (when (listp buffer)
4782 (with-current-buffer error-buffer
4783 (insert-file-contents (cadr buffer)))
4784 (delete-file (cadr buffer)))
4785 (if current-buffer-p
4786 ;; This is like exchange-point-and-mark, but doesn't
4787 ;; activate the mark. It is cleaner to avoid activation,
4788 ;; even though the command loop would deactivate the mark
4789 ;; because we inserted text.
4790 (goto-char (prog1 (mark t)
4791 (set-marker (mark-marker) (point)
4792 (current-buffer))))
4793 ;; There's some output, display it.
4794 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
4795 (if (functionp 'display-message-or-buffer)
4796 (tramp-compat-funcall 'display-message-or-buffer output-buffer)
4797 (pop-to-buffer output-buffer))))))))
4798
4799;; File Editing.
4800
4801(defvar tramp-handle-file-local-copy-hook nil 1661(defvar tramp-handle-file-local-copy-hook nil
4802 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.") 1662 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.")
4803 1663
4804(defun tramp-handle-file-local-copy (filename)
4805 "Like `file-local-copy' for Tramp files."
4806
4807 (with-parsed-tramp-file-name filename nil
4808 (unless (file-exists-p filename)
4809 (tramp-error
4810 v 'file-error
4811 "Cannot make local copy of non-existing file `%s'" filename))
4812
4813 (let* ((size (nth 7 (file-attributes filename)))
4814 (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
4815 (loc-dec (tramp-get-inline-coding v "local-decoding" size))
4816 (tmpfile (tramp-compat-make-temp-file filename)))
4817
4818 (condition-case err
4819 (cond
4820 ;; `copy-file' handles direct copy and out-of-band methods.
4821 ((or (tramp-local-host-p v)
4822 (tramp-method-out-of-band-p v size))
4823 (copy-file filename tmpfile t t))
4824
4825 ;; Use inline encoding for file transfer.
4826 (rem-enc
4827 (save-excursion
4828 (with-progress-reporter
4829 v 3 (format "Encoding remote file %s" filename)
4830 (tramp-barf-unless-okay
4831 v (format rem-enc (tramp-shell-quote-argument localname))
4832 "Encoding remote file failed"))
4833
4834 (if (functionp loc-dec)
4835 ;; If local decoding is a function, we call it. We
4836 ;; must disable multibyte, because
4837 ;; `uudecode-decode-region' doesn't handle it
4838 ;; correctly.
4839 (with-temp-buffer
4840 (set-buffer-multibyte nil)
4841 (insert-buffer-substring (tramp-get-buffer v))
4842 (with-progress-reporter
4843 v 3 (format "Decoding remote file %s with function %s"
4844 filename loc-dec)
4845 (funcall loc-dec (point-min) (point-max))
4846 ;; Unset `file-name-handler-alist'. Otherwise,
4847 ;; epa-file gets confused.
4848 (let (file-name-handler-alist
4849 (coding-system-for-write 'binary))
4850 (write-region (point-min) (point-max) tmpfile))))
4851
4852 ;; If tramp-decoding-function is not defined for this
4853 ;; method, we invoke tramp-decoding-command instead.
4854 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
4855 ;; Unset `file-name-handler-alist'. Otherwise,
4856 ;; epa-file gets confused.
4857 (let (file-name-handler-alist
4858 (coding-system-for-write 'binary))
4859 (write-region (point-min) (point-max) tmpfile2))
4860 (with-progress-reporter
4861 v 3 (format "Decoding remote file %s with command %s"
4862 filename loc-dec)
4863 (unwind-protect
4864 (tramp-call-local-coding-command
4865 loc-dec tmpfile2 tmpfile)
4866 (delete-file tmpfile2)))))
4867
4868 ;; Set proper permissions.
4869 (set-file-modes tmpfile (tramp-default-file-modes filename))
4870 ;; Set local user ownership.
4871 (tramp-set-file-uid-gid tmpfile)))
4872
4873 ;; Oops, I don't know what to do.
4874 (t (tramp-error
4875 v 'file-error "Wrong method specification for `%s'" method)))
4876
4877 ;; Error handling.
4878 ((error quit)
4879 (delete-file tmpfile)
4880 (signal (car err) (cdr err))))
4881
4882 (run-hooks 'tramp-handle-file-local-copy-hook)
4883 tmpfile)))
4884
4885(defun tramp-handle-file-remote-p (filename &optional identification connected)
4886 "Like `file-remote-p' for Tramp files."
4887 (let ((tramp-verbose 3))
4888 (when (tramp-tramp-file-p filename)
4889 (let* ((v (tramp-dissect-file-name filename))
4890 (p (tramp-get-connection-process v))
4891 (c (and p (processp p) (memq (process-status p) '(run open)))))
4892 ;; We expand the file name only, if there is already a connection.
4893 (with-parsed-tramp-file-name
4894 (if c (expand-file-name filename) filename) nil
4895 (and (or (not connected) c)
4896 (cond
4897 ((eq identification 'method) method)
4898 ((eq identification 'user) user)
4899 ((eq identification 'host) host)
4900 ((eq identification 'localname) localname)
4901 (t (tramp-make-tramp-file-name method user host "")))))))))
4902
4903(defun tramp-find-file-name-coding-system-alist (filename tmpname) 1664(defun tramp-find-file-name-coding-system-alist (filename tmpname)
4904 "Like `find-operation-coding-system' for Tramp filenames. 1665 "Like `find-operation-coding-system' for Tramp filenames.
4905Tramp's `insert-file-contents' and `write-region' work over 1666Tramp's `insert-file-contents' and `write-region' work over
@@ -4915,532 +1676,6 @@ coding system might not be determined. This function repairs it."
4915 (add-to-list 1676 (add-to-list
4916 'result (cons (regexp-quote tmpname) (cdr elt)) 'append))))) 1677 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
4917 1678
4918(defun tramp-handle-insert-file-contents
4919 (filename &optional visit beg end replace)
4920 "Like `insert-file-contents' for Tramp files."
4921 (barf-if-buffer-read-only)
4922 (setq filename (expand-file-name filename))
4923 (let (result local-copy remote-copy)
4924 (with-parsed-tramp-file-name filename nil
4925 (unwind-protect
4926 (if (not (file-exists-p filename))
4927 ;; We don't raise a Tramp error, because it might be
4928 ;; suppressed, like in `find-file-noselect-1'.
4929 (signal 'file-error
4930 (list "File not found on remote host" filename))
4931
4932 (if (and (tramp-local-host-p v)
4933 (let (file-name-handler-alist)
4934 (file-readable-p localname)))
4935 ;; Short track: if we are on the local host, we can
4936 ;; run directly.
4937 (setq result
4938 (tramp-run-real-handler
4939 'insert-file-contents
4940 (list localname visit beg end replace)))
4941
4942 ;; When we shall insert only a part of the file, we copy
4943 ;; this part.
4944 (when (or beg end)
4945 (setq remote-copy (tramp-make-tramp-temp-file v))
4946 (tramp-send-command
4947 v
4948 (cond
4949 ((and beg end)
4950 (format "tail -c +%d %s | head -c +%d >%s"
4951 (1+ beg) (tramp-shell-quote-argument localname)
4952 (- end beg) remote-copy))
4953 (beg
4954 (format "tail -c +%d %s >%s"
4955 (1+ beg) (tramp-shell-quote-argument localname)
4956 remote-copy))
4957 (end
4958 (format "head -c +%d %s >%s"
4959 (1+ end) (tramp-shell-quote-argument localname)
4960 remote-copy)))))
4961
4962 ;; `insert-file-contents-literally' takes care to avoid
4963 ;; calling jka-compr. By let-binding
4964 ;; `inhibit-file-name-operation', we propagate that care
4965 ;; to the `file-local-copy' operation.
4966 (setq local-copy
4967 (let ((inhibit-file-name-operation
4968 (when (eq inhibit-file-name-operation
4969 'insert-file-contents)
4970 'file-local-copy)))
4971 (cond
4972 ((stringp remote-copy)
4973 (file-local-copy
4974 (tramp-make-tramp-file-name
4975 method user host remote-copy)))
4976 ((stringp tramp-temp-buffer-file-name)
4977 (copy-file filename tramp-temp-buffer-file-name 'ok)
4978 tramp-temp-buffer-file-name)
4979 (t (file-local-copy filename)))))
4980
4981 ;; When the file is not readable for the owner, it
4982 ;; cannot be inserted, even it is redable for the group
4983 ;; or for everybody.
4984 (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
4985
4986 (when (and (null remote-copy)
4987 (tramp-get-method-parameter
4988 method 'tramp-copy-keep-tmpfile))
4989 ;; We keep the local file for performance reasons,
4990 ;; useful for "rsync".
4991 (setq tramp-temp-buffer-file-name local-copy)
4992 (put 'tramp-temp-buffer-file-name 'permanent-local t))
4993
4994 (with-progress-reporter
4995 v 3 (format "Inserting local temp file `%s'" local-copy)
4996 ;; We must ensure that `file-coding-system-alist'
4997 ;; matches `local-copy'.
4998 (let ((file-coding-system-alist
4999 (tramp-find-file-name-coding-system-alist
5000 filename local-copy)))
5001 (setq result
5002 (insert-file-contents
5003 local-copy nil nil nil replace))))))
5004
5005 ;; Save exit.
5006 (progn
5007 (when visit
5008 (setq buffer-file-name filename)
5009 (setq buffer-read-only (not (file-writable-p filename)))
5010 (set-visited-file-modtime)
5011 (set-buffer-modified-p nil))
5012 (when (and (stringp local-copy)
5013 (or remote-copy (null tramp-temp-buffer-file-name)))
5014 (delete-file local-copy))
5015 (when (stringp remote-copy)
5016 (delete-file
5017 (tramp-make-tramp-file-name method user host remote-copy))))))
5018
5019 ;; Result.
5020 (list (expand-file-name filename)
5021 (cadr result))))
5022
5023;; This is needed for XEmacs only. Code stolen from files.el.
5024(defun tramp-handle-insert-file-contents-literally
5025 (filename &optional visit beg end replace)
5026 "Like `insert-file-contents-literally' for Tramp files."
5027 (let ((format-alist nil)
5028 (after-insert-file-functions nil)
5029 (coding-system-for-read 'no-conversion)
5030 (coding-system-for-write 'no-conversion)
5031 (find-buffer-file-type-function
5032 (if (fboundp 'find-buffer-file-type)
5033 (symbol-function 'find-buffer-file-type)
5034 nil))
5035 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
5036 (inhibit-file-name-operation 'insert-file-contents))
5037 (unwind-protect
5038 (progn
5039 (fset 'find-buffer-file-type (lambda (filename) t))
5040 (insert-file-contents filename visit beg end replace))
5041 ;; Save exit.
5042 (if find-buffer-file-type-function
5043 (fset 'find-buffer-file-type find-buffer-file-type-function)
5044 (fmakunbound 'find-buffer-file-type)))))
5045
5046(defun tramp-handle-find-backup-file-name (filename)
5047 "Like `find-backup-file-name' for Tramp files."
5048 (with-parsed-tramp-file-name filename nil
5049 ;; We set both variables. It doesn't matter whether it is
5050 ;; Emacs or XEmacs.
5051 (let ((backup-directory-alist
5052 ;; Emacs case.
5053 (when (boundp 'backup-directory-alist)
5054 (if (symbol-value 'tramp-backup-directory-alist)
5055 (mapcar
5056 (lambda (x)
5057 (cons
5058 (car x)
5059 (if (and (stringp (cdr x))
5060 (file-name-absolute-p (cdr x))
5061 (not (tramp-file-name-p (cdr x))))
5062 (tramp-make-tramp-file-name method user host (cdr x))
5063 (cdr x))))
5064 (symbol-value 'tramp-backup-directory-alist))
5065 (symbol-value 'backup-directory-alist))))
5066
5067 (bkup-backup-directory-info
5068 ;; XEmacs case.
5069 (when (boundp 'bkup-backup-directory-info)
5070 (if (symbol-value 'tramp-bkup-backup-directory-info)
5071 (mapcar
5072 (lambda (x)
5073 (nconc
5074 (list (car x))
5075 (list
5076 (if (and (stringp (car (cdr x)))
5077 (file-name-absolute-p (car (cdr x)))
5078 (not (tramp-file-name-p (car (cdr x)))))
5079 (tramp-make-tramp-file-name
5080 method user host (car (cdr x)))
5081 (car (cdr x))))
5082 (cdr (cdr x))))
5083 (symbol-value 'tramp-bkup-backup-directory-info))
5084 (symbol-value 'bkup-backup-directory-info)))))
5085
5086 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
5087
5088(defun tramp-handle-make-auto-save-file-name ()
5089 "Like `make-auto-save-file-name' for Tramp files.
5090Returns a file name in `tramp-auto-save-directory' for autosaving this file."
5091 (let ((tramp-auto-save-directory tramp-auto-save-directory)
5092 (buffer-file-name
5093 (tramp-subst-strs-in-string
5094 '(("_" . "|")
5095 ("/" . "_a")
5096 (":" . "_b")
5097 ("|" . "__")
5098 ("[" . "_l")
5099 ("]" . "_r"))
5100 (buffer-file-name))))
5101 ;; File name must be unique. This is ensured with Emacs 22 (see
5102 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
5103 ;; all other cases we must do it ourselves.
5104 (when (boundp 'auto-save-file-name-transforms)
5105 (mapc
5106 (lambda (x)
5107 (when (and (string-match (car x) buffer-file-name)
5108 (not (car (cddr x))))
5109 (setq tramp-auto-save-directory
5110 (or tramp-auto-save-directory
5111 (tramp-compat-temporary-file-directory)))))
5112 (symbol-value 'auto-save-file-name-transforms)))
5113 ;; Create directory.
5114 (when tramp-auto-save-directory
5115 (setq buffer-file-name
5116 (expand-file-name buffer-file-name tramp-auto-save-directory))
5117 (unless (file-exists-p tramp-auto-save-directory)
5118 (make-directory tramp-auto-save-directory t)))
5119 ;; Run plain `make-auto-save-file-name'. There might be an advice when
5120 ;; it is not a magic file name operation (since Emacs 22).
5121 ;; We must deactivate it temporarily.
5122 (if (not (ad-is-active 'make-auto-save-file-name))
5123 (tramp-run-real-handler 'make-auto-save-file-name nil)
5124 ;; else
5125 (ad-deactivate 'make-auto-save-file-name)
5126 (prog1
5127 (tramp-run-real-handler 'make-auto-save-file-name nil)
5128 (ad-activate 'make-auto-save-file-name)))))
5129
5130(defvar tramp-handle-write-region-hook nil
5131 "Normal hook to be run at the end of `tramp-handle-write-region'.")
5132
5133;; CCC grok LOCKNAME
5134(defun tramp-handle-write-region
5135 (start end filename &optional append visit lockname confirm)
5136 "Like `write-region' for Tramp files."
5137 (setq filename (expand-file-name filename))
5138 (with-parsed-tramp-file-name filename nil
5139 ;; Following part commented out because we don't know what to do about
5140 ;; file locking, and it does not appear to be a problem to ignore it.
5141 ;; Ange-ftp ignores it, too.
5142 ;; (when (and lockname (stringp lockname))
5143 ;; (setq lockname (expand-file-name lockname)))
5144 ;; (unless (or (eq lockname nil)
5145 ;; (string= lockname filename))
5146 ;; (error
5147 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
5148
5149 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
5150 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
5151 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
5152 (tramp-error v 'file-error "File not overwritten")))
5153
5154 (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
5155 (tramp-get-remote-uid v 'integer)))
5156 (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
5157 (tramp-get-remote-gid v 'integer))))
5158
5159 (if (and (tramp-local-host-p v)
5160 ;; `file-writable-p' calls `file-expand-file-name'. We
5161 ;; cannot use `tramp-run-real-handler' therefore.
5162 (let (file-name-handler-alist)
5163 (and
5164 (file-writable-p (file-name-directory localname))
5165 (or (file-directory-p localname)
5166 (file-writable-p localname)))))
5167 ;; Short track: if we are on the local host, we can run directly.
5168 (tramp-run-real-handler
5169 'write-region
5170 (list start end localname append 'no-message lockname confirm))
5171
5172 (let ((modes (save-excursion (tramp-default-file-modes filename)))
5173 ;; We use this to save the value of
5174 ;; `last-coding-system-used' after writing the tmp
5175 ;; file. At the end of the function, we set
5176 ;; `last-coding-system-used' to this saved value. This
5177 ;; way, any intermediary coding systems used while
5178 ;; talking to the remote shell or suchlike won't hose
5179 ;; this variable. This approach was snarfed from
5180 ;; ange-ftp.el.
5181 coding-system-used
5182 ;; Write region into a tmp file. This isn't really
5183 ;; needed if we use an encoding function, but currently
5184 ;; we use it always because this makes the logic
5185 ;; simpler.
5186 (tmpfile (or tramp-temp-buffer-file-name
5187 (tramp-compat-make-temp-file filename))))
5188
5189 ;; If `append' is non-nil, we copy the file locally, and let
5190 ;; the native `write-region' implementation do the job.
5191 (when append (copy-file filename tmpfile 'ok))
5192
5193 ;; We say `no-message' here because we don't want the
5194 ;; visited file modtime data to be clobbered from the temp
5195 ;; file. We call `set-visited-file-modtime' ourselves later
5196 ;; on. We must ensure that `file-coding-system-alist'
5197 ;; matches `tmpfile'.
5198 (let (file-name-handler-alist
5199 (file-coding-system-alist
5200 (tramp-find-file-name-coding-system-alist filename tmpfile)))
5201 (condition-case err
5202 (tramp-run-real-handler
5203 'write-region
5204 (list start end tmpfile append 'no-message lockname confirm))
5205 ((error quit)
5206 (setq tramp-temp-buffer-file-name nil)
5207 (delete-file tmpfile)
5208 (signal (car err) (cdr err))))
5209
5210 ;; Now, `last-coding-system-used' has the right value. Remember it.
5211 (when (boundp 'last-coding-system-used)
5212 (setq coding-system-used
5213 (symbol-value 'last-coding-system-used))))
5214
5215 ;; The permissions of the temporary file should be set. If
5216 ;; filename does not exist (eq modes nil) it has been
5217 ;; renamed to the backup file. This case `save-buffer'
5218 ;; handles permissions.
5219 ;; Ensure, that it is still readable.
5220 (when modes
5221 (set-file-modes
5222 tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400"))))
5223
5224 ;; This is a bit lengthy due to the different methods
5225 ;; possible for file transfer. First, we check whether the
5226 ;; method uses an rcp program. If so, we call it.
5227 ;; Otherwise, both encoding and decoding command must be
5228 ;; specified. However, if the method _also_ specifies an
5229 ;; encoding function, then that is used for encoding the
5230 ;; contents of the tmp file.
5231 (let* ((size (nth 7 (file-attributes tmpfile)))
5232 (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
5233 (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
5234 (cond
5235 ;; `copy-file' handles direct copy and out-of-band methods.
5236 ((or (tramp-local-host-p v)
5237 (tramp-method-out-of-band-p v size))
5238 (if (and (not (stringp start))
5239 (= (or end (point-max)) (point-max))
5240 (= (or start (point-min)) (point-min))
5241 (tramp-get-method-parameter
5242 method 'tramp-copy-keep-tmpfile))
5243 (progn
5244 (setq tramp-temp-buffer-file-name tmpfile)
5245 (condition-case err
5246 ;; We keep the local file for performance
5247 ;; reasons, useful for "rsync".
5248 (copy-file tmpfile filename t)
5249 ((error quit)
5250 (setq tramp-temp-buffer-file-name nil)
5251 (delete-file tmpfile)
5252 (signal (car err) (cdr err)))))
5253 (setq tramp-temp-buffer-file-name nil)
5254 ;; Don't rename, in order to keep context in SELinux.
5255 (unwind-protect
5256 (copy-file tmpfile filename t)
5257 (delete-file tmpfile))))
5258
5259 ;; Use inline file transfer.
5260 (rem-dec
5261 ;; Encode tmpfile.
5262 (unwind-protect
5263 (with-temp-buffer
5264 (set-buffer-multibyte nil)
5265 ;; Use encoding function or command.
5266 (if (functionp loc-enc)
5267 (with-progress-reporter
5268 v 3 (format "Encoding region using function `%s'"
5269 loc-enc)
5270 (let ((coding-system-for-read 'binary))
5271 (insert-file-contents-literally tmpfile))
5272 ;; The following `let' is a workaround for the
5273 ;; base64.el that comes with pgnus-0.84. If
5274 ;; both of the following conditions are
5275 ;; satisfied, it tries to write to a local
5276 ;; file in default-directory, but at this
5277 ;; point, default-directory is remote.
5278 ;; (`call-process-region' can't write to
5279 ;; remote files, it seems.) The file in
5280 ;; question is a tmp file anyway.
5281 (let ((default-directory
5282 (tramp-compat-temporary-file-directory)))
5283 (funcall loc-enc (point-min) (point-max))))
5284
5285 (with-progress-reporter
5286 v 3 (format "Encoding region using command `%s'"
5287 loc-enc)
5288 (unless (zerop (tramp-call-local-coding-command
5289 loc-enc tmpfile t))
5290 (tramp-error
5291 v 'file-error
5292 (concat "Cannot write to `%s', "
5293 "local encoding command `%s' failed")
5294 filename loc-enc))))
5295
5296 ;; Send buffer into remote decoding command which
5297 ;; writes to remote file. Because this happens on
5298 ;; the remote host, we cannot use the function.
5299 (with-progress-reporter
5300 v 3
5301 (format "Decoding region into remote file %s" filename)
5302 (goto-char (point-max))
5303 (unless (bolp) (newline))
5304 (tramp-send-command
5305 v
5306 (format
5307 (concat rem-dec " <<'EOF'\n%sEOF")
5308 (tramp-shell-quote-argument localname)
5309 (buffer-string)))
5310 (tramp-barf-unless-okay
5311 v nil
5312 "Couldn't write region to `%s', decode using `%s' failed"
5313 filename rem-dec)
5314 ;; When `file-precious-flag' is set, the region is
5315 ;; written to a temporary file. Check that the
5316 ;; checksum is equal to that from the local tmpfile.
5317 (when file-precious-flag
5318 (erase-buffer)
5319 (and
5320 ;; cksum runs locally, if possible.
5321 (zerop (tramp-local-call-process "cksum" tmpfile t))
5322 ;; cksum runs remotely.
5323 (zerop
5324 (tramp-send-command-and-check
5325 v
5326 (format
5327 "cksum <%s"
5328 (tramp-shell-quote-argument localname))))
5329 ;; ... they are different.
5330 (not
5331 (string-equal
5332 (buffer-string)
5333 (with-current-buffer (tramp-get-buffer v)
5334 (buffer-string))))
5335 (tramp-error
5336 v 'file-error
5337 (concat "Couldn't write region to `%s',"
5338 " decode using `%s' failed")
5339 filename rem-dec)))))
5340
5341 ;; Save exit.
5342 (delete-file tmpfile)))
5343
5344 ;; That's not expected.
5345 (t
5346 (tramp-error
5347 v 'file-error
5348 (concat "Method `%s' should specify both encoding and "
5349 "decoding command or an rcp program")
5350 method))))
5351
5352 ;; Make `last-coding-system-used' have the right value.
5353 (when coding-system-used
5354 (set 'last-coding-system-used coding-system-used))))
5355
5356 (tramp-flush-file-property v (file-name-directory localname))
5357 (tramp-flush-file-property v localname)
5358
5359 ;; We must protect `last-coding-system-used', now we have set it
5360 ;; to its correct value.
5361 (let (last-coding-system-used (need-chown t))
5362 ;; Set file modification time.
5363 (when (or (eq visit t) (stringp visit))
5364 (let ((file-attr (file-attributes filename)))
5365 (set-visited-file-modtime
5366 ;; We must pass modtime explicitely, because filename can
5367 ;; be different from (buffer-file-name), f.e. if
5368 ;; `file-precious-flag' is set.
5369 (nth 5 file-attr))
5370 (when (and (eq (nth 2 file-attr) uid)
5371 (eq (nth 3 file-attr) gid))
5372 (setq need-chown nil))))
5373
5374 ;; Set the ownership.
5375 (when need-chown
5376 (tramp-set-file-uid-gid filename uid gid))
5377 (when (or (eq visit t) (null visit) (stringp visit))
5378 (tramp-message v 0 "Wrote %s" filename))
5379 (run-hooks 'tramp-handle-write-region-hook)))))
5380
5381(defvar tramp-vc-registered-file-names nil
5382 "List used to collect file names, which are checked during `vc-registered'.")
5383
5384;; VC backends check for the existence of various different special
5385;; files. This is very time consuming, because every single check
5386;; requires a remote command (the file cache must be invalidated).
5387;; Therefore, we apply a kind of optimization. We install the file
5388;; name handler `tramp-vc-file-name-handler', which does nothing but
5389;; remembers all file names for which `file-exists-p' or
5390;; `file-readable-p' has been applied. A first run of `vc-registered'
5391;; is performed. Afterwards, a script is applied for all collected
5392;; file names, using just one remote command. The result of this
5393;; script is used to fill the file cache with actual values. Now we
5394;; can reset the file name handlers, and we make a second run of
5395;; `vc-registered', which returns the expected result without sending
5396;; any other remote command.
5397(defun tramp-handle-vc-registered (file)
5398 "Like `vc-registered' for Tramp files."
5399 (with-temp-message ""
5400 (with-parsed-tramp-file-name file nil
5401 (with-progress-reporter
5402 v 3 (format "Checking `vc-registered' for %s" file)
5403
5404 ;; There could be new files, created by the vc backend. We
5405 ;; cannot reuse the old cache entries, therefore.
5406 (let (tramp-vc-registered-file-names
5407 (tramp-cache-inhibit-cache (current-time))
5408 (file-name-handler-alist
5409 `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
5410
5411 ;; Here we collect only file names, which need an operation.
5412 (tramp-run-real-handler 'vc-registered (list file))
5413 (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
5414
5415 ;; Send just one command, in order to fill the cache.
5416 (when tramp-vc-registered-file-names
5417 (tramp-maybe-send-script
5418 v
5419 (format tramp-vc-registered-read-file-names
5420 (tramp-get-file-exists-command v)
5421 (format "%s -r" (tramp-get-test-command v)))
5422 "tramp_vc_registered_read_file_names")
5423
5424 (dolist
5425 (elt
5426 (tramp-send-command-and-read
5427 v
5428 (format
5429 "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
5430 (mapconcat 'tramp-shell-quote-argument
5431 tramp-vc-registered-file-names
5432 "\n"))))
5433
5434 (tramp-set-file-property
5435 v (car elt) (cadr elt) (cadr (cdr elt))))))
5436
5437 ;; Second run. Now all `file-exists-p' or `file-readable-p'
5438 ;; calls shall be answered from the file cache. We unset
5439 ;; `process-file-side-effects' in order to keep the cache when
5440 ;; `process-file' calls appear.
5441 (let (process-file-side-effects)
5442 (tramp-run-real-handler 'vc-registered (list file)))))))
5443
5444;;;###autoload 1679;;;###autoload
5445(progn (defun tramp-run-real-handler (operation args) 1680(progn (defun tramp-run-real-handler (operation args)
5446 "Invoke normal file name handler for OPERATION. 1681 "Invoke normal file name handler for OPERATION.
@@ -5601,8 +1836,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
5601 (condition-case err 1836 (condition-case err
5602 (apply foreign operation args) 1837 (apply foreign operation args)
5603 1838
5604 ;; Trace that somebody has interrupted the 1839 ;; Trace, that somebody has interrupted the operation.
5605 ;; operation.
5606 (quit 1840 (quit
5607 (let (tramp-message-show-message) 1841 (let (tramp-message-show-message)
5608 (tramp-message 1842 (tramp-message
@@ -5660,48 +1894,6 @@ preventing reentrant calls of Tramp.")
5660Together with `tramp-locked', this implements a locking mechanism 1894Together with `tramp-locked', this implements a locking mechanism
5661preventing reentrant calls of Tramp.") 1895preventing reentrant calls of Tramp.")
5662 1896
5663(defun tramp-sh-file-name-handler (operation &rest args)
5664 "Invoke remote-shell Tramp file name handler.
5665Fall back to normal file name handler if no Tramp handler exists."
5666 (when (and tramp-locked (not tramp-locker))
5667 (setq tramp-locked nil)
5668 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
5669 (let ((tl tramp-locked))
5670 (unwind-protect
5671 (progn
5672 (setq tramp-locked t)
5673 (let ((tramp-locker t))
5674 (save-match-data
5675 (let ((fn (assoc operation tramp-file-name-handler-alist)))
5676 (if fn
5677 (apply (cdr fn) args)
5678 (tramp-run-real-handler operation args))))))
5679 (setq tramp-locked tl))))
5680
5681(defun tramp-vc-file-name-handler (operation &rest args)
5682 "Invoke special file name handler, which collects files to be handled."
5683 (save-match-data
5684 (let ((filename
5685 (tramp-replace-environment-variables
5686 (apply 'tramp-file-name-for-operation operation args)))
5687 (fn (assoc operation tramp-file-name-handler-alist)))
5688 (with-parsed-tramp-file-name filename nil
5689 (cond
5690 ;; That's what we want: file names, for which checks are
5691 ;; applied. We assume, that VC uses only `file-exists-p' and
5692 ;; `file-readable-p' checks; otherwise we must extend the
5693 ;; list. We do not perform any action, but return nil, in
5694 ;; order to keep `vc-registered' running.
5695 ((and fn (memq operation '(file-exists-p file-readable-p)))
5696 (add-to-list 'tramp-vc-registered-file-names localname 'append)
5697 nil)
5698 ;; Tramp file name handlers like `expand-file-name'. They
5699 ;; must still work.
5700 (fn
5701 (save-match-data (apply (cdr fn) args)))
5702 ;; Default file name handlers, we don't care.
5703 (t (tramp-run-real-handler operation args)))))))
5704
5705;;;###autoload 1897;;;###autoload
5706(progn (defun tramp-completion-file-name-handler (operation &rest args) 1898(progn (defun tramp-completion-file-name-handler (operation &rest args)
5707 "Invoke Tramp file name completion handler. 1899 "Invoke Tramp file name completion handler.
@@ -5795,6 +1987,7 @@ should never be set globally, the intention is to let-bind it.")
5795;; Tramp file name syntax. Maybe another variable should be introduced 1987;; Tramp file name syntax. Maybe another variable should be introduced
5796;; overwriting this check in such cases. Or we change Tramp file name 1988;; overwriting this check in such cases. Or we change Tramp file name
5797;; syntax in order to avoid ambiguities, like in XEmacs ... 1989;; syntax in order to avoid ambiguities, like in XEmacs ...
1990;;;###tramp-autoload
5798(defun tramp-completion-mode-p () 1991(defun tramp-completion-mode-p ()
5799 "Check, whether method / user name / host name completion is active." 1992 "Check, whether method / user name / host name completion is active."
5800 (or 1993 (or
@@ -5899,12 +2092,11 @@ not in completion mode."
5899 ;; Complete local parts. 2092 ;; Complete local parts.
5900 (append 2093 (append
5901 result1 2094 result1
5902 (condition-case nil 2095 (ignore-errors
5903 (apply (if (tramp-connectable-p fullname) 2096 (apply (if (tramp-connectable-p fullname)
5904 'tramp-completion-run-real-handler 2097 'tramp-completion-run-real-handler
5905 'tramp-run-real-handler) 2098 'tramp-run-real-handler)
5906 'file-name-all-completions (list (list filename directory))) 2099 'file-name-all-completions (list (list filename directory)))))))
5907 (error nil)))))
5908 2100
5909;; Method, host name and user name completion for a file. 2101;; Method, host name and user name completion for a file.
5910;;;###autoload 2102;;;###autoload
@@ -6344,7 +2536,7 @@ User is always nil."
6344 (let ((default-directory (tramp-compat-temporary-file-directory)) 2536 (let ((default-directory (tramp-compat-temporary-file-directory))
6345 res) 2537 res)
6346 (with-temp-buffer 2538 (with-temp-buffer
6347 (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry)) 2539 (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
6348 (goto-char (point-min)) 2540 (goto-char (point-min))
6349 (while (not (eobp)) 2541 (while (not (eobp))
6350 (push (tramp-parse-putty-group registry) res)))) 2542 (push (tramp-parse-putty-group registry) res))))
@@ -6362,81 +2554,10 @@ User is always nil."
6362 (forward-line 1) 2554 (forward-line 1)
6363 result)) 2555 result))
6364 2556
6365;;; Internal Functions:
6366
6367(defun tramp-maybe-send-script (vec script name)
6368 "Define in remote shell function NAME implemented as SCRIPT.
6369Only send the definition if it has not already been done."
6370 (let* ((p (tramp-get-connection-process vec))
6371 (scripts (tramp-get-connection-property p "scripts" nil)))
6372 (unless (member name scripts)
6373 (with-progress-reporter vec 5 (format "Sending script `%s'" name)
6374 ;; The script could contain a call of Perl. This is masked with `%s'.
6375 (tramp-send-command-and-check
6376 vec
6377 (format "%s () {\n%s\n}" name
6378 (format script (tramp-get-remote-perl vec))))
6379 (tramp-set-connection-property p "scripts" (cons name scripts))))))
6380
6381(defun tramp-set-auto-save ()
6382 (when (and ;; ange-ftp has its own auto-save mechanism
6383 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
6384 'tramp-sh-file-name-handler)
6385 auto-save-default)
6386 (auto-save-mode 1)))
6387(add-hook 'find-file-hooks 'tramp-set-auto-save t)
6388(add-hook 'tramp-unload-hook
6389 (lambda ()
6390 (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
6391
6392(defun tramp-run-test (switch filename)
6393 "Run `test' on the remote system, given a SWITCH and a FILENAME.
6394Returns the exit code of the `test' program."
6395 (with-parsed-tramp-file-name filename nil
6396 (tramp-send-command-and-check
6397 v
6398 (format
6399 "%s %s %s"
6400 (tramp-get-test-command v)
6401 switch
6402 (tramp-shell-quote-argument localname)))))
6403
6404(defun tramp-run-test2 (format-string file1 file2)
6405 "Run `test'-like program on the remote system, given FILE1, FILE2.
6406FORMAT-STRING contains the program name, switches, and place holders.
6407Returns the exit code of the `test' program. Barfs if the methods,
6408hosts, or files, disagree."
6409 (unless (tramp-equal-remote file1 file2)
6410 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
6411 (tramp-error
6412 v 'file-error
6413 "tramp-run-test2 only implemented for same method, user, host")))
6414 (with-parsed-tramp-file-name file1 v1
6415 (with-parsed-tramp-file-name file1 v2
6416 (tramp-send-command-and-check
6417 v1
6418 (format format-string
6419 (tramp-shell-quote-argument v1-localname)
6420 (tramp-shell-quote-argument v2-localname))))))
6421
6422(defun tramp-buffer-name (vec)
6423 "A name for the connection buffer VEC."
6424 ;; We must use `tramp-file-name-real-host', because for gateway
6425 ;; methods the default port will be expanded later on, which would
6426 ;; tamper the name.
6427 (let ((method (tramp-file-name-method vec))
6428 (user (tramp-file-name-user vec))
6429 (host (tramp-file-name-real-host vec)))
6430 (if (not (zerop (length user)))
6431 (format "*tramp/%s %s@%s*" method user host)
6432 (format "*tramp/%s %s*" method host))))
6433
6434(defun tramp-delete-temp-file-function () 2557(defun tramp-delete-temp-file-function ()
6435 "Remove temporary files related to current buffer." 2558 "Remove temporary files related to current buffer."
6436 (when (stringp tramp-temp-buffer-file-name) 2559 (when (stringp tramp-temp-buffer-file-name)
6437 (condition-case nil 2560 (ignore-errors (delete-file tramp-temp-buffer-file-name))))
6438 (delete-file tramp-temp-buffer-file-name)
6439 (error nil))))
6440 2561
6441(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function) 2562(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
6442(add-hook 'tramp-cache-unload-hook 2563(add-hook 'tramp-cache-unload-hook
@@ -6444,241 +2565,6 @@ hosts, or files, disagree."
6444 (remove-hook 'kill-buffer-hook 2565 (remove-hook 'kill-buffer-hook
6445 'tramp-delete-temp-file-function))) 2566 'tramp-delete-temp-file-function)))
6446 2567
6447(defun tramp-get-buffer (vec)
6448 "Get the connection buffer to be used for VEC."
6449 (or (get-buffer (tramp-buffer-name vec))
6450 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
6451 (setq buffer-undo-list t)
6452 (setq default-directory
6453 (tramp-make-tramp-file-name
6454 (tramp-file-name-method vec)
6455 (tramp-file-name-user vec)
6456 (tramp-file-name-host vec)
6457 "/"))
6458 (current-buffer))))
6459
6460(defun tramp-get-connection-buffer (vec)
6461 "Get the connection buffer to be used for VEC.
6462In case a second asynchronous communication has been started, it is different
6463from `tramp-get-buffer'."
6464 (or (tramp-get-connection-property vec "process-buffer" nil)
6465 (tramp-get-buffer vec)))
6466
6467(defun tramp-get-connection-process (vec)
6468 "Get the connection process to be used for VEC.
6469In case a second asynchronous communication has been started, it is different
6470from the default one."
6471 (get-process
6472 (or (tramp-get-connection-property vec "process-name" nil)
6473 (tramp-buffer-name vec))))
6474
6475(defun tramp-debug-buffer-name (vec)
6476 "A name for the debug buffer for VEC."
6477 ;; We must use `tramp-file-name-real-host', because for gateway
6478 ;; methods the default port will be expanded later on, which would
6479 ;; tamper the name.
6480 (let ((method (tramp-file-name-method vec))
6481 (user (tramp-file-name-user vec))
6482 (host (tramp-file-name-real-host vec)))
6483 (if (not (zerop (length user)))
6484 (format "*debug tramp/%s %s@%s*" method user host)
6485 (format "*debug tramp/%s %s*" method host))))
6486
6487(defconst tramp-debug-outline-regexp
6488 "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
6489
6490(defun tramp-get-debug-buffer (vec)
6491 "Get the debug buffer for VEC."
6492 (with-current-buffer
6493 (get-buffer-create (tramp-debug-buffer-name vec))
6494 (when (bobp)
6495 (setq buffer-undo-list t)
6496 ;; Activate `outline-mode'. This runs `text-mode-hook' and
6497 ;; `outline-mode-hook'. We must prevent that local processes
6498 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
6499 ;; Furthermore, `outline-regexp' must have the correct value
6500 ;; already, because it is used by `font-lock-compile-keywords'.
6501 (let ((default-directory (tramp-compat-temporary-file-directory))
6502 (outline-regexp tramp-debug-outline-regexp))
6503 (outline-mode))
6504 (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
6505 (set (make-local-variable 'outline-level) 'tramp-outline-level))
6506 (current-buffer)))
6507
6508(defun tramp-outline-level ()
6509 "Return the depth to which a statement is nested in the outline.
6510Point must be at the beginning of a header line.
6511
6512The outline level is equal to the verbosity of the Tramp message."
6513 (1+ (string-to-number (match-string 1))))
6514
6515(defun tramp-find-executable
6516 (vec progname dirlist &optional ignore-tilde ignore-path)
6517 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
6518First arg VEC specifies the connection, PROGNAME is the program
6519to search for, and DIRLIST gives the list of directories to
6520search. If IGNORE-TILDE is non-nil, directory names starting
6521with `~' will be ignored. If IGNORE-PATH is non-nil, searches
6522only in DIRLIST.
6523
6524Returns the absolute file name of PROGNAME, if found, and nil otherwise.
6525
6526This function expects to be in the right *tramp* buffer."
6527 (with-current-buffer (tramp-get-connection-buffer vec)
6528 (let (result)
6529 ;; Check whether the executable is in $PATH. "which(1)" does not
6530 ;; report always a correct error code; therefore we check the
6531 ;; number of words it returns.
6532 (unless ignore-path
6533 (tramp-send-command vec (format "which \\%s | wc -w" progname))
6534 (goto-char (point-min))
6535 (if (looking-at "^\\s-*1$")
6536 (setq result (concat "\\" progname))))
6537 (unless result
6538 (when ignore-tilde
6539 ;; Remove all ~/foo directories from dirlist. In XEmacs,
6540 ;; `remove' is in CL, and we want to avoid CL dependencies.
6541 (let (newdl d)
6542 (while dirlist
6543 (setq d (car dirlist))
6544 (setq dirlist (cdr dirlist))
6545 (unless (char-equal ?~ (aref d 0))
6546 (setq newdl (cons d newdl))))
6547 (setq dirlist (nreverse newdl))))
6548 (tramp-send-command
6549 vec
6550 (format (concat "while read d; "
6551 "do if test -x $d/%s -a -f $d/%s; "
6552 "then echo tramp_executable $d/%s; "
6553 "break; fi; done <<'EOF'\n"
6554 "%s\nEOF")
6555 progname progname progname (mapconcat 'identity dirlist "\n")))
6556 (goto-char (point-max))
6557 (when (search-backward "tramp_executable " nil t)
6558 (skip-chars-forward "^ ")
6559 (skip-chars-forward " ")
6560 (setq result (buffer-substring
6561 (point) (tramp-compat-line-end-position)))))
6562 result)))
6563
6564(defun tramp-set-remote-path (vec)
6565 "Sets the remote environment PATH to existing directories.
6566I.e., for each directory in `tramp-remote-path', it is tested
6567whether it exists and if so, it is added to the environment
6568variable PATH."
6569 (tramp-message vec 5 (format "Setting $PATH environment variable"))
6570 (tramp-send-command
6571 vec (format "PATH=%s; export PATH"
6572 (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
6573
6574;; ------------------------------------------------------------
6575;; -- Communication with external shell --
6576;; ------------------------------------------------------------
6577
6578(defun tramp-find-file-exists-command (vec)
6579 "Find a command on the remote host for checking if a file exists.
6580Here, we are looking for a command which has zero exit status if the
6581file exists and nonzero exit status otherwise."
6582 (let ((existing "/")
6583 (nonexisting
6584 (tramp-shell-quote-argument "/ this file does not exist "))
6585 result)
6586 ;; The algorithm is as follows: we try a list of several commands.
6587 ;; For each command, we first run `$cmd /' -- this should return
6588 ;; true, as the root directory always exists. And then we run
6589 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
6590 ;; does not exist. This should return false. We use the first
6591 ;; command we find that seems to work.
6592 ;; The list of commands to try is as follows:
6593 ;; `ls -d' This works on most systems, but NetBSD 1.4
6594 ;; has a bug: `ls' always returns zero exit
6595 ;; status, even for files which don't exist.
6596 ;; `test -e' Some Bourne shells have a `test' builtin
6597 ;; which does not know the `-e' option.
6598 ;; `/bin/test -e' For those, the `test' binary on disk normally
6599 ;; provides the option. Alas, the binary
6600 ;; is sometimes `/bin/test' and sometimes it's
6601 ;; `/usr/bin/test'.
6602 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
6603 (unless (or
6604 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
6605 (zerop (tramp-send-command-and-check
6606 vec (format "%s %s" result existing)))
6607 (not (zerop (tramp-send-command-and-check
6608 vec (format "%s %s" result nonexisting)))))
6609 (and (setq result "/bin/test -e")
6610 (zerop (tramp-send-command-and-check
6611 vec (format "%s %s" result existing)))
6612 (not (zerop (tramp-send-command-and-check
6613 vec (format "%s %s" result nonexisting)))))
6614 (and (setq result "/usr/bin/test -e")
6615 (zerop (tramp-send-command-and-check
6616 vec (format "%s %s" result existing)))
6617 (not (zerop (tramp-send-command-and-check
6618 vec (format "%s %s" result nonexisting)))))
6619 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
6620 (zerop (tramp-send-command-and-check
6621 vec (format "%s %s" result existing)))
6622 (not (zerop (tramp-send-command-and-check
6623 vec (format "%s %s" result nonexisting))))))
6624 (tramp-error
6625 vec 'file-error "Couldn't find command to check if file exists"))
6626 result))
6627
6628(defun tramp-open-shell (vec shell)
6629 "Opens shell SHELL."
6630 (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
6631 ;; Find arguments for this shell.
6632 (let ((tramp-end-of-output tramp-initial-end-of-output)
6633 (alist tramp-sh-extra-args)
6634 item extra-args)
6635 (while (and alist (null extra-args))
6636 (setq item (pop alist))
6637 (when (string-match (car item) shell)
6638 (setq extra-args (cdr item))))
6639 (when extra-args (setq shell (concat shell " " extra-args)))
6640 (tramp-send-command
6641 vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
6642 (shell-quote-argument tramp-end-of-output) shell)
6643 t))
6644 ;; Setting prompts.
6645 (tramp-send-command
6646 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
6647 (tramp-send-command vec "PS2=''" t)
6648 (tramp-send-command vec "PS3=''" t)
6649 (tramp-send-command vec "PROMPT_COMMAND=''" t)))
6650
6651(defun tramp-find-shell (vec)
6652 "Opens a shell on the remote host which groks tilde expansion."
6653 (unless (tramp-get-connection-property vec "remote-shell" nil)
6654 (let (shell)
6655 (with-current-buffer (tramp-get-buffer vec)
6656 (tramp-send-command vec "echo ~root" t)
6657 (cond
6658 ((or (string-match "^~root$" (buffer-string))
6659 ;; The default shell (ksh93) of OpenSolaris is buggy.
6660 (string-equal (tramp-get-connection-property vec "uname" "")
6661 "SunOS 5.11"))
6662 (setq shell
6663 (or (tramp-find-executable
6664 vec "bash" (tramp-get-remote-path vec) t t)
6665 (tramp-find-executable
6666 vec "ksh" (tramp-get-remote-path vec) t t)))
6667 (unless shell
6668 (tramp-error
6669 vec 'file-error
6670 "Couldn't find a shell which groks tilde expansion"))
6671 (tramp-message
6672 vec 5 "Starting remote shell `%s' for tilde expansion" shell)
6673 (tramp-open-shell vec shell))
6674
6675 (t (tramp-message
6676 vec 5 "Remote `%s' groks tilde expansion, good"
6677 (tramp-set-connection-property
6678 vec "remote-shell"
6679 (tramp-get-method-parameter
6680 (tramp-file-name-method vec) 'tramp-remote-sh)))))))))
6681
6682;; ------------------------------------------------------------ 2568;; ------------------------------------------------------------
6683;; -- Functions for establishing connection -- 2569;; -- Functions for establishing connection --
6684;; ------------------------------------------------------------ 2570;; ------------------------------------------------------------
@@ -6804,7 +2690,7 @@ The terminal type can be configured with `tramp-terminal-type'."
6804(defun tramp-process-actions (proc vec actions &optional timeout) 2690(defun tramp-process-actions (proc vec actions &optional timeout)
6805 "Perform actions until success or TIMEOUT." 2691 "Perform actions until success or TIMEOUT."
6806 ;; Preserve message for `progress-reporter'. 2692 ;; Preserve message for `progress-reporter'.
6807 (with-temp-message "" 2693 (tramp-compat-with-temp-message ""
6808 ;; Enable auth-source and password-cache. 2694 ;; Enable auth-source and password-cache.
6809 (tramp-set-connection-property vec "first-password-request" t) 2695 (tramp-set-connection-property vec "first-password-request" t)
6810 (let (exit) 2696 (let (exit)
@@ -6912,17 +2798,6 @@ nil."
6912 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp))) 2798 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
6913 found))) 2799 found)))
6914 2800
6915(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
6916 "Wait for shell prompt and barf if none appears.
6917Looks at process PROC to see if a shell prompt appears in TIMEOUT
6918seconds. If not, it produces an error message with the given ERROR-ARGS."
6919 (unless
6920 (tramp-wait-for-regexp
6921 proc timeout
6922 (format
6923 "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
6924 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
6925
6926;; We don't call `tramp-send-string' in order to hide the password 2801;; We don't call `tramp-send-string' in order to hide the password
6927;; from the debug buffer, and because end-of-line handling of the 2802;; from the debug buffer, and because end-of-line handling of the
6928;; string. 2803;; string.
@@ -6935,820 +2810,6 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
6935 'tramp-password-end-of-line) 2810 'tramp-password-end-of-line)
6936 tramp-default-password-end-of-line)))) 2811 tramp-default-password-end-of-line))))
6937 2812
6938(defun tramp-open-connection-setup-interactive-shell (proc vec)
6939 "Set up an interactive shell.
6940Mainly sets the prompt and the echo correctly. PROC is the shell
6941process to set up. VEC specifies the connection."
6942 (let ((tramp-end-of-output tramp-initial-end-of-output))
6943 ;; It is useful to set the prompt in the following command because
6944 ;; some people have a setting for $PS1 which /bin/sh doesn't know
6945 ;; about and thus /bin/sh will display a strange prompt. For
6946 ;; example, if $PS1 has "${CWD}" in the value, then ksh will
6947 ;; display the current working directory but /bin/sh will display
6948 ;; a dollar sign. The following command line sets $PS1 to a sane
6949 ;; value, and works under Bourne-ish shells as well as csh-like
6950 ;; shells. Daniel Pittman reports that the unusual positioning of
6951 ;; the single quotes makes it work under `rc', too. We also unset
6952 ;; the variable $ENV because that is read by some sh
6953 ;; implementations (eg, bash when called as sh) on startup; this
6954 ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
6955 ;; is another way to set the prompt in /bin/bash, it must be
6956 ;; discarded as well.
6957 (tramp-open-shell
6958 vec
6959 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh))
6960
6961 ;; Disable echo.
6962 (tramp-message vec 5 "Setting up remote shell environment")
6963 (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
6964 ;; Check whether the echo has really been disabled. Some
6965 ;; implementations, like busybox of embedded GNU/Linux, don't
6966 ;; support disabling.
6967 (tramp-send-command vec "echo foo" t)
6968 (with-current-buffer (process-buffer proc)
6969 (goto-char (point-min))
6970 (when (looking-at "echo foo")
6971 (tramp-set-connection-property proc "remote-echo" t)
6972 (tramp-message vec 5 "Remote echo still on. Ok.")
6973 ;; Make sure backspaces and their echo are enabled and no line
6974 ;; width magic interferes with them.
6975 (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
6976
6977 (tramp-message vec 5 "Setting shell prompt")
6978 (tramp-send-command
6979 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
6980 (tramp-send-command vec "PS2=''" t)
6981 (tramp-send-command vec "PS3=''" t)
6982 (tramp-send-command vec "PROMPT_COMMAND=''" t)
6983
6984 ;; Try to set up the coding system correctly.
6985 ;; CCC this can't be the right way to do it. Hm.
6986 (tramp-message vec 5 "Determining coding system")
6987 (tramp-send-command vec "echo foo ; echo bar" t)
6988 (with-current-buffer (process-buffer proc)
6989 (goto-char (point-min))
6990 (if (featurep 'mule)
6991 ;; Use MULE to select the right EOL convention for communicating
6992 ;; with the process.
6993 (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
6994 (cons 'undecided 'undecided)))
6995 cs-decode cs-encode)
6996 (when (symbolp cs) (setq cs (cons cs cs)))
6997 (setq cs-decode (car cs))
6998 (setq cs-encode (cdr cs))
6999 (unless cs-decode (setq cs-decode 'undecided))
7000 (unless cs-encode (setq cs-encode 'undecided))
7001 (setq cs-encode (tramp-coding-system-change-eol-conversion
7002 cs-encode 'unix))
7003 (when (search-forward "\r" nil t)
7004 (setq cs-decode (tramp-coding-system-change-eol-conversion
7005 cs-decode 'dos)))
7006 (tramp-compat-funcall
7007 'set-buffer-process-coding-system cs-decode cs-encode)
7008 (tramp-message
7009 vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
7010 ;; Look for ^M and do something useful if found.
7011 (when (search-forward "\r" nil t)
7012 ;; We have found a ^M but cannot frob the process coding system
7013 ;; because we're running on a non-MULE Emacs. Let's try
7014 ;; stty, instead.
7015 (tramp-send-command vec "stty -onlcr" t))))
7016 ;; Dump stty settings in the traces.
7017 (when (>= tramp-verbose 9)
7018 (tramp-send-command vec "stty -a" t))
7019 (tramp-send-command vec "set +o vi +o emacs" t)
7020
7021 ;; Check whether the output of "uname -sr" has been changed. If
7022 ;; yes, this is a strong indication that we must expire all
7023 ;; connection properties. We start again with
7024 ;; `tramp-maybe-open-connection', it will be catched there.
7025 (tramp-message vec 5 "Checking system information")
7026 (let ((old-uname (tramp-get-connection-property vec "uname" nil))
7027 (new-uname
7028 (tramp-set-connection-property
7029 vec "uname"
7030 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
7031 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
7032 (with-current-buffer (tramp-get-debug-buffer vec)
7033 ;; Keep the debug buffer.
7034 (rename-buffer
7035 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
7036 (tramp-compat-funcall 'tramp-cleanup-connection vec)
7037 (if (= (point-min) (point-max))
7038 (kill-buffer nil)
7039 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
7040 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
7041 (tramp-get-buffer vec)
7042 (tramp-message
7043 vec 3
7044 "Connection reset, because remote host changed from `%s' to `%s'"
7045 old-uname new-uname)
7046 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
7047
7048 ;; Check whether the remote host suffers from buggy
7049 ;; `send-process-string'. This is known for FreeBSD (see comment in
7050 ;; `send_process', file process.c). I've tested sending 624 bytes
7051 ;; successfully, sending 625 bytes failed. Emacs makes a hack when
7052 ;; this host type is detected locally. It cannot handle remote
7053 ;; hosts, though.
7054 (with-connection-property proc "chunksize"
7055 (cond
7056 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
7057 tramp-chunksize)
7058 (t
7059 (tramp-message
7060 vec 5 "Checking remote host type for `send-process-string' bug")
7061 (if (string-match
7062 "^FreeBSD" (tramp-get-connection-property vec "uname" ""))
7063 500 0))))
7064
7065 ;; Set remote PATH variable.
7066 (tramp-set-remote-path vec)
7067
7068 ;; Search for a good shell before searching for a command which
7069 ;; checks if a file exists. This is done because Tramp wants to use
7070 ;; "test foo; echo $?" to check if various conditions hold, and
7071 ;; there are buggy /bin/sh implementations which don't execute the
7072 ;; "echo $?" part if the "test" part has an error. In particular,
7073 ;; the OpenSolaris /bin/sh is a problem. There are also other
7074 ;; problems with /bin/sh of OpenSolaris, like redirection of stderr
7075 ;; in function declarations, or changing HISTFILE in place.
7076 ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when
7077 ;; detected.
7078 (tramp-find-shell vec)
7079
7080 ;; Disable unexpected output.
7081 (tramp-send-command vec "mesg n; biff n" t)
7082
7083 ;; IRIX64 bash expands "!" even when in single quotes. This
7084 ;; destroys our shell functions, we must disable it. See
7085 ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
7086 (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" ""))
7087 (tramp-send-command vec "set +H" t))
7088
7089 ;; Set `remote-tty' process property.
7090 (ignore-errors
7091 (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
7092 (unless (zerop (length tty)) (process-put proc 'remote-tty tty))))
7093
7094 ;; Set the environment.
7095 (tramp-message vec 5 "Setting default environment")
7096
7097 (let ((env (copy-sequence tramp-remote-process-environment))
7098 unset item)
7099 (while env
7100 (setq item (tramp-compat-split-string (car env) "="))
7101 (setcdr item (mapconcat 'identity (cdr item) "="))
7102 (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
7103 (tramp-send-command
7104 vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t)
7105 (push (car item) unset))
7106 (setq env (cdr env)))
7107 (when unset
7108 (tramp-send-command
7109 vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
7110
7111;; CCC: We should either implement a Perl version of base64 encoding
7112;; and decoding. Then we just use that in the last item. The other
7113;; alternative is to use the Perl version of UU encoding. But then
7114;; we need a Lisp version of uuencode.
7115;;
7116;; Old text from documentation of tramp-methods:
7117;; Using a uuencode/uudecode inline method is discouraged, please use one
7118;; of the base64 methods instead since base64 encoding is much more
7119;; reliable and the commands are more standardized between the different
7120;; Unix versions. But if you can't use base64 for some reason, please
7121;; note that the default uudecode command does not work well for some
7122;; Unices, in particular AIX and Irix. For AIX, you might want to use
7123;; the following command for uudecode:
7124;;
7125;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
7126;;
7127;; For Irix, no solution is known yet.
7128
7129(defconst tramp-local-coding-commands
7130 '((b64 base64-encode-region base64-decode-region)
7131 (uu tramp-uuencode-region uudecode-decode-region)
7132 (pack
7133 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7134 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7135 "List of local coding commands for inline transfer.
7136Each item is a list that looks like this:
7137
7138\(FORMAT ENCODING DECODING\)
7139
7140FORMAT is symbol describing the encoding/decoding format. It can be
7141`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7142
7143ENCODING and DECODING can be strings, giving commands, or symbols,
7144giving functions. If they are strings, then they can contain
7145the \"%s\" format specifier. If that specifier is present, the input
7146filename will be put into the command line at that spot. If the
7147specifier is not present, the input should be read from standard
7148input.
7149
7150If they are functions, they will be called with two arguments, start
7151and end of region, and are expected to replace the region contents
7152with the encoded or decoded results, respectively.")
7153
7154(defconst tramp-remote-coding-commands
7155 '((b64 "base64" "base64 -d")
7156 (b64 "mimencode -b" "mimencode -u -b")
7157 (b64 "mmencode -b" "mmencode -u -b")
7158 (b64 "recode data..base64" "recode base64..data")
7159 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
7160 (b64 tramp-perl-encode tramp-perl-decode)
7161 (uu "uuencode xxx" "uudecode -o /dev/stdout")
7162 (uu "uuencode xxx" "uudecode -o -")
7163 (uu "uuencode xxx" "uudecode -p")
7164 (uu "uuencode xxx" tramp-uudecode)
7165 (pack
7166 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7167 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7168 "List of remote coding commands for inline transfer.
7169Each item is a list that looks like this:
7170
7171\(FORMAT ENCODING DECODING\)
7172
7173FORMAT is symbol describing the encoding/decoding format. It can be
7174`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7175
7176ENCODING and DECODING can be strings, giving commands, or symbols,
7177giving variables. If they are strings, then they can contain
7178the \"%s\" format specifier. If that specifier is present, the input
7179filename will be put into the command line at that spot. If the
7180specifier is not present, the input should be read from standard
7181input.
7182
7183If they are variables, this variable is a string containing a Perl
7184implementation for this functionality. This Perl program will be transferred
7185to the remote host, and it is available as shell function with the same name.")
7186
7187(defun tramp-find-inline-encoding (vec)
7188 "Find an inline transfer encoding that works.
7189Goes through the list `tramp-local-coding-commands' and
7190`tramp-remote-coding-commands'."
7191 (save-excursion
7192 (let ((local-commands tramp-local-coding-commands)
7193 (magic "xyzzy")
7194 loc-enc loc-dec rem-enc rem-dec litem ritem found)
7195 (while (and local-commands (not found))
7196 (setq litem (pop local-commands))
7197 (catch 'wont-work-local
7198 (let ((format (nth 0 litem))
7199 (remote-commands tramp-remote-coding-commands))
7200 (setq loc-enc (nth 1 litem))
7201 (setq loc-dec (nth 2 litem))
7202 ;; If the local encoder or decoder is a string, the
7203 ;; corresponding command has to work locally.
7204 (if (not (stringp loc-enc))
7205 (tramp-message
7206 vec 5 "Checking local encoding function `%s'" loc-enc)
7207 (tramp-message
7208 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
7209 (unless (zerop (tramp-call-local-coding-command
7210 loc-enc nil nil))
7211 (throw 'wont-work-local nil)))
7212 (if (not (stringp loc-dec))
7213 (tramp-message
7214 vec 5 "Checking local decoding function `%s'" loc-dec)
7215 (tramp-message
7216 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
7217 (unless (zerop (tramp-call-local-coding-command
7218 loc-dec nil nil))
7219 (throw 'wont-work-local nil)))
7220 ;; Search for remote coding commands with the same format
7221 (while (and remote-commands (not found))
7222 (setq ritem (pop remote-commands))
7223 (catch 'wont-work-remote
7224 (when (equal format (nth 0 ritem))
7225 (setq rem-enc (nth 1 ritem))
7226 (setq rem-dec (nth 2 ritem))
7227 ;; Check if remote encoding and decoding commands can be
7228 ;; called remotely with null input and output. This makes
7229 ;; sure there are no syntax errors and the command is really
7230 ;; found. Note that we do not redirect stdout to /dev/null,
7231 ;; for two reasons: when checking the decoding command, we
7232 ;; actually check the output it gives. And also, when
7233 ;; redirecting "mimencode" output to /dev/null, then as root
7234 ;; it might change the permissions of /dev/null!
7235 (when (not (stringp rem-enc))
7236 (let ((name (symbol-name rem-enc)))
7237 (while (string-match (regexp-quote "-") name)
7238 (setq name (replace-match "_" nil t name)))
7239 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
7240 (setq rem-enc name)))
7241 (tramp-message
7242 vec 5
7243 "Checking remote encoding command `%s' for sanity" rem-enc)
7244 (unless (zerop (tramp-send-command-and-check
7245 vec (format "%s </dev/null" rem-enc) t))
7246 (throw 'wont-work-remote nil))
7247
7248 (when (not (stringp rem-dec))
7249 (let ((name (symbol-name rem-dec)))
7250 (while (string-match (regexp-quote "-") name)
7251 (setq name (replace-match "_" nil t name)))
7252 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
7253 (setq rem-dec name)))
7254 (tramp-message
7255 vec 5
7256 "Checking remote decoding command `%s' for sanity" rem-dec)
7257 (unless (zerop (tramp-send-command-and-check
7258 vec
7259 (format "echo %s | %s | %s"
7260 magic rem-enc rem-dec)
7261 t))
7262 (throw 'wont-work-remote nil))
7263
7264 (with-current-buffer (tramp-get-buffer vec)
7265 (goto-char (point-min))
7266 (unless (looking-at (regexp-quote magic))
7267 (throw 'wont-work-remote nil)))
7268
7269 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
7270 (setq rem-enc (nth 1 ritem))
7271 (setq rem-dec (nth 2 ritem))
7272 (setq found t)))))))
7273
7274 ;; Did we find something?
7275 (unless found
7276 (tramp-error
7277 vec 'file-error "Couldn't find an inline transfer encoding"))
7278
7279 ;; Set connection properties.
7280 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
7281 (tramp-set-connection-property vec "local-encoding" loc-enc)
7282 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
7283 (tramp-set-connection-property vec "local-decoding" loc-dec)
7284 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
7285 (tramp-set-connection-property vec "remote-encoding" rem-enc)
7286 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
7287 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
7288
7289(defun tramp-call-local-coding-command (cmd input output)
7290 "Call the local encoding or decoding command.
7291If CMD contains \"%s\", provide input file INPUT there in command.
7292Otherwise, INPUT is passed via standard input.
7293INPUT can also be nil which means `/dev/null'.
7294OUTPUT can be a string (which specifies a filename), or t (which
7295means standard output and thus the current buffer), or nil (which
7296means discard it)."
7297 (tramp-local-call-process
7298 tramp-encoding-shell
7299 (when (and input (not (string-match "%s" cmd))) input)
7300 (if (eq output t) t nil)
7301 nil
7302 tramp-encoding-command-switch
7303 (concat
7304 (if (string-match "%s" cmd) (format cmd input) cmd)
7305 (if (stringp output) (concat "> " output) ""))))
7306
7307(defconst tramp-inline-compress-commands
7308 '(("gzip" "gzip -d")
7309 ("bzip2" "bzip2 -d")
7310 ("compress" "compress -d"))
7311 "List of compress and decompress commands for inline transfer.
7312Each item is a list that looks like this:
7313
7314\(COMPRESS DECOMPRESS\)
7315
7316COMPRESS or DECOMPRESS are strings with the respective commands.")
7317
7318(defun tramp-find-inline-compress (vec)
7319 "Find an inline transfer compress command that works.
7320Goes through the list `tramp-inline-compress-commands'."
7321 (save-excursion
7322 (let ((commands tramp-inline-compress-commands)
7323 (magic "xyzzy")
7324 item compress decompress
7325 found)
7326 (while (and commands (not found))
7327 (catch 'next
7328 (setq item (pop commands)
7329 compress (nth 0 item)
7330 decompress (nth 1 item))
7331 (tramp-message
7332 vec 5
7333 "Checking local compress command `%s', `%s' for sanity"
7334 compress decompress)
7335 (unless (zerop (tramp-call-local-coding-command
7336 (format "echo %s | %s | %s"
7337 magic compress decompress) nil nil))
7338 (throw 'next nil))
7339 (tramp-message
7340 vec 5
7341 "Checking remote compress command `%s', `%s' for sanity"
7342 compress decompress)
7343 (unless (zerop (tramp-send-command-and-check
7344 vec (format "echo %s | %s | %s"
7345 magic compress decompress) t))
7346 (throw 'next nil))
7347 (setq found t)))
7348
7349 ;; Did we find something?
7350 (if found
7351 (progn
7352 ;; Set connection properties.
7353 (tramp-message
7354 vec 5 "Using inline transfer compress command `%s'" compress)
7355 (tramp-set-connection-property vec "inline-compress" compress)
7356 (tramp-message
7357 vec 5 "Using inline transfer decompress command `%s'" decompress)
7358 (tramp-set-connection-property vec "inline-decompress" decompress))
7359
7360 (tramp-set-connection-property vec "inline-compress" nil)
7361 (tramp-set-connection-property vec "inline-decompress" nil)
7362 (tramp-message
7363 vec 2 "Couldn't find an inline transfer compress command")))))
7364
7365(defun tramp-compute-multi-hops (vec)
7366 "Expands VEC according to `tramp-default-proxies-alist'.
7367Gateway hops are already opened."
7368 (let ((target-alist `(,vec))
7369 (choices tramp-default-proxies-alist)
7370 item proxy)
7371
7372 ;; Look for proxy hosts to be passed.
7373 (while choices
7374 (setq item (pop choices)
7375 proxy (eval (nth 2 item)))
7376 (when (and
7377 ;; host
7378 (string-match (or (eval (nth 0 item)) "")
7379 (or (tramp-file-name-host (car target-alist)) ""))
7380 ;; user
7381 (string-match (or (eval (nth 1 item)) "")
7382 (or (tramp-file-name-user (car target-alist)) "")))
7383 (if (null proxy)
7384 ;; No more hops needed.
7385 (setq choices nil)
7386 ;; Replace placeholders.
7387 (setq proxy
7388 (format-spec
7389 proxy
7390 (format-spec-make
7391 ?u (or (tramp-file-name-user (car target-alist)) "")
7392 ?h (or (tramp-file-name-host (car target-alist)) ""))))
7393 (with-parsed-tramp-file-name proxy l
7394 ;; Add the hop.
7395 (add-to-list 'target-alist l)
7396 ;; Start next search.
7397 (setq choices tramp-default-proxies-alist)))))
7398
7399 ;; Handle gateways.
7400 (when (and (boundp 'tramp-gw-tunnel-method)
7401 (string-match (format
7402 "^\\(%s\\|%s\\)$"
7403 (symbol-value 'tramp-gw-tunnel-method)
7404 (symbol-value 'tramp-gw-socks-method))
7405 (tramp-file-name-method (car target-alist))))
7406 (let ((gw (pop target-alist))
7407 (hop (pop target-alist)))
7408 ;; Is the method prepared for gateways?
7409 (unless (tramp-get-method-parameter
7410 (tramp-file-name-method hop) 'tramp-default-port)
7411 (tramp-error
7412 vec 'file-error
7413 "Method `%s' is not supported for gateway access."
7414 (tramp-file-name-method hop)))
7415 ;; Add default port if needed.
7416 (unless
7417 (string-match
7418 tramp-host-with-port-regexp (tramp-file-name-host hop))
7419 (aset hop 2
7420 (concat
7421 (tramp-file-name-host hop) tramp-prefix-port-format
7422 (number-to-string
7423 (tramp-get-method-parameter
7424 (tramp-file-name-method hop) 'tramp-default-port)))))
7425 ;; Open the gateway connection.
7426 (add-to-list
7427 'target-alist
7428 (vector
7429 (tramp-file-name-method hop) (tramp-file-name-user hop)
7430 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
7431 ;; For the password prompt, we need the correct values.
7432 ;; Therefore, we must remember the gateway vector. But we
7433 ;; cannot do it as connection property, because it shouldn't
7434 ;; be persistent. And we have no started process yet either.
7435 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
7436
7437 ;; Foreign and out-of-band methods are not supported for multi-hops.
7438 (when (cdr target-alist)
7439 (setq choices target-alist)
7440 (while choices
7441 (setq item (pop choices))
7442 (when
7443 (or
7444 (not
7445 (tramp-get-method-parameter
7446 (tramp-file-name-method item) 'tramp-login-program))
7447 (tramp-get-method-parameter
7448 (tramp-file-name-method item) 'tramp-copy-program))
7449 (tramp-error
7450 vec 'file-error
7451 "Method `%s' is not supported for multi-hops."
7452 (tramp-file-name-method item)))))
7453
7454 ;; In case the host name is not used for the remote shell
7455 ;; command, the user could be misguided by applying a random
7456 ;; hostname.
7457 (let* ((v (car target-alist))
7458 (method (tramp-file-name-method v))
7459 (host (tramp-file-name-host v)))
7460 (unless
7461 (or
7462 ;; There are multi-hops.
7463 (cdr target-alist)
7464 ;; The host name is used for the remote shell command.
7465 (member
7466 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
7467 ;; The host is local. We cannot use `tramp-local-host-p'
7468 ;; here, because it opens a connection as well.
7469 (string-match tramp-local-host-regexp host))
7470 (tramp-error
7471 v 'file-error
7472 "Host `%s' looks like a remote host, `%s' can only use the local host"
7473 host method)))
7474
7475 ;; Result.
7476 target-alist))
7477
7478(defun tramp-maybe-open-connection (vec)
7479 "Maybe open a connection VEC.
7480Does not do anything if a connection is already open, but re-opens the
7481connection if a previous connection has died for some reason."
7482 (catch 'uname-changed
7483 (let ((p (tramp-get-connection-process vec))
7484 (process-name (tramp-get-connection-property vec "process-name" nil))
7485 (process-environment (copy-sequence process-environment)))
7486
7487 ;; If too much time has passed since last command was sent, look
7488 ;; whether process is still alive. If it isn't, kill it. When
7489 ;; using ssh, it can sometimes happen that the remote end has
7490 ;; hung up but the local ssh client doesn't recognize this until
7491 ;; it tries to send some data to the remote end. So that's why
7492 ;; we try to send a command from time to time, then look again
7493 ;; whether the process is really alive.
7494 (condition-case nil
7495 (when (and (> (tramp-time-diff
7496 (current-time)
7497 (tramp-get-connection-property
7498 p "last-cmd-time" '(0 0 0)))
7499 60)
7500 p (processp p) (memq (process-status p) '(run open)))
7501 (tramp-send-command vec "echo are you awake" t t)
7502 (unless (and (memq (process-status p) '(run open))
7503 (tramp-wait-for-output p 10))
7504 ;; The error will be catched locally.
7505 (tramp-error vec 'file-error "Awake did fail")))
7506 (file-error
7507 (tramp-flush-connection-property vec)
7508 (tramp-flush-connection-property p)
7509 (delete-process p)
7510 (setq p nil)))
7511
7512 ;; New connection must be opened.
7513 (unless (and p (processp p) (memq (process-status p) '(run open)))
7514
7515 ;; We call `tramp-get-buffer' in order to get a debug buffer for
7516 ;; messages from the beginning.
7517 (tramp-get-buffer vec)
7518 (with-progress-reporter
7519 vec 3
7520 (if (zerop (length (tramp-file-name-user vec)))
7521 (format "Opening connection for %s using %s"
7522 (tramp-file-name-host vec)
7523 (tramp-file-name-method vec))
7524 (format "Opening connection for %s@%s using %s"
7525 (tramp-file-name-user vec)
7526 (tramp-file-name-host vec)
7527 (tramp-file-name-method vec)))
7528
7529 ;; Start new process.
7530 (when (and p (processp p))
7531 (delete-process p))
7532 (setenv "TERM" tramp-terminal-type)
7533 (setenv "LC_ALL" "C")
7534 (setenv "PROMPT_COMMAND")
7535 (setenv "PS1" tramp-initial-end-of-output)
7536 (let* ((target-alist (tramp-compute-multi-hops vec))
7537 (process-connection-type tramp-process-connection-type)
7538 (process-adaptive-read-buffering nil)
7539 (coding-system-for-read nil)
7540 ;; This must be done in order to avoid our file name handler.
7541 (p (let ((default-directory
7542 (tramp-compat-temporary-file-directory)))
7543 (start-process
7544 (or process-name (tramp-buffer-name vec))
7545 (tramp-get-connection-buffer vec)
7546 tramp-encoding-shell))))
7547
7548 (tramp-message
7549 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
7550
7551 ;; Check whether process is alive.
7552 (tramp-set-process-query-on-exit-flag p nil)
7553 (tramp-barf-if-no-shell-prompt
7554 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
7555
7556 ;; Now do all the connections as specified.
7557 (while target-alist
7558 (let* ((hop (car target-alist))
7559 (l-method (tramp-file-name-method hop))
7560 (l-user (tramp-file-name-user hop))
7561 (l-host (tramp-file-name-host hop))
7562 (l-port nil)
7563 (login-program
7564 (tramp-get-method-parameter
7565 l-method 'tramp-login-program))
7566 (login-args
7567 (tramp-get-method-parameter l-method 'tramp-login-args))
7568 (async-args
7569 (tramp-get-method-parameter l-method 'tramp-async-args))
7570 (gw-args
7571 (tramp-get-method-parameter l-method 'tramp-gw-args))
7572 (gw (tramp-get-file-property hop "" "gateway" nil))
7573 (g-method (and gw (tramp-file-name-method gw)))
7574 (g-user (and gw (tramp-file-name-user gw)))
7575 (g-host (and gw (tramp-file-name-host gw)))
7576 (command login-program)
7577 ;; We don't create the temporary file. In fact,
7578 ;; it is just a prefix for the ControlPath option
7579 ;; of ssh; the real temporary file has another
7580 ;; name, and it is created and protected by ssh.
7581 ;; It is also removed by ssh, when the connection
7582 ;; is closed.
7583 (tmpfile
7584 (tramp-set-connection-property
7585 p "temp-file"
7586 (make-temp-name
7587 (expand-file-name
7588 tramp-temp-name-prefix
7589 (tramp-compat-temporary-file-directory)))))
7590 spec)
7591
7592 ;; Add arguments for asynchrononous processes.
7593 (when (and process-name async-args)
7594 (setq login-args (append async-args login-args)))
7595
7596 ;; Add gateway arguments if necessary.
7597 (when (and gw gw-args)
7598 (setq login-args (append gw-args login-args)))
7599
7600 ;; Check for port number. Until now, there's no need
7601 ;; for handling like method, user, host.
7602 (when (string-match tramp-host-with-port-regexp l-host)
7603 (setq l-port (match-string 2 l-host)
7604 l-host (match-string 1 l-host)))
7605
7606 ;; Set variables for computing the prompt for reading
7607 ;; password. They can also be derived from a gateway.
7608 (setq tramp-current-method (or g-method l-method)
7609 tramp-current-user (or g-user l-user)
7610 tramp-current-host (or g-host l-host))
7611
7612 ;; Replace login-args place holders.
7613 (setq
7614 l-host (or l-host "")
7615 l-user (or l-user "")
7616 l-port (or l-port "")
7617 spec (format-spec-make
7618 ?h l-host ?u l-user ?p l-port ?t tmpfile)
7619 command
7620 (concat
7621 ;; We do not want to see the trailing local prompt in
7622 ;; `start-file-process'.
7623 (unless (memq system-type '(windows-nt)) "exec ")
7624 command " "
7625 (mapconcat
7626 (lambda (x)
7627 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
7628 (unless (member "" x) (mapconcat 'identity x " ")))
7629 login-args " ")
7630 ;; Local shell could be a Windows COMSPEC. It
7631 ;; doesn't know the ";" syntax, but we must exit
7632 ;; always for `start-file-process'. "exec" does not
7633 ;; work either.
7634 (if (memq system-type '(windows-nt)) " && exit || exit")))
7635
7636 ;; Send the command.
7637 (tramp-message vec 3 "Sending command `%s'" command)
7638 (tramp-send-command vec command t t)
7639 (tramp-process-actions p vec tramp-actions-before-shell 60)
7640 (tramp-message
7641 vec 3 "Found remote shell prompt on `%s'" l-host))
7642 ;; Next hop.
7643 (setq target-alist (cdr target-alist)))
7644
7645 ;; Make initial shell settings.
7646 (tramp-open-connection-setup-interactive-shell p vec)))))))
7647
7648(defun tramp-send-command (vec command &optional neveropen nooutput)
7649 "Send the COMMAND to connection VEC.
7650Erases temporary buffer before sending the command. If optional
7651arg NEVEROPEN is non-nil, never try to open the connection. This
7652is meant to be used from `tramp-maybe-open-connection' only. The
7653function waits for output unless NOOUTPUT is set."
7654 (unless neveropen (tramp-maybe-open-connection vec))
7655 (let ((p (tramp-get-connection-process vec)))
7656 (when (tramp-get-connection-property p "remote-echo" nil)
7657 ;; We mark the command string that it can be erased in the output buffer.
7658 (tramp-set-connection-property p "check-remote-echo" t)
7659 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
7660 (tramp-message vec 6 "%s" command)
7661 (tramp-send-string vec command)
7662 (unless nooutput (tramp-wait-for-output p))))
7663
7664(defun tramp-wait-for-output (proc &optional timeout)
7665 "Wait for output from remote command."
7666 (unless (buffer-live-p (process-buffer proc))
7667 (delete-process proc)
7668 (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
7669 (with-current-buffer (process-buffer proc)
7670 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
7671 ;; be leading escape sequences, which must be ignored.
7672 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
7673 ;; Sometimes, the commands do not return a newline but a
7674 ;; null byte before the shell prompt, for example "git
7675 ;; ls-files -c -z ...".
7676 (regexp1 (format "\\(^\\|\000\\)%s" regexp))
7677 (found (tramp-wait-for-regexp proc timeout regexp1)))
7678 (if found
7679 (let (buffer-read-only)
7680 ;; A simple-minded busybox has sent " ^H" sequences.
7681 ;; Delete them.
7682 (goto-char (point-min))
7683 (when (re-search-forward
7684 "^\\(.\b\\)+$" (tramp-compat-line-end-position) t)
7685 (forward-line 1)
7686 (delete-region (point-min) (point)))
7687 ;; Delete the prompt.
7688 (goto-char (point-max))
7689 (re-search-backward regexp nil t)
7690 (delete-region (point) (point-max)))
7691 (if timeout
7692 (tramp-error
7693 proc 'file-error
7694 "[[Remote prompt `%s' not found in %d secs]]"
7695 tramp-end-of-output timeout)
7696 (tramp-error
7697 proc 'file-error
7698 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
7699 ;; Return value is whether end-of-output sentinel was found.
7700 found)))
7701
7702(defun tramp-send-command-and-check
7703 (vec command &optional subshell dont-suppress-err)
7704 "Run COMMAND and check its exit status.
7705Sends `echo $?' along with the COMMAND for checking the exit status. If
7706COMMAND is nil, just sends `echo $?'. Returns the exit status found.
7707
7708If the optional argument SUBSHELL is non-nil, the command is
7709executed in a subshell, ie surrounded by parentheses. If
7710DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
7711 (tramp-send-command
7712 vec
7713 (concat (if subshell "( " "")
7714 command
7715 (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
7716 "echo tramp_exit_status $?"
7717 (if subshell " )" "")))
7718 (with-current-buffer (tramp-get-connection-buffer vec)
7719 (goto-char (point-max))
7720 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
7721 (tramp-error
7722 vec 'file-error "Couldn't find exit status of `%s'" command))
7723 (skip-chars-forward "^ ")
7724 (prog1
7725 (read (current-buffer))
7726 (let (buffer-read-only) (delete-region (match-beginning 0) (point-max))))))
7727
7728(defun tramp-barf-unless-okay (vec command fmt &rest args)
7729 "Run COMMAND, check exit status, throw error if exit status not okay.
7730Similar to `tramp-send-command-and-check' but accepts two more arguments
7731FMT and ARGS which are passed to `error'."
7732 (unless (zerop (tramp-send-command-and-check vec command))
7733 (apply 'tramp-error vec 'file-error fmt args)))
7734
7735(defun tramp-send-command-and-read (vec command)
7736 "Run COMMAND and return the output, which must be a Lisp expression.
7737In case there is no valid Lisp expression, it raises an error"
7738 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
7739 (with-current-buffer (tramp-get-connection-buffer vec)
7740 ;; Read the expression.
7741 (goto-char (point-min))
7742 (condition-case nil
7743 (prog1 (read (current-buffer))
7744 ;; Error handling.
7745 (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t)
7746 (error nil)))
7747 (error (tramp-error
7748 vec 'file-error
7749 "`%s' does not return a valid Lisp expression: `%s'"
7750 command (buffer-string))))))
7751
7752;; It seems that Tru64 Unix does not like it if long strings are sent 2813;; It seems that Tru64 Unix does not like it if long strings are sent
7753;; to it in one go. (This happens when sending the Perl 2814;; to it in one go. (This happens when sending the Perl
7754;; `file-attributes' implementation, for instance.) Therefore, we 2815;; `file-attributes' implementation, for instance.) Therefore, we
@@ -7791,181 +2852,6 @@ the remote host use line-endings as defined in the variable
7791 (setq pos (+ pos chunksize)))) 2852 (setq pos (+ pos chunksize))))
7792 (process-send-string p string))))) 2853 (process-send-string p string)))))
7793 2854
7794(defun tramp-mode-string-to-int (mode-string)
7795 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
7796 (let* (case-fold-search
7797 (mode-chars (string-to-vector mode-string))
7798 (owner-read (aref mode-chars 1))
7799 (owner-write (aref mode-chars 2))
7800 (owner-execute-or-setid (aref mode-chars 3))
7801 (group-read (aref mode-chars 4))
7802 (group-write (aref mode-chars 5))
7803 (group-execute-or-setid (aref mode-chars 6))
7804 (other-read (aref mode-chars 7))
7805 (other-write (aref mode-chars 8))
7806 (other-execute-or-sticky (aref mode-chars 9)))
7807 (save-match-data
7808 (logior
7809 (cond
7810 ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
7811 ((char-equal owner-read ?-) 0)
7812 (t (error "Second char `%c' must be one of `r-'" owner-read)))
7813 (cond
7814 ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
7815 ((char-equal owner-write ?-) 0)
7816 (t (error "Third char `%c' must be one of `w-'" owner-write)))
7817 (cond
7818 ((char-equal owner-execute-or-setid ?x)
7819 (tramp-octal-to-decimal "00100"))
7820 ((char-equal owner-execute-or-setid ?S)
7821 (tramp-octal-to-decimal "04000"))
7822 ((char-equal owner-execute-or-setid ?s)
7823 (tramp-octal-to-decimal "04100"))
7824 ((char-equal owner-execute-or-setid ?-) 0)
7825 (t (error "Fourth char `%c' must be one of `xsS-'"
7826 owner-execute-or-setid)))
7827 (cond
7828 ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
7829 ((char-equal group-read ?-) 0)
7830 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
7831 (cond
7832 ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
7833 ((char-equal group-write ?-) 0)
7834 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
7835 (cond
7836 ((char-equal group-execute-or-setid ?x)
7837 (tramp-octal-to-decimal "00010"))
7838 ((char-equal group-execute-or-setid ?S)
7839 (tramp-octal-to-decimal "02000"))
7840 ((char-equal group-execute-or-setid ?s)
7841 (tramp-octal-to-decimal "02010"))
7842 ((char-equal group-execute-or-setid ?-) 0)
7843 (t (error "Seventh char `%c' must be one of `xsS-'"
7844 group-execute-or-setid)))
7845 (cond
7846 ((char-equal other-read ?r)
7847 (tramp-octal-to-decimal "00004"))
7848 ((char-equal other-read ?-) 0)
7849 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
7850 (cond
7851 ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
7852 ((char-equal other-write ?-) 0)
7853 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
7854 (cond
7855 ((char-equal other-execute-or-sticky ?x)
7856 (tramp-octal-to-decimal "00001"))
7857 ((char-equal other-execute-or-sticky ?T)
7858 (tramp-octal-to-decimal "01000"))
7859 ((char-equal other-execute-or-sticky ?t)
7860 (tramp-octal-to-decimal "01001"))
7861 ((char-equal other-execute-or-sticky ?-) 0)
7862 (t (error "Tenth char `%c' must be one of `xtT-'"
7863 other-execute-or-sticky)))))))
7864
7865(defun tramp-convert-file-attributes (vec attr)
7866 "Convert file-attributes ATTR generated by perl script, stat or ls.
7867Convert file mode bits to string and set virtual device number.
7868Return ATTR."
7869 (when attr
7870 ;; Convert last access time.
7871 (unless (listp (nth 4 attr))
7872 (setcar (nthcdr 4 attr)
7873 (list (floor (nth 4 attr) 65536)
7874 (floor (mod (nth 4 attr) 65536)))))
7875 ;; Convert last modification time.
7876 (unless (listp (nth 5 attr))
7877 (setcar (nthcdr 5 attr)
7878 (list (floor (nth 5 attr) 65536)
7879 (floor (mod (nth 5 attr) 65536)))))
7880 ;; Convert last status change time.
7881 (unless (listp (nth 6 attr))
7882 (setcar (nthcdr 6 attr)
7883 (list (floor (nth 6 attr) 65536)
7884 (floor (mod (nth 6 attr) 65536)))))
7885 ;; Convert file size.
7886 (when (< (nth 7 attr) 0)
7887 (setcar (nthcdr 7 attr) -1))
7888 (when (and (floatp (nth 7 attr))
7889 (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
7890 (setcar (nthcdr 7 attr) (round (nth 7 attr))))
7891 ;; Convert file mode bits to string.
7892 (unless (stringp (nth 8 attr))
7893 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
7894 (when (stringp (car attr))
7895 (aset (nth 8 attr) 0 ?l)))
7896 ;; Convert directory indication bit.
7897 (when (string-match "^d" (nth 8 attr))
7898 (setcar attr t))
7899 ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
7900 (when (consp (car attr))
7901 (if (and (stringp (caar attr))
7902 (string-match ".+ -> .\\(.+\\)." (caar attr)))
7903 (setcar attr (match-string 1 (caar attr)))
7904 (setcar attr nil)))
7905 ;; Set file's gid change bit.
7906 (setcar (nthcdr 9 attr)
7907 (if (numberp (nth 3 attr))
7908 (not (= (nth 3 attr)
7909 (tramp-get-remote-gid vec 'integer)))
7910 (not (string-equal
7911 (nth 3 attr)
7912 (tramp-get-remote-gid vec 'string)))))
7913 ;; Convert inode.
7914 (unless (listp (nth 10 attr))
7915 (setcar (nthcdr 10 attr)
7916 (condition-case nil
7917 (cons (floor (nth 10 attr) 65536)
7918 (floor (mod (nth 10 attr) 65536)))
7919 ;; Inodes can be incredible huge. We must hide this.
7920 (error (tramp-get-inode vec)))))
7921 ;; Set virtual device number.
7922 (setcar (nthcdr 11 attr)
7923 (tramp-get-device vec))
7924 attr))
7925
7926(defun tramp-check-cached-permissions (vec access)
7927 "Check `file-attributes' caches for VEC.
7928Return t if according to the cache access type ACCESS is known to
7929be granted."
7930 (let ((result nil)
7931 (offset (cond
7932 ((eq ?r access) 1)
7933 ((eq ?w access) 2)
7934 ((eq ?x access) 3))))
7935 (dolist (suffix '("string" "integer") result)
7936 (setq
7937 result
7938 (or
7939 result
7940 (let ((file-attr
7941 (tramp-get-file-property
7942 vec (tramp-file-name-localname vec)
7943 (concat "file-attributes-" suffix) nil))
7944 (remote-uid
7945 (tramp-get-connection-property
7946 vec (concat "uid-" suffix) nil))
7947 (remote-gid
7948 (tramp-get-connection-property
7949 vec (concat "gid-" suffix) nil)))
7950 (and
7951 file-attr
7952 (or
7953 ;; Not a symlink
7954 (eq t (car file-attr))
7955 (null (car file-attr)))
7956 (or
7957 ;; World accessible.
7958 (eq access (aref (nth 8 file-attr) (+ offset 6)))
7959 ;; User accessible and owned by user.
7960 (and
7961 (eq access (aref (nth 8 file-attr) offset))
7962 (equal remote-uid (nth 2 file-attr)))
7963 ;; Group accessible and owned by user's
7964 ;; principal group.
7965 (and
7966 (eq access (aref (nth 8 file-attr) (+ offset 3)))
7967 (equal remote-gid (nth 3 file-attr)))))))))))
7968
7969(defun tramp-get-inode (vec) 2855(defun tramp-get-inode (vec)
7970 "Returns the virtual inode number. 2856 "Returns the virtual inode number.
7971If it doesn't exist, generate a new one." 2857If it doesn't exist, generate a new one."
@@ -7992,199 +2878,6 @@ If it doesn't exist, generate a new one."
7992 (list string (length tramp-devices)))) 2878 (list string (length tramp-devices))))
7993 (cons -1 (nth 1 (assoc string tramp-devices))))) 2879 (cons -1 (nth 1 (assoc string tramp-devices)))))
7994 2880
7995(defun tramp-file-mode-from-int (mode)
7996 "Turn an integer representing a file mode into an ls(1)-like string."
7997 (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
7998 (user (logand (lsh mode -6) 7))
7999 (group (logand (lsh mode -3) 7))
8000 (other (logand (lsh mode -0) 7))
8001 (suid (> (logand (lsh mode -9) 4) 0))
8002 (sgid (> (logand (lsh mode -9) 2) 0))
8003 (sticky (> (logand (lsh mode -9) 1) 0)))
8004 (setq user (tramp-file-mode-permissions user suid "s"))
8005 (setq group (tramp-file-mode-permissions group sgid "s"))
8006 (setq other (tramp-file-mode-permissions other sticky "t"))
8007 (concat type user group other)))
8008
8009(defun tramp-file-mode-permissions (perm suid suid-text)
8010 "Convert a permission bitset into a string.
8011This is used internally by `tramp-file-mode-from-int'."
8012 (let ((r (> (logand perm 4) 0))
8013 (w (> (logand perm 2) 0))
8014 (x (> (logand perm 1) 0)))
8015 (concat (or (and r "r") "-")
8016 (or (and w "w") "-")
8017 (or (and suid x suid-text) ; suid, execute
8018 (and suid (upcase suid-text)) ; suid, !execute
8019 (and x "x") "-")))) ; !suid
8020
8021(defun tramp-decimal-to-octal (i)
8022 "Return a string consisting of the octal digits of I.
8023Not actually used. Use `(format \"%o\" i)' instead?"
8024 (cond ((< i 0) (error "Cannot convert negative number to octal"))
8025 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
8026 ((zerop i) "0")
8027 (t (concat (tramp-decimal-to-octal (/ i 8))
8028 (number-to-string (% i 8))))))
8029
8030;; Kudos to Gerd Moellmann for this suggestion.
8031(defun tramp-octal-to-decimal (ostr)
8032 "Given a string of octal digits, return a decimal number."
8033 (let ((x (or ostr "")))
8034 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
8035 (unless (string-match "\\`[0-7]*\\'" x)
8036 (error "Non-octal junk in string `%s'" x))
8037 (string-to-number ostr 8)))
8038
8039(defun tramp-shell-case-fold (string)
8040 "Converts STRING to shell glob pattern which ignores case."
8041 (mapconcat
8042 (lambda (c)
8043 (if (equal (downcase c) (upcase c))
8044 (vector c)
8045 (format "[%c%c]" (downcase c) (upcase c))))
8046 string
8047 ""))
8048
8049
8050;; ------------------------------------------------------------
8051;; -- Tramp file names --
8052;; ------------------------------------------------------------
8053;; Conversion functions between external representation and
8054;; internal data structure. Convenience functions for internal
8055;; data structure.
8056
8057(defun tramp-file-name-p (vec)
8058 "Check, whether VEC is a Tramp object."
8059 (and (vectorp vec) (= 4 (length vec))))
8060
8061(defun tramp-file-name-method (vec)
8062 "Return method component of VEC."
8063 (and (tramp-file-name-p vec) (aref vec 0)))
8064
8065(defun tramp-file-name-user (vec)
8066 "Return user component of VEC."
8067 (and (tramp-file-name-p vec) (aref vec 1)))
8068
8069(defun tramp-file-name-host (vec)
8070 "Return host component of VEC."
8071 (and (tramp-file-name-p vec) (aref vec 2)))
8072
8073(defun tramp-file-name-localname (vec)
8074 "Return localname component of VEC."
8075 (and (tramp-file-name-p vec) (aref vec 3)))
8076
8077;; The user part of a Tramp file name vector can be of kind
8078;; "user%domain". Sometimes, we must extract these parts.
8079(defun tramp-file-name-real-user (vec)
8080 "Return the user name of VEC without domain."
8081 (save-match-data
8082 (let ((user (tramp-file-name-user vec)))
8083 (if (and (stringp user)
8084 (string-match tramp-user-with-domain-regexp user))
8085 (match-string 1 user)
8086 user))))
8087
8088(defun tramp-file-name-domain (vec)
8089 "Return the domain name of VEC."
8090 (save-match-data
8091 (let ((user (tramp-file-name-user vec)))
8092 (and (stringp user)
8093 (string-match tramp-user-with-domain-regexp user)
8094 (match-string 2 user)))))
8095
8096;; The host part of a Tramp file name vector can be of kind
8097;; "host#port". Sometimes, we must extract these parts.
8098(defun tramp-file-name-real-host (vec)
8099 "Return the host name of VEC without port."
8100 (save-match-data
8101 (let ((host (tramp-file-name-host vec)))
8102 (if (and (stringp host)
8103 (string-match tramp-host-with-port-regexp host))
8104 (match-string 1 host)
8105 host))))
8106
8107(defun tramp-file-name-port (vec)
8108 "Return the port number of VEC."
8109 (save-match-data
8110 (let ((host (tramp-file-name-host vec)))
8111 (and (stringp host)
8112 (string-match tramp-host-with-port-regexp host)
8113 (string-to-number (match-string 2 host))))))
8114
8115(defun tramp-tramp-file-p (name)
8116 "Return t if NAME is a string with Tramp file name syntax."
8117 (save-match-data
8118 (and (stringp name) (string-match tramp-file-name-regexp name))))
8119
8120(defun tramp-find-method (method user host)
8121 "Return the right method string to use.
8122This is METHOD, if non-nil. Otherwise, do a lookup in
8123`tramp-default-method-alist'."
8124 (or method
8125 (let ((choices tramp-default-method-alist)
8126 lmethod item)
8127 (while choices
8128 (setq item (pop choices))
8129 (when (and (string-match (or (nth 0 item) "") (or host ""))
8130 (string-match (or (nth 1 item) "") (or user "")))
8131 (setq lmethod (nth 2 item))
8132 (setq choices nil)))
8133 lmethod)
8134 tramp-default-method))
8135
8136(defun tramp-find-user (method user host)
8137 "Return the right user string to use.
8138This is USER, if non-nil. Otherwise, do a lookup in
8139`tramp-default-user-alist'."
8140 (or user
8141 (let ((choices tramp-default-user-alist)
8142 luser item)
8143 (while choices
8144 (setq item (pop choices))
8145 (when (and (string-match (or (nth 0 item) "") (or method ""))
8146 (string-match (or (nth 1 item) "") (or host "")))
8147 (setq luser (nth 2 item))
8148 (setq choices nil)))
8149 luser)
8150 tramp-default-user))
8151
8152(defun tramp-find-host (method user host)
8153 "Return the right host string to use.
8154This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
8155 (or (and (> (length host) 0) host)
8156 tramp-default-host))
8157
8158(defun tramp-dissect-file-name (name &optional nodefault)
8159 "Return a `tramp-file-name' structure.
8160The structure consists of remote method, remote user, remote host
8161and localname (file name on remote host). If NODEFAULT is
8162non-nil, the file name parts are not expanded to their default
8163values."
8164 (save-match-data
8165 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
8166 (unless match (error "Not a Tramp file name: %s" name))
8167 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
8168 (user (match-string (nth 2 tramp-file-name-structure) name))
8169 (host (match-string (nth 3 tramp-file-name-structure) name))
8170 (localname (match-string (nth 4 tramp-file-name-structure) name)))
8171 (when (member method '("multi" "multiu"))
8172 (error
8173 "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
8174 method))
8175 (when host
8176 (when (string-match tramp-prefix-ipv6-regexp host)
8177 (setq host (replace-match "" nil t host)))
8178 (when (string-match tramp-postfix-ipv6-regexp host)
8179 (setq host (replace-match "" nil t host))))
8180 (if nodefault
8181 (vector method user host localname)
8182 (vector
8183 (tramp-find-method method user host)
8184 (tramp-find-user method user host)
8185 (tramp-find-host method user host)
8186 localname))))))
8187
8188(defun tramp-equal-remote (file1 file2) 2881(defun tramp-equal-remote (file1 file2)
8189 "Check, whether the remote parts of FILE1 and FILE2 are identical. 2882 "Check, whether the remote parts of FILE1 and FILE2 are identical.
8190The check depends on method, user and host name of the files. If 2883The check depends on method, user and host name of the files. If
@@ -8203,423 +2896,6 @@ would yield `t'. On the other hand, the following check results in nil:
8203 (stringp (file-remote-p file2)) 2896 (stringp (file-remote-p file2))
8204 (string-equal (file-remote-p file1) (file-remote-p file2)))) 2897 (string-equal (file-remote-p file1) (file-remote-p file2))))
8205 2898
8206(defun tramp-make-tramp-file-name (method user host localname)
8207 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
8208 (concat tramp-prefix-format
8209 (when (not (zerop (length method)))
8210 (concat method tramp-postfix-method-format))
8211 (when (not (zerop (length user)))
8212 (concat user tramp-postfix-user-format))
8213 (when host
8214 (if (string-match tramp-ipv6-regexp host)
8215 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8216 host))
8217 tramp-postfix-host-format
8218 (when localname localname)))
8219
8220(defun tramp-completion-make-tramp-file-name (method user host localname)
8221 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
8222It must not be a complete Tramp file name, but as long as there are
8223necessary only. This function will be used in file name completion."
8224 (concat tramp-prefix-format
8225 (when (not (zerop (length method)))
8226 (concat method tramp-postfix-method-format))
8227 (when (not (zerop (length user)))
8228 (concat user tramp-postfix-user-format))
8229 (when (not (zerop (length host)))
8230 (concat
8231 (if (string-match tramp-ipv6-regexp host)
8232 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8233 host)
8234 tramp-postfix-host-format))
8235 (when localname localname)))
8236
8237(defun tramp-make-copy-program-file-name (vec)
8238 "Create a file name suitable to be passed to `rcp' and workalikes."
8239 (let ((user (tramp-file-name-user vec))
8240 (host (tramp-file-name-real-host vec))
8241 (localname (tramp-shell-quote-argument
8242 (tramp-file-name-localname vec))))
8243 (if (not (zerop (length user)))
8244 (format "%s@%s:%s" user host localname)
8245 (format "%s:%s" host localname))))
8246
8247(defun tramp-method-out-of-band-p (vec size)
8248 "Return t if this is an out-of-band method, nil otherwise."
8249 (and
8250 ;; It shall be an out-of-band method.
8251 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
8252 ;; Either the file size is large enough, or (in rare cases) there
8253 ;; does not exist a remote encoding.
8254 (or (null tramp-copy-size-limit)
8255 (> size tramp-copy-size-limit)
8256 (null (tramp-get-inline-coding vec "remote-encoding" size)))))
8257
8258(defun tramp-local-host-p (vec)
8259 "Return t if this points to the local host, nil otherwise."
8260 ;; We cannot use `tramp-file-name-real-host'. A port is an
8261 ;; indication for an ssh tunnel or alike.
8262 (let ((host (tramp-file-name-host vec)))
8263 (and
8264 (stringp host)
8265 (string-match tramp-local-host-regexp host)
8266 ;; The method shall be applied to one of the shell file name
8267 ;; handler. `tramp-local-host-p' is also called for "smb" and
8268 ;; alike, where it must fail.
8269 (tramp-get-method-parameter
8270 (tramp-file-name-method vec) 'tramp-login-program)
8271 ;; The local temp directory must be writable for the other user.
8272 (file-writable-p
8273 (tramp-make-tramp-file-name
8274 (tramp-file-name-method vec)
8275 (tramp-file-name-user vec)
8276 host
8277 (tramp-compat-temporary-file-directory)))
8278 ;; On some systems, chown runs only for root.
8279 (or (zerop (user-uid))
8280 (zerop (tramp-get-remote-uid vec 'integer))))))
8281
8282;; Variables local to connection.
8283
8284(defun tramp-get-remote-path (vec)
8285 (with-connection-property
8286 ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
8287 ;; cache the result for the session only. Otherwise, the result
8288 ;; is cached persistently.
8289 (if (memq 'tramp-own-remote-path tramp-remote-path)
8290 (tramp-get-connection-process vec)
8291 vec)
8292 "remote-path"
8293 (let* ((remote-path (copy-tree tramp-remote-path))
8294 (elt1 (memq 'tramp-default-remote-path remote-path))
8295 (elt2 (memq 'tramp-own-remote-path remote-path))
8296 (default-remote-path
8297 (when elt1
8298 (condition-case nil
8299 (tramp-send-command-and-read
8300 vec "echo \\\"`getconf PATH`\\\"")
8301 ;; Default if "getconf" is not available.
8302 (error
8303 (tramp-message
8304 vec 3
8305 "`getconf PATH' not successful, using default value \"%s\"."
8306 "/bin:/usr/bin")
8307 "/bin:/usr/bin"))))
8308 (own-remote-path
8309 (when elt2
8310 (condition-case nil
8311 (tramp-send-command-and-read vec "echo \\\"$PATH\\\"")
8312 ;; Default if "getconf" is not available.
8313 (error
8314 (tramp-message
8315 vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.")
8316 nil)))))
8317
8318 ;; Replace place holder `tramp-default-remote-path'.
8319 (when elt1
8320 (setcdr elt1
8321 (append
8322 (tramp-compat-split-string default-remote-path ":")
8323 (cdr elt1)))
8324 (setq remote-path (delq 'tramp-default-remote-path remote-path)))
8325
8326 ;; Replace place holder `tramp-own-remote-path'.
8327 (when elt2
8328 (setcdr elt2
8329 (append
8330 (tramp-compat-split-string own-remote-path ":")
8331 (cdr elt2)))
8332 (setq remote-path (delq 'tramp-own-remote-path remote-path)))
8333
8334 ;; Remove double entries.
8335 (setq elt1 remote-path)
8336 (while (consp elt1)
8337 (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
8338 (setcar elt2 nil))
8339 (setq elt1 (cdr elt1)))
8340
8341 ;; Remove non-existing directories.
8342 (delq
8343 nil
8344 (mapcar
8345 (lambda (x)
8346 (and
8347 (stringp x)
8348 (file-directory-p
8349 (tramp-make-tramp-file-name
8350 (tramp-file-name-method vec)
8351 (tramp-file-name-user vec)
8352 (tramp-file-name-host vec)
8353 x))
8354 x))
8355 remote-path)))))
8356
8357(defun tramp-get-remote-tmpdir (vec)
8358 (with-connection-property vec "tmp-directory"
8359 (let ((dir (tramp-shell-quote-argument "/tmp")))
8360 (if (and (zerop
8361 (tramp-send-command-and-check
8362 vec (format "%s -d %s" (tramp-get-test-command vec) dir)))
8363 (zerop
8364 (tramp-send-command-and-check
8365 vec (format "%s -w %s" (tramp-get-test-command vec) dir))))
8366 dir
8367 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
8368
8369(defun tramp-get-ls-command (vec)
8370 (with-connection-property vec "ls"
8371 (tramp-message vec 5 "Finding a suitable `ls' command")
8372 (or
8373 (catch 'ls-found
8374 (dolist (cmd '("ls" "gnuls" "gls"))
8375 (let ((dl (tramp-get-remote-path vec))
8376 result)
8377 (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
8378 ;; Check parameters. On busybox, "ls" output coloring is
8379 ;; enabled by default sometimes. So we try to disable it
8380 ;; when possible. $LS_COLORING is not supported there.
8381 ;; Some "ls" versions are sensible wrt the order of
8382 ;; arguments, they fail when "-al" is after the
8383 ;; "--color=never" argument (for example on FreeBSD).
8384 (when (zerop (tramp-send-command-and-check
8385 vec (format "%s -lnd /" result)))
8386 (when (zerop (tramp-send-command-and-check
8387 vec (format
8388 "%s --color=never -al /dev/null" result)))
8389 (setq result (concat result " --color=never")))
8390 (throw 'ls-found result))
8391 (setq dl (cdr dl))))))
8392 (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
8393
8394(defun tramp-get-ls-command-with-dired (vec)
8395 (save-match-data
8396 (with-connection-property vec "ls-dired"
8397 (tramp-message vec 5 "Checking, whether `ls --dired' works")
8398 ;; Some "ls" versions are sensible wrt the order of arguments,
8399 ;; they fail when "-al" is after the "--dired" argument (for
8400 ;; example on FreeBSD).
8401 (zerop (tramp-send-command-and-check
8402 vec (format "%s --dired -al /dev/null"
8403 (tramp-get-ls-command vec)))))))
8404
8405(defun tramp-get-test-command (vec)
8406 (with-connection-property vec "test"
8407 (tramp-message vec 5 "Finding a suitable `test' command")
8408 (if (zerop (tramp-send-command-and-check vec "test 0"))
8409 "test"
8410 (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
8411
8412(defun tramp-get-test-nt-command (vec)
8413 ;; Does `test A -nt B' work? Use abominable `find' construct if it
8414 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
8415 ;; for otherwise the shell crashes.
8416 (with-connection-property vec "test-nt"
8417 (or
8418 (progn
8419 (tramp-send-command
8420 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
8421 (with-current-buffer (tramp-get-buffer vec)
8422 (goto-char (point-min))
8423 (when (looking-at (regexp-quote tramp-end-of-output))
8424 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
8425 (progn
8426 (tramp-send-command
8427 vec
8428 (format
8429 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
8430 (tramp-get-test-command vec)))
8431 "tramp_test_nt %s %s"))))
8432
8433(defun tramp-get-file-exists-command (vec)
8434 (with-connection-property vec "file-exists"
8435 (tramp-message vec 5 "Finding command to check if file exists")
8436 (tramp-find-file-exists-command vec)))
8437
8438(defun tramp-get-remote-ln (vec)
8439 (with-connection-property vec "ln"
8440 (tramp-message vec 5 "Finding a suitable `ln' command")
8441 (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
8442
8443(defun tramp-get-remote-perl (vec)
8444 (with-connection-property vec "perl"
8445 (tramp-message vec 5 "Finding a suitable `perl' command")
8446 (let ((result
8447 (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
8448 (tramp-find-executable
8449 vec "perl" (tramp-get-remote-path vec)))))
8450 ;; We must check also for some Perl modules.
8451 (when result
8452 (with-connection-property vec "perl-file-spec"
8453 (zerop
8454 (tramp-send-command-and-check
8455 vec (format "%s -e 'use File::Spec;'" result))))
8456 (with-connection-property vec "perl-cwd-realpath"
8457 (zerop
8458 (tramp-send-command-and-check
8459 vec (format "%s -e 'use Cwd \"realpath\";'" result)))))
8460 result)))
8461
8462(defun tramp-get-remote-stat (vec)
8463 (with-connection-property vec "stat"
8464 (tramp-message vec 5 "Finding a suitable `stat' command")
8465 (let ((result (tramp-find-executable
8466 vec "stat" (tramp-get-remote-path vec)))
8467 tmp)
8468 ;; Check whether stat(1) returns usable syntax. %s does not
8469 ;; work on older AIX systems.
8470 (when result
8471 (setq tmp
8472 ;; We don't want to display an error message.
8473 (with-temp-message (or (current-message) "")
8474 (condition-case nil
8475 (tramp-send-command-and-read
8476 vec (format "%s -c '(\"%%N\" %%s)' /" result))
8477 (error nil))))
8478 (unless (and (listp tmp) (stringp (car tmp))
8479 (string-match "^./.$" (car tmp))
8480 (integerp (cadr tmp)))
8481 (setq result nil)))
8482 result)))
8483
8484(defun tramp-get-remote-readlink (vec)
8485 (with-connection-property vec "readlink"
8486 (tramp-message vec 5 "Finding a suitable `readlink' command")
8487 (let ((result (tramp-find-executable
8488 vec "readlink" (tramp-get-remote-path vec))))
8489 (when (and result
8490 ;; We don't want to display an error message.
8491 (with-temp-message (or (current-message) "")
8492 (condition-case nil
8493 (zerop
8494 (tramp-send-command-and-check
8495 vec (format "%s --canonicalize-missing /" result)))
8496 (error nil))))
8497 result))))
8498
8499(defun tramp-get-remote-trash (vec)
8500 (with-connection-property vec "trash"
8501 (tramp-message vec 5 "Finding a suitable `trash' command")
8502 (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
8503
8504(defun tramp-get-remote-id (vec)
8505 (with-connection-property vec "id"
8506 (tramp-message vec 5 "Finding POSIX `id' command")
8507 (or
8508 (catch 'id-found
8509 (let ((dl (tramp-get-remote-path vec))
8510 result)
8511 (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
8512 ;; Check POSIX parameter.
8513 (when (zerop (tramp-send-command-and-check
8514 vec (format "%s -u" result)))
8515 (throw 'id-found result))
8516 (setq dl (cdr dl)))))
8517 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
8518
8519(defun tramp-get-remote-uid (vec id-format)
8520 (with-connection-property vec (format "uid-%s" id-format)
8521 (let ((res (tramp-send-command-and-read
8522 vec
8523 (format "%s -u%s %s"
8524 (tramp-get-remote-id vec)
8525 (if (equal id-format 'integer) "" "n")
8526 (if (equal id-format 'integer)
8527 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8528 ;; The command might not always return a number.
8529 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8530
8531(defun tramp-get-remote-gid (vec id-format)
8532 (with-connection-property vec (format "gid-%s" id-format)
8533 (let ((res (tramp-send-command-and-read
8534 vec
8535 (format "%s -g%s %s"
8536 (tramp-get-remote-id vec)
8537 (if (equal id-format 'integer) "" "n")
8538 (if (equal id-format 'integer)
8539 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8540 ;; The command might not always return a number.
8541 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8542
8543(defun tramp-get-local-uid (id-format)
8544 (if (equal id-format 'integer) (user-uid) (user-login-name)))
8545
8546(defun tramp-get-local-gid (id-format)
8547 (nth 3 (tramp-compat-file-attributes "~/" id-format)))
8548
8549;; Some predefined connection properties.
8550(defun tramp-get-inline-compress (vec prop size)
8551 "Return the compress command related to PROP.
8552PROP is either `inline-compress' or `inline-decompress'. SIZE is
8553the length of the file to be compressed.
8554
8555If no corresponding command is found, nil is returned."
8556 (when (and (integerp tramp-inline-compress-start-size)
8557 (> size tramp-inline-compress-start-size))
8558 (with-connection-property vec prop
8559 (tramp-find-inline-compress vec)
8560 (tramp-get-connection-property vec prop nil))))
8561
8562(defun tramp-get-inline-coding (vec prop size)
8563 "Return the coding command related to PROP.
8564PROP is either `remote-encoding', `remode-decoding',
8565`local-encoding' or `local-decoding'.
8566
8567SIZE is the length of the file to be coded. Depending on SIZE,
8568compression might be applied.
8569
8570If no corresponding command is found, nil is returned.
8571Otherwise, either a string is returned which contains a `%s' mark
8572to be used for the respective input or output file; or a Lisp
8573function cell is returned to be applied on a buffer."
8574 (let ((coding
8575 (with-connection-property vec prop
8576 (tramp-find-inline-encoding vec)
8577 (tramp-get-connection-property vec prop nil)))
8578 (prop1 (if (string-match "encoding" prop)
8579 "inline-compress" "inline-decompress"))
8580 compress)
8581 ;; The connection property might have been cached. So we must send
8582 ;; the script to the remote side - maybe.
8583 (when (and coding (symbolp coding) (string-match "remote" prop))
8584 (let ((name (symbol-name coding)))
8585 (while (string-match (regexp-quote "-") name)
8586 (setq name (replace-match "_" nil t name)))
8587 (tramp-maybe-send-script vec (symbol-value coding) name)
8588 (setq coding name)))
8589 (when coding
8590 ;; Check for the `compress' command.
8591 (setq compress (tramp-get-inline-compress vec prop1 size))
8592 ;; Return the value.
8593 (cond
8594 ((and compress (symbolp coding))
8595 (if (string-match "decompress" prop1)
8596 `(lambda (beg end)
8597 (,coding beg end)
8598 (let ((coding-system-for-write 'binary)
8599 (coding-system-for-read 'binary))
8600 (apply
8601 'call-process-region (point-min) (point-max)
8602 (car (split-string ,compress)) t t nil
8603 (cdr (split-string ,compress)))))
8604 `(lambda (beg end)
8605 (let ((coding-system-for-write 'binary)
8606 (coding-system-for-read 'binary))
8607 (apply
8608 'call-process-region beg end
8609 (car (split-string ,compress)) t t nil
8610 (cdr (split-string ,compress))))
8611 (,coding (point-min) (point-max)))))
8612 ((symbolp coding)
8613 coding)
8614 ((and compress (string-match "decoding" prop))
8615 (format "(%s | %s >%%s)" coding compress))
8616 (compress
8617 (format "(%s <%%s | %s)" compress coding))
8618 ((string-match "decoding" prop)
8619 (format "%s >%%s" coding))
8620 (t
8621 (format "%s <%%s" coding))))))
8622
8623(defun tramp-get-method-parameter (method param) 2899(defun tramp-get-method-parameter (method param)
8624 "Return the method parameter PARAM. 2900 "Return the method parameter PARAM.
8625If the `tramp-methods' entry does not exist, return nil." 2901If the `tramp-methods' entry does not exist, return nil."
@@ -8632,27 +2908,26 @@ If the `tramp-methods' entry does not exist, return nil."
8632 "Check, whether OPERATION runs a file name handler." 2908 "Check, whether OPERATION runs a file name handler."
8633 ;; The file name handler is determined on base of either an 2909 ;; The file name handler is determined on base of either an
8634 ;; argument, `buffer-file-name', or `default-directory'. 2910 ;; argument, `buffer-file-name', or `default-directory'.
8635 (condition-case nil 2911 (ignore-errors
8636 (let* ((buffer-file-name "/") 2912 (let* ((buffer-file-name "/")
8637 (default-directory "/") 2913 (default-directory "/")
8638 (fnha file-name-handler-alist) 2914 (fnha file-name-handler-alist)
8639 (check-file-name-operation operation) 2915 (check-file-name-operation operation)
8640 (file-name-handler-alist 2916 (file-name-handler-alist
8641 (list 2917 (list
8642 (cons "/" 2918 (cons "/"
8643 (lambda (operation &rest args) 2919 (lambda (operation &rest args)
8644 "Returns OPERATION if it is the one to be checked." 2920 "Returns OPERATION if it is the one to be checked."
8645 (if (equal check-file-name-operation operation) 2921 (if (equal check-file-name-operation operation)
8646 operation 2922 operation
8647 (let ((file-name-handler-alist fnha)) 2923 (let ((file-name-handler-alist fnha))
8648 (apply operation args)))))))) 2924 (apply operation args))))))))
8649 (equal (apply operation args) operation)) 2925 (equal (apply operation args) operation))))
8650 (error nil)))
8651 2926
8652(unless (tramp-exists-file-name-handler 'make-auto-save-file-name) 2927(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
8653 (defadvice make-auto-save-file-name 2928 (defadvice make-auto-save-file-name
8654 (around tramp-advice-make-auto-save-file-name () activate) 2929 (around tramp-advice-make-auto-save-file-name () activate)
8655 "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files." 2930 "Invoke `tramp-*-handle-make-auto-save-file-name' for Tramp files."
8656 (if (tramp-tramp-file-p (buffer-file-name)) 2931 (if (tramp-tramp-file-p (buffer-file-name))
8657 ;; We cannot call `tramp-handle-make-auto-save-file-name' 2932 ;; We cannot call `tramp-handle-make-auto-save-file-name'
8658 ;; directly, because this would bypass the locking mechanism. 2933 ;; directly, because this would bypass the locking mechanism.
@@ -8682,8 +2957,9 @@ If the `tramp-methods' entry does not exist, return nil."
8682 ;; Permissions should be set always, because there might be an old 2957 ;; Permissions should be set always, because there might be an old
8683 ;; auto-saved file belonging to another original file. This could 2958 ;; auto-saved file belonging to another original file. This could
8684 ;; be a security threat. 2959 ;; be a security threat.
8685 (set-file-modes buffer-auto-save-file-name 2960 (set-file-modes
8686 (or (file-modes bfn) (tramp-octal-to-decimal "0600")))))) 2961 buffer-auto-save-file-name
2962 (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600"))))))
8687 2963
8688(unless (and (featurep 'xemacs) 2964(unless (and (featurep 'xemacs)
8689 (= emacs-major-version 21) 2965 (= emacs-major-version 21)
@@ -8787,7 +3063,6 @@ Return the difference in the format of a time value."
8787(defun tramp-time-diff (t1 t2) 3063(defun tramp-time-diff (t1 t2)
8788 "Return the difference between the two times, in seconds. 3064 "Return the difference between the two times, in seconds.
8789T1 and T2 are time values (as returned by `current-time' for example)." 3065T1 and T2 are time values (as returned by `current-time' for example)."
8790 ;; Pacify byte-compiler with `symbol-function'.
8791 (cond ((and (fboundp 'subtract-time) 3066 (cond ((and (fboundp 'subtract-time)
8792 (fboundp 'float-time)) 3067 (fboundp 'float-time))
8793 (tramp-compat-funcall 3068 (tramp-compat-funcall
@@ -8863,6 +3138,7 @@ exiting if process is running."
8863;; CCC: This function should be rewritten so that 3138;; CCC: This function should be rewritten so that
8864;; `shell-quote-argument' is not used. This way, we are safe from 3139;; `shell-quote-argument' is not used. This way, we are safe from
8865;; changes in `shell-quote-argument'. 3140;; changes in `shell-quote-argument'.
3141;;;###tramp-autoload
8866(defun tramp-shell-quote-argument (s) 3142(defun tramp-shell-quote-argument (s)
8867 "Similar to `shell-quote-argument', but groks newlines. 3143 "Similar to `shell-quote-argument', but groks newlines.
8868Only works for Bourne-like shells." 3144Only works for Bourne-like shells."
@@ -8888,112 +3164,42 @@ Only works for Bourne-like shells."
8888(defun tramp-unload-tramp () 3164(defun tramp-unload-tramp ()
8889 "Discard Tramp from loading remote files." 3165 "Discard Tramp from loading remote files."
8890 (interactive) 3166 (interactive)
8891 ;; When Tramp is not loaded yet, its autoloads are still active.
8892 (tramp-unload-file-name-handlers)
8893 ;; ange-ftp settings must be enabled. 3167 ;; ange-ftp settings must be enabled.
8894 (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp) 3168 (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
8895 ;; Maybe its not loaded yet. 3169 ;; Maybe it's not loaded yet.
8896 (condition-case nil 3170 (ignore-errors (unload-feature 'tramp 'force)))
8897 (unload-feature 'tramp 'force)
8898 (error nil)))
8899
8900(when (and load-in-progress
8901 (string-match "Loading tramp..." (or (current-message) "")))
8902 (message "Loading tramp...done"))
8903 3171
8904(provide 'tramp) 3172(provide 'tramp)
8905 3173
8906;;; TODO: 3174;;; TODO:
8907 3175
8908;; * Handle nonlocal exits such as C-g.
8909;; * But it would probably be better to use with-local-quit at the
8910;; place where it's actually needed: around any potentially
8911;; indefinitely blocking piece of code. In this case it would be
8912;; within Tramp around one of its calls to accept-process-output (or
8913;; around one of the loops that calls accept-process-output)
8914;; (Stefan Monnier).
8915;; * Rewrite `tramp-shell-quote-argument' to abstain from using 3176;; * Rewrite `tramp-shell-quote-argument' to abstain from using
8916;; `shell-quote-argument'. 3177;; `shell-quote-argument'.
8917;; * In Emacs 21, `insert-directory' shows total number of bytes used 3178;; * In Emacs 21, `insert-directory' shows total number of bytes used
8918;; by the files in that directory. Add this here. 3179;; by the files in that directory. Add this here.
8919;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) 3180;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
8920;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) 3181;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
8921;; * Don't use globbing for directories with many files, as this is
8922;; likely to produce long command lines, and some shells choke on
8923;; long command lines.
8924;; * How to deal with MULE in `insert-file-contents' and `write-region'?
8925;; * abbreviate-file-name 3182;; * abbreviate-file-name
8926;; * Better error checking. At least whenever we see something 3183;; * Better error checking. At least whenever we see something
8927;; strange when doing zerop, we should kill the process and start 3184;; strange when doing zerop, we should kill the process and start
8928;; again. (Greg Stark) 3185;; again. (Greg Stark)
8929;; * Remove unneeded parameters from methods.
8930;; * Make it work for different encodings, and for different file name
8931;; encodings, too. (Daniel Pittman)
8932;; * Don't search for perl5 and perl. Instead, only search for perl and
8933;; then look if it's the right version (with `perl -v').
8934;; * When editing a remote CVS controlled file as a different user, VC
8935;; gets confused about the file locking status. Try to find out why
8936;; the workaround doesn't work.
8937;; * Username and hostname completion. 3186;; * Username and hostname completion.
8938;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'. 3187;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
8939;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'. 3188;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
8940;; Code is nearly identical. 3189;; Code is nearly identical.
8941;; * Allow out-of-band methods as _last_ multi-hop. Open a connection
8942;; until the last but one hop via `start-file-process'. Apply it
8943;; also for ftp and smb.
8944;; * WIBNI if we had a command "trampclient"? If I was editing in
8945;; some shell with root priviledges, it would be nice if I could
8946;; just call
8947;; trampclient filename.c
8948;; as an editor, and the _current_ shell would connect to an Emacs
8949;; server and would be used in an existing non-priviledged Emacs
8950;; session for doing the editing in question.
8951;; That way, I need not tell Emacs my password again and be afraid
8952;; that it makes it into core dumps or other ugly stuff (I had Emacs
8953;; once display a just typed password in the context of a keyboard
8954;; sequence prompt for a question immediately following in a shell
8955;; script run within Emacs -- nasty).
8956;; And if I have some ssh session running to a different computer,
8957;; having the possibility of passing a local file there to a local
8958;; Emacs session (in case I can arrange for a connection back) would
8959;; be nice.
8960;; Likely the corresponding Tramp server should not allow the
8961;; equivalent of the emacsclient -eval option in order to make this
8962;; reasonably unproblematic. And maybe trampclient should have some
8963;; way of passing credentials, like by using an SSL socket or
8964;; something. (David Kastrup)
8965;; * Reconnect directly to a compliant shell without first going
8966;; through the user's default shell. (Pete Forman)
8967;; * Make `tramp-default-user' obsolete. 3190;; * Make `tramp-default-user' obsolete.
8968;; * How can I interrupt the remote process with a signal
8969;; (interrupt-process seems not to work)? (Markus Triska)
8970;; * Avoid the local shell entirely for starting remote processes. If
8971;; so, I think even a signal, when delivered directly to the local
8972;; SSH instance, would correctly be propagated to the remote process
8973;; automatically; possibly SSH would have to be started with
8974;; "-t". (Markus Triska)
8975;; * It makes me wonder if tramp couldn't fall back to ssh when scp
8976;; isn't on the remote host. (Mark A. Hershberger)
8977;; * Use lsh instead of ssh. (Alfred M. Szmidt)
8978;; * Implement a general server-local-variable mechanism, as there are 3191;; * Implement a general server-local-variable mechanism, as there are
8979;; probably other variables that need different values for different 3192;; probably other variables that need different values for different
8980;; servers too. The user could then configure a variable (such as 3193;; servers too. The user could then configure a variable (such as
8981;; tramp-server-local-variable-alist) to define any such variables 3194;; tramp-server-local-variable-alist) to define any such variables
8982;; that they need to, which would then be let bound as appropriate 3195;; that they need to, which would then be let bound as appropriate
8983;; in tramp functions. (Jason Rumney) 3196;; in tramp functions. (Jason Rumney)
8984;; * Optimize out-of-band copying, when both methods are scp-like (not
8985;; rsync).
8986;; * Keep a second connection open for out-of-band methods like scp or
8987;; rsync.
8988;; * IMHO, it's a drawback that currently Tramp doesn't support 3197;; * IMHO, it's a drawback that currently Tramp doesn't support
8989;; Unicode in Dired file names by default. Is it possible to 3198;; Unicode in Dired file names by default. Is it possible to
8990;; improve Tramp to set LC_ALL to "C" only for commands where Tramp 3199;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
8991;; expects English? Or just to set LC_MESSAGES to "C" if Tramp 3200;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
8992;; expects only English messages? (Juri Linkov) 3201;; expects only English messages? (Juri Linkov)
8993;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) 3202;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
8994;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705)
8995;; * Try telnet+curl as new method. It might be useful for busybox,
8996;; without built-in uuencode/uudecode.
8997;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. 3203;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'.
8998;; * I was wondering it it would be possible to use tramp even if I'm 3204;; * I was wondering it it would be possible to use tramp even if I'm
8999;; actually using sshfs. But when I launch a command I would like 3205;; actually using sshfs. But when I launch a command I would like
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 8725721869d..7690e859310 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -31,16 +31,29 @@
31;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; 31;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
32;; should be changed only there. 32;; should be changed only there.
33 33
34(defconst tramp-version "2.1.19" 34;;;###tramp-autoload
35(defconst tramp-version "2.2.0-pre"
35 "This version of Tramp.") 36 "This version of Tramp.")
36 37
38;;;###tramp-autoload
37(defconst tramp-bug-report-address "tramp-devel@gnu.org" 39(defconst tramp-bug-report-address "tramp-devel@gnu.org"
38 "Email address to send bug reports to.") 40 "Email address to send bug reports to.")
39 41
40;; Check for (X)Emacs version. 42;; Check for (X)Emacs version.
41(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) 43(let ((x (if (or (>= emacs-major-version 22)
44 (and (featurep 'xemacs)
45 (= emacs-major-version 21)
46 (>= emacs-minor-version 4)))
47 "ok"
48 (format "Tramp 2.2.0-pre is not fit for %s"
49 (when (string-match "^.*$" (emacs-version))
50 (match-string 0 (emacs-version)))))))
42 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 51 (unless (string-match "\\`ok\\'" x) (error "%s" x)))
43 52
53(add-hook 'tramp-unload-hook
54 (lambda ()
55 (unload-feature 'trampver 'force)))
56
44(provide 'trampver) 57(provide 'trampver)
45 58
46;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1 59;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1
diff --git a/lisp/notifications.el b/lisp/notifications.el
index beb63a6311b..68db58e54fa 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -42,6 +42,9 @@
42 42
43(require 'dbus) 43(require 'dbus)
44 44
45(defconst notifications-specification-version "1.1"
46 "The version of the Desktop Notifications Specification implemented.")
47
45(defconst notifications-application-name "Emacs" 48(defconst notifications-application-name "Emacs"
46 "Default application name.") 49 "Default application name.")
47 50
@@ -151,7 +154,14 @@ Various PARAMS can be set:
151 :image-data This is a raw data image format which describes the width, 154 :image-data This is a raw data image format which describes the width,
152 height, rowstride, has alpha, bits per sample, channels and 155 height, rowstride, has alpha, bits per sample, channels and
153 image data respectively. 156 image data respectively.
157 :image-path This is represented either as a URI (file:// is the
158 only URI schema supported right now) or a name
159 in a freedesktop.org-compliant icon theme.
154 :sound-file The path to a sound file to play when the notification pops up. 160 :sound-file The path to a sound file to play when the notification pops up.
161 :sound-name A themeable named sound from the freedesktop.org sound naming
162 specification to play when the notification pops up.
163 Similar to icon-name,only for sounds. An example would
164 be \"message-new-instant\".
155 :suppress-sound Causes the server to suppress playing any sounds, if it has 165 :suppress-sound Causes the server to suppress playing any sounds, if it has
156 that ability. 166 that ability.
157 :x Specifies the X location on the screen that the notification 167 :x Specifies the X location on the screen that the notification
@@ -186,7 +196,9 @@ used to manipulate the notification item with
186 (category (plist-get params :category)) 196 (category (plist-get params :category))
187 (desktop-entry (plist-get params :desktop-entry)) 197 (desktop-entry (plist-get params :desktop-entry))
188 (image-data (plist-get params :image-data)) 198 (image-data (plist-get params :image-data))
199 (image-path (plist-get params :image-path))
189 (sound-file (plist-get params :sound-file)) 200 (sound-file (plist-get params :sound-file))
201 (sound-name (plist-get params :sound-name))
190 (suppress-sound (plist-get params :suppress-sound)) 202 (suppress-sound (plist-get params :suppress-sound))
191 (x (plist-get params :x)) 203 (x (plist-get params :x))
192 (y (plist-get params :y)) 204 (y (plist-get params :y))
@@ -211,10 +223,18 @@ used to manipulate the notification item with
211 (add-to-list 'hints `(:dict-entry 223 (add-to-list 'hints `(:dict-entry
212 "image_data" 224 "image_data"
213 (:variant :struct ,image-data)) t)) 225 (:variant :struct ,image-data)) t))
226 (when image-path
227 (add-to-list 'hints `(:dict-entry
228 "image_path"
229 (:variant :string ,image-path)) t))
214 (when sound-file 230 (when sound-file
215 (add-to-list 'hints `(:dict-entry 231 (add-to-list 'hints `(:dict-entry
216 "sound-file" 232 "sound-file"
217 (:variant :string ,sound-file)) t)) 233 (:variant :string ,sound-file)) t))
234 (when sound-name
235 (add-to-list 'hints `(:dict-entry
236 "sound-name"
237 (:variant :string ,sound-name)) t))
218 (when suppress-sound 238 (when suppress-sound
219 (add-to-list 'hints `(:dict-entry 239 (add-to-list 'hints `(:dict-entry
220 "suppress-sound" 240 "suppress-sound"
diff --git a/lisp/nxml/TODO b/lisp/nxml/TODO
deleted file mode 100644
index a5ac542f942..00000000000
--- a/lisp/nxml/TODO
+++ /dev/null
@@ -1,468 +0,0 @@
1* High priority
2
3** Command to insert an element template, including all required
4attributes and child elements. When there's a choice of elements
5possible, we could insert a comment, and put an overlay on that
6comment that makes it behave like a button with a pop-up menu to
7select the appropriate choice.
8
9** Command to tag a region. With a schema should complete using legal
10tags, but should work without a schema as well.
11
12** Provide a way to conveniently rename an element. With a schema should
13complete using legal tags, but should work without a schema as well.
14
15* Outlining
16
17** Implement C-c C-o C-q.
18
19** Install pre/post command hook for moving out of invisible section.
20
21** Put a modify hook on invisible sections that expands them.
22
23** Integrate dumb folding somehow.
24
25** An element should be able to be its own heading.
26
27** Optimize to avoid complete buffer scan on each command.
28
29** Make it work with HTML-style headings (i.e. level indicated by
30name of heading element rather than depth of section nesting).
31
32** Recognize root element as a section provided it has a title, even
33if it doesn't match section-element-name-regex.
34
35** Support for incremental search automatically making hidden text
36visible.
37
38** Allow title to be an attribute.
39
40** Command that says to recognize the tag at point as a section/heading.
41
42** Explore better ways to determine when an element is a section
43or a heading.
44
45** rng-next-error needs to either ignore invisible portion or reveal it
46(maybe use isearch oriented text properties).
47
48** Errors within hidden section should be highlighted by underlining the
49ellipsis.
50
51** Make indirect buffers work.
52
53** How should nxml-refresh outline recover from non well-formed tags?
54
55** Hide tags in title elements?
56
57** Use overlays instead of text properties for holding outline state?
58Necessary for indirect buffers to work?
59
60** Allow an outline to go in the speedbar.
61
62** Split up outlining manual section into subsections.
63
64** More detail in the manual about each outlining command.
65
66** More menu entries for hiding/showing?
67
68** Indication of many lines have been hidden?
69
70* Locating schemas
71
72** Should rng-validate-mode give the user an opportunity to specify a
73schema if there is currently none? Or should it at least give a hint
74to the user how to specify a non-vacuous schema?
75
76** Support for adding new schemas to schema-locating files. Add
77documentElement and namespace elements.
78
79** C-c C-w should be able to report current type id.
80
81** Implement doctypePublicId.
82
83** Implement typeIdBase.
84
85** Implement typeIdProcessingInstruction.
86
87** Support xml:base.
88
89** Implement group.
90
91** Find preferred prefix from schema-locating files. Get rid of
92rng-preferred-prefix-alist.
93
94** Inserting document element with vacuous schema should complete using
95document elements declared in schema locating files, and set schema
96appropriately.
97
98** Add a ruleType attribute to the <include> element?
99
100** Allow processing instruction in prolog to contain the compact syntax
101schema directly.
102
103** Use RDDL to locate a schema based on the namespace URI.
104
105** Should not prompt to add redundant association to schema locating
106file.
107
108** Command to reload current schema.
109
110* Schema-sensitive features
111
112** Should filter dynamic markup possibilities using schema validity, by
113adding hook to nxml-mode.
114
115** Dynamic markup word should (at least optionally) be able to look in
116other buffers that are using nxml-mode.
117
118** Should clicking on Invalid move to next error if already on an error?
119
120** Take advantage of a:documentation. Needs change to schema format.
121
122** Provide feasible validation (as in Jing) toggle.
123
124** Save the validation state as a property on the error overlay to enable
125more detailed diagnosis.
126
127** Provide an Error Summary buffer showing all the validation errors.
128
129** Pop-up menu. What is useful? Tag a region (should be greyed out if
130the region is not balanced). Suggestions based on error messages.
131
132** Have configurable list of namespace URIs so that we can provide
133namespace URI completion on extension elements or with schema-less
134documents.
135
136** Allow validation to handle XInclude.
137
138** ID/IDREF support.
139
140* Completion
141
142** Make it work with icomplete. Only use a function to complete when
143some of the possible names have undeclared namespaces.
144
145** How should C-return in mixed text work?
146
147** When there's a vacuous schema, C-return after < will insert the
148end-tag. Is this a bug or a feature?
149
150** After completing start-tag, ensure we don't get unhelpful message
151from validation
152
153** Syntax table for completion.
154
155** Should complete start-tag name with a space if namespace attributes
156are required.
157
158** When completing start-tag name with no prefix and it doesn't match
159should try to infer namespace from local name.
160
161** Should completion pay attention to characters after point? If so,
162how?
163
164** When completing start-tag name, add required atts if only one required
165attribute.
166
167** When completing attribute name, add attribute value if only one value
168is possible.
169
170** After attribute-value completion, insert space after close delimiter
171if more attributes are required.
172
173** Complete on enumerated data values in elements.
174
175** When in context that allows only elements, should get tag
176completion without having to type < first.
177
178** When immediately after start-tag name, and name is valid and not
179prefix of any other name, should C-return complete on attribute names?
180
181** When completing attributes, more consistent to ignore all attributes
182after point.
183
184** Inserting attribute value completions needs to be sensitive to what
185delimiter is used so that it quotes the correct character.
186
187** Complete on encoding-names in XML decl.
188
189** Complete namespace declarations by searching for all namespaces
190mentioned in the schema.
191
192* Well-formed XML support
193
194** Deal better with Mule-UCS
195
196** Deal with UTF-8 BOM when reading.
197
198** Complete entity names.
199
200** Provide some support for entity names for MathML.
201
202** Command to repeat the last tag.
203
204** Support for changing between character references and characters.
205Need to check that context is one in which character references are
206allowed. xmltok prolog parsing will need to distinguish parameter
207literals from other kinds of literal.
208
209** Provide a comment command to bind to M-; that works better than the
210normal one.
211
212** Make indenting in a multi-line comment work.
213
214** Structure view. Separate buffer displaying element tree. Be able to
215navigate from structure view to document and vice-versa.
216
217** Flash matching >.
218
219** Smart selection command that selects increasingly large syntactically
220coherent chunks of XML. If point is in an attribute value, first
221select complete value; then if command is repeated, select value plus
222delimiters, then select attribute name as well, then complete
223start-tag, then complete element, then enclosing element, etc.
224
225** ispell integration.
226
227** Block-level items in mixed content should be indented, e.g:
228 <para>This is list:
229 <ul>
230 <li>item</li>
231
232** Provide option to indent like this:
233
234** <para>This is a paragraph
235 occupying multiple lines.</para>
236
237** Option to add make a / that closes a start-tag electrically insert a
238space for the XHTML guys.
239
240** C-M-q should work.
241
242* Datatypes
243
244** Figure out workaround for CJK characters with regexps.
245
246** Does category C contain Cn?
247
248** Do ENTITY datatype properly.
249
250* XML Parsing Library
251
252** Parameter entity parsing option, nil (never), t (always),
253unless-standalone (unless standalone="yes" in XML declaration).
254
255** When a file is currently being edited, there should be an option to
256use its buffer instead of the on-disk copy.
257
258* Handling all XML features
259
260** Provide better support for editing external general parsed entities.
261Perhaps provide a way to force ignoring undefined entities; maybe turn
262this on automatically with <?xml encoding=""?> (with no version
263pseudo-att).
264
265** Handle internal general entity declarations containing elements.
266
267** Handle external general entity declarations.
268
269** Handle default attribute declarations in internal subset.
270
271** Handle parameter entities (including DTD).
272
273* RELAX NG
274
275** Do complete schema checking, at least optionally.
276
277** Detect include/external loops during schema parse.
278
279** Coding system detection for schemas. Should use utf-8/utf-16 per the
280spec. But also need to allow encodings other than UTF-8/16 to support
281CJK charsets that Emacs cannot represent in Unicode.
282
283* Catching XML errors
284
285** Check public identifiers.
286
287** Check default attribute values.
288
289* Performance
290
291** Explore whether overlay-recenter can cure overlays performance
292problems.
293
294** Cache schemas. Need to have list of files and mtimes.
295
296** Make it possible to reduce rng-validate-chunk-size significantly,
297perhaps to 500 bytes, without bad performance impact: don't do
298redisplay on every chunk; pass continue functions on other uses of
299rng-do-some-validation.
300
301** Cache after first tag.
302
303** Introduce a new name class that is a choice between names (so that
304we can use member)
305
306** intern-choice should simplify after patterns with same 1st/2nd args
307
308** Large numbers of overlays slow things down dramatically. Represent
309errors using text properties. This implies we cannot incrementally
310keep track of the number of errors, in order to determine validity.
311Instead, when validation completes, scan for any characters with an
312error text property; this seems to be fast enough even with large
313buffers. Problem with error at end of buffer, where there's no
314character; need special variable for this. Need to merge face from
315font-lock with the error face: use :inherit attribute with list of two
316faces. How do we avoid making rng-valid depend on nxml-mode?
317
318* Error recovery
319
320** Don't stop at newline in looking for close of start-tag.
321
322** Use indentation to guide recovery from mismatched end-tags
323
324** Don't keep parsing when currently not well-formed but previously
325well-formed
326
327** Try to recover from a bad start-tag by popping an open element if
328there was a mismatched end-tag unaccounted for.
329
330** Try to recover from a bad start-tag open on the hypothesis that there
331was an error in the namespace URI.
332
333** Better recovery from ill-formed XML declarations.
334
335* Useability improvements
336
337** Should print a "Parsing..." message during long movements.
338
339** Provide better position for reference to undefined pattern error.
340
341** Put Well-formed in the mode-line when validating against any-content.
342
343** Trim marking of illegal data for leading and trailing whitespace.
344
345** Show Invalid status as soon as we are sure it's invalid, rather than
346waiting for everything to be completely up to date.
347
348** When narrowed, Valid or Invalid status should probably consider only
349validity of narrowed region.
350
351* Bug fixes
352
353** Need to give an error for a document like: <foo/><![CDATA[ ]]>
354
355** Make nxml-forward-balanced-item work better for the prolog.
356
357** Make filling and indenting comments work in the prolog.
358
359** Should delete RNC Input buffers.
360
361** Figure out what regex use for NCName and use it consistently,
362
363** Should have not-well-formed tokens in ref.
364
365** Require version in XML declaration? Probably not because prevents
366use for external parsed entities. At least forbid standalone
367without version.
368
369** Reject schema that compiles to rng-not-allowed-ipattern.
370
371** Move point backwards on schema parse error so that it's on the right token.
372
373* Internal
374
375** Use rng-quote-string consistently.
376
377** Use parsing library for XML to texinfo conversion.
378
379** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of
380xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to
381nxml-t-token-start.
382
383** Can we set fill-prefix to nil and rely on indenting?
384
385** xmltok should make available replacement text of entities containing
386elements
387
388** In rng-valid, instead of using modification-hooks and
389insert-behind-hooks on dependent overlays, use same technique as
390nxml-mode.
391
392** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on
393Mule-UCS); overlays/text properties vs extents; absence of
394fontification-functions hook.
395
396* Fontification
397
398** Allow face to depend on element qname, attribute qname, attribute
399value. Use list with pairs of (R . F), where R specifies regexps and
400F specifies faces. How can this list be made to depend on the
401document type?
402
403* Other
404
405** Support RELAX NG XML syntax (use XML parsing library).
406
407** Support W3C XML Schema (use XML parsing library).
408
409** Command to infer schema from current document (like trang).
410
411* Schemas
412
413** XSLT schema should take advantage of RELAX NG to express cooccurrence
414constraints on attributes (e.g. xsl:template).
415
416* Documentation
417
418** Move material from README to manual.
419
420** Document encodings.
421
422* Notes
423
424** How can we allow an error to be displayed on a different token from
425where it is detected? In particular, for a missing closing ">" we
426will need to display it at the beginning of the following token. At
427the moment, when we parse the following token the error overlay will
428get cleared.
429
430** How should rng-goto-next-error deal with narrowing?
431
432** Perhaps should merge errors having same start position even if they
433have different ends.
434
435** How to handle surrogates? One possibility is to be compatible with
436utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible
437with this.
438
439** Should we distinguish well-formedness errors from invalidity errors?
440(I think not: we may want to recover from a bad start-tag by implying
441an end-tag.)
442
443** Seems to be a bug with Emacs, where a mouse movement that causes
444help-echo text to appear counts as pending input but does not cause
445idle timer to be restarted.
446
447** Use XML to represent this file.
448
449** I had a TODO which said simply "split-string". What did I mean?
450
451** Investigate performance on large files all on one line.
452
453* Issues for Emacs versions >= 22
454
455** Take advantage of UTF-8 CJK support.
456
457** Supply a next-error-function.
458
459** Investigate this NEWS item "Emacs now tries to set up buffer coding
460systems for HTML/XML files automatically."
461
462** Take advantage of the pointer text property.
463
464** Leverage char-displayable-p.
465
466Local variables:
467mode: outline
468end:
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
index 4531bc06f81..0245537faaa 100644
--- a/lisp/obsolete/old-whitespace.el
+++ b/lisp/obsolete/old-whitespace.el
@@ -788,7 +788,7 @@ This is meant to be added buffer-locally to `write-file-functions'."
788 788
789(defun whitespace-unload-function () 789(defun whitespace-unload-function ()
790 "Unload the whitespace library." 790 "Unload the whitespace library."
791 (if (unintern "whitespace-unload-hook") 791 (if (unintern "whitespace-unload-hook" obarray)
792 ;; if whitespace-unload-hook is defined, let's get rid of it 792 ;; if whitespace-unload-hook is defined, let's get rid of it
793 ;; and recursively call `unload-feature' 793 ;; and recursively call `unload-feature'
794 (progn (unload-feature 'whitespace) t) 794 (progn (unload-feature 'whitespace) t)
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 227f202fef0..4bbe1e43f85 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -834,10 +834,7 @@ the 4 file locations can be clicked on and jumped to."
834;; 834;;
835;; On Emacs, this is done through the `syntax-table' text property. The 835;; On Emacs, this is done through the `syntax-table' text property. The
836;; corresponding action is applied automatically each time the buffer 836;; corresponding action is applied automatically each time the buffer
837;; changes. If `font-lock-mode' is enabled (the default) the action is 837;; changes via syntax-propertize-function.
838;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it
839;; manually in `ada-after-change-function'. The proper method is
840;; installed by `ada-handle-syntax-table-properties'.
841;; 838;;
842;; on XEmacs, the `syntax-table' property does not exist and we have to use a 839;; on XEmacs, the `syntax-table' property does not exist and we have to use a
843;; slow advice to `parse-partial-sexp' to do the same thing. 840;; slow advice to `parse-partial-sexp' to do the same thing.
@@ -937,6 +934,12 @@ declares it as a word constituent."
937 (insert (caddar change)) 934 (insert (caddar change))
938 (setq change (cdr change))))))) 935 (setq change (cdr change)))))))
939 936
937(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
938 ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table
939 ;; properties, and in some cases we even had to do it manually (in
940 ;; `ada-after-change-function'). `ada-handle-syntax-table-properties'
941 ;; decides which method to use.
942
940(defun ada-set-syntax-table-properties () 943(defun ada-set-syntax-table-properties ()
941 "Assign `syntax-table' properties in accessible part of buffer. 944 "Assign `syntax-table' properties in accessible part of buffer.
942In particular, character constants are said to be strings, #...# 945In particular, character constants are said to be strings, #...#
@@ -991,6 +994,8 @@ OLD-LEN indicates what the length of the replaced text was."
991 ;; Take care of `syntax-table' properties manually. 994 ;; Take care of `syntax-table' properties manually.
992 (ada-initialize-syntax-table-properties))) 995 (ada-initialize-syntax-table-properties)))
993 996
997) ;;(not (fboundp 'syntax-propertize))
998
994;;------------------------------------------------------------------ 999;;------------------------------------------------------------------
995;; Testing the grammatical context 1000;; Testing the grammatical context
996;;------------------------------------------------------------------ 1001;;------------------------------------------------------------------
@@ -1118,7 +1123,8 @@ the file name."
1118 1123
1119;;;###autoload 1124;;;###autoload
1120(defun ada-mode () 1125(defun ada-mode ()
1121 "Ada mode is the major mode for editing Ada code." 1126 "Ada mode is the major mode for editing Ada code.
1127\\{ada-mode-map}"
1122 1128
1123 (interactive) 1129 (interactive)
1124 (kill-all-local-variables) 1130 (kill-all-local-variables)
@@ -1161,9 +1167,9 @@ the file name."
1161 (set (make-local-variable 'comment-padding) 0) 1167 (set (make-local-variable 'comment-padding) 0)
1162 (set (make-local-variable 'parse-sexp-lookup-properties) t)) 1168 (set (make-local-variable 'parse-sexp-lookup-properties) t))
1163 1169
1164 (set 'case-fold-search t) 1170 (setq case-fold-search t)
1165 (if (boundp 'imenu-case-fold-search) 1171 (if (boundp 'imenu-case-fold-search)
1166 (set 'imenu-case-fold-search t)) 1172 (setq imenu-case-fold-search t))
1167 1173
1168 (set (make-local-variable 'fill-paragraph-function) 1174 (set (make-local-variable 'fill-paragraph-function)
1169 'ada-fill-comment-paragraph) 1175 'ada-fill-comment-paragraph)
@@ -1186,8 +1192,13 @@ the file name."
1186 '(ada-font-lock-keywords 1192 '(ada-font-lock-keywords
1187 nil t 1193 nil t
1188 ((?\_ . "w") (?# . ".")) 1194 ((?\_ . "w") (?# . "."))
1189 beginning-of-line 1195 beginning-of-line))
1190 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) 1196
1197 (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
1198 (set (make-local-variable 'syntax-propertize-function)
1199 (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords))
1200 (set (make-local-variable 'font-lock-syntactic-keywords)
1201 ada-font-lock-syntactic-keywords))
1191 1202
1192 ;; Set up support for find-file.el. 1203 ;; Set up support for find-file.el.
1193 (set (make-local-variable 'ff-other-file-alist) 1204 (set (make-local-variable 'ff-other-file-alist)
@@ -1322,22 +1333,24 @@ the file name."
1322 1333
1323 ;; To be run after the hook, in case the user modified 1334 ;; To be run after the hook, in case the user modified
1324 ;; ada-fill-comment-prefix 1335 ;; ada-fill-comment-prefix
1325 (make-local-variable 'comment-start) 1336 ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs
1326 (if ada-fill-comment-prefix 1337 ;; then it was already available before running the hook, and if he
1327 (set 'comment-start ada-fill-comment-prefix) 1338 ;; modifies it in the hook, he might as well modify comment-start instead.
1328 (set 'comment-start "-- ")) 1339 (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- "))
1329 1340
1330 ;; Run this after the hook to give the users a chance to activate 1341 ;; Run this after the hook to give the users a chance to activate
1331 ;; font-lock-mode 1342 ;; font-lock-mode
1332 1343
1333 (unless (featurep 'xemacs) 1344 (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
1345 (featurep 'xemacs))
1334 (ada-initialize-syntax-table-properties) 1346 (ada-initialize-syntax-table-properties)
1335 (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) 1347 (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
1336 1348
1337 ;; the following has to be done after running the ada-mode-hook 1349 ;; the following has to be done after running the ada-mode-hook
1338 ;; because users might want to set the values of these variable 1350 ;; because users might want to set the values of these variable
1339 ;; inside the hook 1351 ;; inside the hook
1340 1352 ;; FIXME: it might even be set later on via file-local vars, no?
1353 ;; so maybe ada-keywords should be set lazily.
1341 (cond ((eq ada-language-version 'ada83) 1354 (cond ((eq ada-language-version 'ada83)
1342 (setq ada-keywords ada-83-keywords)) 1355 (setq ada-keywords ada-83-keywords))
1343 ((eq ada-language-version 'ada95) 1356 ((eq ada-language-version 'ada95)
@@ -1397,25 +1410,21 @@ If WORD is not given, then the current word in the buffer is used instead.
1397The new word is added to the first file in `ada-case-exception-file'. 1410The new word is added to the first file in `ada-case-exception-file'.
1398The standard casing rules will no longer apply to this word." 1411The standard casing rules will no longer apply to this word."
1399 (interactive) 1412 (interactive)
1400 (let ((previous-syntax-table (syntax-table)) 1413 (let ((file-name
1401 file-name 1414 (cond ((stringp ada-case-exception-file)
1402 ) 1415 ada-case-exception-file)
1403 1416 ((listp ada-case-exception-file)
1404 (cond ((stringp ada-case-exception-file) 1417 (car ada-case-exception-file))
1405 (setq file-name ada-case-exception-file)) 1418 (t
1406 ((listp ada-case-exception-file) 1419 (error (concat "No exception file specified. "
1407 (setq file-name (car ada-case-exception-file))) 1420 "See variable ada-case-exception-file"))))))
1408 (t
1409 (error (concat "No exception file specified. "
1410 "See variable ada-case-exception-file"))))
1411 1421
1412 (set-syntax-table ada-mode-symbol-syntax-table)
1413 (unless word 1422 (unless word
1414 (save-excursion 1423 (with-syntax-table ada-mode-symbol-syntax-table
1415 (skip-syntax-backward "w") 1424 (save-excursion
1416 (setq word (buffer-substring-no-properties 1425 (skip-syntax-backward "w")
1417 (point) (save-excursion (forward-word 1) (point)))))) 1426 (setq word (buffer-substring-no-properties
1418 (set-syntax-table previous-syntax-table) 1427 (point) (save-excursion (forward-word 1) (point)))))))
1419 1428
1420 ;; Reread the exceptions file, in case it was modified by some other, 1429 ;; Reread the exceptions file, in case it was modified by some other,
1421 (ada-case-read-exceptions-from-file file-name) 1430 (ada-case-read-exceptions-from-file file-name)
@@ -1425,11 +1434,9 @@ The standard casing rules will no longer apply to this word."
1425 (if (and (not (equal ada-case-exception '())) 1434 (if (and (not (equal ada-case-exception '()))
1426 (assoc-string word ada-case-exception t)) 1435 (assoc-string word ada-case-exception t))
1427 (setcar (assoc-string word ada-case-exception t) word) 1436 (setcar (assoc-string word ada-case-exception t) word)
1428 (add-to-list 'ada-case-exception (cons word t)) 1437 (add-to-list 'ada-case-exception (cons word t)))
1429 )
1430 1438
1431 (ada-save-exceptions-to-file file-name) 1439 (ada-save-exceptions-to-file file-name)))
1432 ))
1433 1440
1434(defun ada-create-case-exception-substring (&optional word) 1441(defun ada-create-case-exception-substring (&optional word)
1435 "Define the substring WORD as an exception for the casing system. 1442 "Define the substring WORD as an exception for the casing system.
@@ -1464,7 +1471,7 @@ word itself has a special casing."
1464 (modify-syntax-entry ?_ "." (syntax-table)) 1471 (modify-syntax-entry ?_ "." (syntax-table))
1465 (save-excursion 1472 (save-excursion
1466 (skip-syntax-backward "w") 1473 (skip-syntax-backward "w")
1467 (set 'word (buffer-substring-no-properties 1474 (setq word (buffer-substring-no-properties
1468 (point) 1475 (point)
1469 (save-excursion (forward-word 1) (point)))))) 1476 (save-excursion (forward-word 1) (point))))))
1470 (modify-syntax-entry ?_ (make-string 1 underscore-syntax) 1477 (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
@@ -1633,37 +1640,30 @@ ARG is the prefix the user entered with \\[universal-argument]."
1633 (interactive "P") 1640 (interactive "P")
1634 1641
1635 (if ada-auto-case 1642 (if ada-auto-case
1636 (let ((lastk last-command-event) 1643 (let ((lastk last-command-event))
1637 (previous-syntax-table (syntax-table))) 1644
1638 1645 (with-syntax-table ada-mode-symbol-syntax-table
1639 (unwind-protect 1646 (cond ((or (eq lastk ?\n)
1640 (progn 1647 (eq lastk ?\r))
1641 (set-syntax-table ada-mode-symbol-syntax-table) 1648 ;; horrible kludge
1642 (cond ((or (eq lastk ?\n) 1649 (insert " ")
1643 (eq lastk ?\r)) 1650 (ada-adjust-case)
1644 ;; horrible kludge 1651 ;; horrible dekludge
1645 (insert " ") 1652 (delete-char -1)
1646 (ada-adjust-case) 1653 ;; some special keys and their bindings
1647 ;; horrible dekludge 1654 (cond
1648 (delete-char -1) 1655 ((eq lastk ?\n)
1649 ;; some special keys and their bindings 1656 (funcall ada-lfd-binding))
1650 (cond 1657 ((eq lastk ?\r)
1651 ((eq lastk ?\n) 1658 (funcall ada-ret-binding))))
1652 (funcall ada-lfd-binding)) 1659 ((eq lastk ?\C-i) (ada-tab))
1653 ((eq lastk ?\r) 1660 ;; Else just insert the character
1654 (funcall ada-ret-binding)))) 1661 ((self-insert-command (prefix-numeric-value arg))))
1655 ((eq lastk ?\C-i) (ada-tab)) 1662 ;; if there is a keyword in front of the underscore
1656 ;; Else just insert the character 1663 ;; then it should be part of an identifier (MH)
1657 ((self-insert-command (prefix-numeric-value arg)))) 1664 (if (eq lastk ?_)
1658 ;; if there is a keyword in front of the underscore 1665 (ada-adjust-case t)
1659 ;; then it should be part of an identifier (MH) 1666 (ada-adjust-case))))
1660 (if (eq lastk ?_)
1661 (ada-adjust-case t)
1662 (ada-adjust-case))
1663 )
1664 ;; Restore the syntax table
1665 (set-syntax-table previous-syntax-table))
1666 )
1667 1667
1668 ;; Else, no auto-casing 1668 ;; Else, no auto-casing
1669 (cond 1669 (cond
@@ -1672,10 +1672,10 @@ ARG is the prefix the user entered with \\[universal-argument]."
1672 ((eq last-command-event ?\r) 1672 ((eq last-command-event ?\r)
1673 (funcall ada-ret-binding)) 1673 (funcall ada-ret-binding))
1674 (t 1674 (t
1675 (self-insert-command (prefix-numeric-value arg)))) 1675 (self-insert-command (prefix-numeric-value arg))))))
1676 ))
1677 1676
1678(defun ada-activate-keys-for-case () 1677(defun ada-activate-keys-for-case ()
1678 ;; FIXME: Use post-self-insert-hook instead of changing key bindings.
1679 "Modify the key bindings for all the keys that should readjust the casing." 1679 "Modify the key bindings for all the keys that should readjust the casing."
1680 (interactive) 1680 (interactive)
1681 ;; Save original key-bindings to allow swapping ret/lfd 1681 ;; Save original key-bindings to allow swapping ret/lfd
@@ -1735,44 +1735,41 @@ Attention: This function might take very long for big regions!"
1735 (let ((begin nil) 1735 (let ((begin nil)
1736 (end nil) 1736 (end nil)
1737 (keywordp nil) 1737 (keywordp nil)
1738 (attribp nil) 1738 (attribp nil))
1739 (previous-syntax-table (syntax-table)))
1740 (message "Adjusting case ...") 1739 (message "Adjusting case ...")
1741 (unwind-protect 1740 (with-syntax-table ada-mode-symbol-syntax-table
1742 (save-excursion 1741 (save-excursion
1743 (set-syntax-table ada-mode-symbol-syntax-table) 1742 (goto-char to)
1744 (goto-char to) 1743 ;;
1745 ;; 1744 ;; loop: look for all identifiers, keywords, and attributes
1746 ;; loop: look for all identifiers, keywords, and attributes 1745 ;;
1747 ;; 1746 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
1748 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) 1747 (setq end (match-end 1))
1749 (setq end (match-end 1)) 1748 (setq attribp
1750 (setq attribp 1749 (and (> (point) from)
1751 (and (> (point) from) 1750 (save-excursion
1752 (save-excursion 1751 (forward-char -1)
1753 (forward-char -1) 1752 (setq attribp (looking-at "'.[^']")))))
1754 (setq attribp (looking-at "'.[^']"))))) 1753 (or
1755 (or 1754 ;; do nothing if it is a string or comment
1756 ;; do nothing if it is a string or comment 1755 (ada-in-string-or-comment-p)
1757 (ada-in-string-or-comment-p) 1756 (progn
1758 (progn 1757 ;;
1759 ;; 1758 ;; get the identifier or keyword or attribute
1760 ;; get the identifier or keyword or attribute 1759 ;;
1761 ;; 1760 (setq begin (point))
1762 (setq begin (point)) 1761 (setq keywordp (looking-at ada-keywords))
1763 (setq keywordp (looking-at ada-keywords)) 1762 (goto-char end)
1764 (goto-char end) 1763 ;;
1765 ;; 1764 ;; casing according to user-option
1766 ;; casing according to user-option 1765 ;;
1767 ;; 1766 (if attribp
1768 (if attribp 1767 (funcall ada-case-attribute -1)
1769 (funcall ada-case-attribute -1) 1768 (if keywordp
1770 (if keywordp 1769 (funcall ada-case-keyword -1)
1771 (funcall ada-case-keyword -1) 1770 (ada-adjust-case-identifier)))
1772 (ada-adjust-case-identifier))) 1771 (goto-char begin))))
1773 (goto-char begin)))) 1772 (message "Adjusting case ... Done")))))
1774 (message "Adjusting case ... Done"))
1775 (set-syntax-table previous-syntax-table))))
1776 1773
1777(defun ada-adjust-case-buffer () 1774(defun ada-adjust-case-buffer ()
1778 "Adjust the case of all words in the whole buffer. 1775 "Adjust the case of all words in the whole buffer.
@@ -1803,46 +1800,39 @@ ATTENTION: This function might take very long for big buffers!"
1803 (let ((begin nil) 1800 (let ((begin nil)
1804 (end nil) 1801 (end nil)
1805 (delend nil) 1802 (delend nil)
1806 (paramlist nil) 1803 (paramlist nil))
1807 (previous-syntax-table (syntax-table))) 1804 (with-syntax-table ada-mode-symbol-syntax-table
1808 (unwind-protect
1809 (progn
1810 (set-syntax-table ada-mode-symbol-syntax-table)
1811 1805
1812 ;; check if really inside parameter list 1806 ;; check if really inside parameter list
1813 (or (ada-in-paramlist-p) 1807 (or (ada-in-paramlist-p)
1814 (error "Not in parameter list")) 1808 (error "Not in parameter list"))
1815 1809
1816 ;; find start of current parameter-list 1810 ;; find start of current parameter-list
1817 (ada-search-ignore-string-comment 1811 (ada-search-ignore-string-comment
1818 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) 1812 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1819 (down-list 1) 1813 (down-list 1)
1820 (backward-char 1) 1814 (backward-char 1)
1821 (setq begin (point)) 1815 (setq begin (point))
1822 1816
1823 ;; find end of parameter-list 1817 ;; find end of parameter-list
1824 (forward-sexp 1) 1818 (forward-sexp 1)
1825 (setq delend (point)) 1819 (setq delend (point))
1826 (delete-char -1) 1820 (delete-char -1)
1827 (insert "\n") 1821 (insert "\n")
1828
1829 ;; find end of last parameter-declaration
1830 (forward-comment -1000)
1831 (setq end (point))
1832 1822
1833 ;; build a list of all elements of the parameter-list 1823 ;; find end of last parameter-declaration
1834 (setq paramlist (ada-scan-paramlist (1+ begin) end)) 1824 (forward-comment -1000)
1825 (setq end (point))
1835 1826
1836 ;; delete the original parameter-list 1827 ;; build a list of all elements of the parameter-list
1837 (delete-region begin delend) 1828 (setq paramlist (ada-scan-paramlist (1+ begin) end))
1838 1829
1839 ;; insert the new parameter-list 1830 ;; delete the original parameter-list
1840 (goto-char begin) 1831 (delete-region begin delend)
1841 (ada-insert-paramlist paramlist))
1842 1832
1843 ;; restore syntax-table 1833 ;; insert the new parameter-list
1844 (set-syntax-table previous-syntax-table) 1834 (goto-char begin)
1845 ))) 1835 (ada-insert-paramlist paramlist))))
1846 1836
1847(defun ada-scan-paramlist (begin end) 1837(defun ada-scan-paramlist (begin end)
1848 "Scan the parameter list found in between BEGIN and END. 1838 "Scan the parameter list found in between BEGIN and END.
@@ -2186,14 +2176,12 @@ Return the new position of point or nil if not found."
2186Return the calculation that was done, including the reference point 2176Return the calculation that was done, including the reference point
2187and the offset." 2177and the offset."
2188 (interactive) 2178 (interactive)
2189 (let ((previous-syntax-table (syntax-table)) 2179 (let ((orgpoint (point-marker))
2190 (orgpoint (point-marker))
2191 cur-indent tmp-indent 2180 cur-indent tmp-indent
2192 prev-indent) 2181 prev-indent)
2193 2182
2194 (unwind-protect 2183 (unwind-protect
2195 (progn 2184 (with-syntax-table ada-mode-symbol-syntax-table
2196 (set-syntax-table ada-mode-symbol-syntax-table)
2197 2185
2198 ;; This need to be done here so that the advice is not always 2186 ;; This need to be done here so that the advice is not always
2199 ;; activated (this might interact badly with other modes) 2187 ;; activated (this might interact badly with other modes)
@@ -2203,14 +2191,14 @@ and the offset."
2203 (save-excursion 2191 (save-excursion
2204 (setq cur-indent 2192 (setq cur-indent
2205 2193
2206 ;; Not First line in the buffer ? 2194 ;; Not First line in the buffer ?
2207 (if (save-excursion (zerop (forward-line -1))) 2195 (if (save-excursion (zerop (forward-line -1)))
2208 (progn 2196 (progn
2209 (back-to-indentation) 2197 (back-to-indentation)
2210 (ada-get-current-indent)) 2198 (ada-get-current-indent))
2211 2199
2212 ;; first line in the buffer 2200 ;; first line in the buffer
2213 (list (point-min) 0)))) 2201 (list (point-min) 0))))
2214 2202
2215 ;; Evaluate the list to get the column to indent to 2203 ;; Evaluate the list to get the column to indent to
2216 ;; prev-indent contains the column to indent to 2204 ;; prev-indent contains the column to indent to
@@ -2242,14 +2230,10 @@ and the offset."
2242 (if (< (current-column) (current-indentation)) 2230 (if (< (current-column) (current-indentation))
2243 (back-to-indentation))) 2231 (back-to-indentation)))
2244 2232
2245 ;; restore syntax-table
2246 (set-syntax-table previous-syntax-table)
2247 (if (featurep 'xemacs) 2233 (if (featurep 'xemacs)
2248 (ad-deactivate 'parse-partial-sexp)) 2234 (ad-deactivate 'parse-partial-sexp)))
2249 )
2250 2235
2251 cur-indent 2236 cur-indent))
2252 ))
2253 2237
2254(defun ada-get-current-indent () 2238(defun ada-get-current-indent ()
2255 "Return the indentation to use for the current line." 2239 "Return the indentation to use for the current line."
@@ -2512,11 +2496,11 @@ and the offset."
2512 (if (looking-at "renames") 2496 (if (looking-at "renames")
2513 (let (pos) 2497 (let (pos)
2514 (save-excursion 2498 (save-excursion
2515 (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t))) 2499 (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
2516 (if (and pos 2500 (if (and pos
2517 (= (downcase (char-after (car pos))) ?r)) 2501 (= (downcase (char-after (car pos))) ?r))
2518 (goto-char (car pos))) 2502 (goto-char (car pos)))
2519 (set 'var 'ada-indent-renames))) 2503 (setq var 'ada-indent-renames)))
2520 2504
2521 (forward-comment -1000) 2505 (forward-comment -1000)
2522 (if (= (char-before) ?\)) 2506 (if (= (char-before) ?\))
@@ -2533,7 +2517,7 @@ and the offset."
2533 (looking-at "\\(function\\|procedure\\)\\>")) 2517 (looking-at "\\(function\\|procedure\\)\\>"))
2534 (progn 2518 (progn
2535 (backward-word 1) 2519 (backward-word 1)
2536 (set 'num-back 2) 2520 (setq num-back 2)
2537 (looking-at "\\(function\\|procedure\\)\\>"))))) 2521 (looking-at "\\(function\\|procedure\\)\\>")))))
2538 2522
2539 ;; The indentation depends of the value of ada-indent-return 2523 ;; The indentation depends of the value of ada-indent-return
@@ -4046,8 +4030,7 @@ Point is moved at the beginning of the SEARCH-RE."
4046 (let (found 4030 (let (found
4047 begin 4031 begin
4048 end 4032 end
4049 parse-result 4033 parse-result)
4050 (previous-syntax-table (syntax-table)))
4051 4034
4052 ;; FIXME: need to pass BACKWARD to search-func! 4035 ;; FIXME: need to pass BACKWARD to search-func!
4053 (unless search-func 4036 (unless search-func
@@ -4057,67 +4040,65 @@ Point is moved at the beginning of the SEARCH-RE."
4057 ;; search until found or end-of-buffer 4040 ;; search until found or end-of-buffer
4058 ;; We have to test that we do not look further than limit 4041 ;; We have to test that we do not look further than limit
4059 ;; 4042 ;;
4060 (set-syntax-table ada-mode-symbol-syntax-table) 4043 (with-syntax-table ada-mode-symbol-syntax-table
4061 (while (and (not found) 4044 (while (and (not found)
4062 (or (not limit) 4045 (or (not limit)
4063 (or (and backward (<= limit (point))) 4046 (or (and backward (<= limit (point)))
4064 (>= limit (point)))) 4047 (>= limit (point))))
4065 (funcall search-func search-re limit 1)) 4048 (funcall search-func search-re limit 1))
4066 (setq begin (match-beginning 0)) 4049 (setq begin (match-beginning 0))
4067 (setq end (match-end 0)) 4050 (setq end (match-end 0))
4068 4051
4069 (setq parse-result (parse-partial-sexp 4052 (setq parse-result (parse-partial-sexp
4070 (save-excursion (beginning-of-line) (point)) 4053 (save-excursion (beginning-of-line) (point))
4071 (point))) 4054 (point)))
4072 4055
4073 (cond 4056 (cond
4074 ;; 4057 ;;
4075 ;; If inside a string, skip it (and the following comments) 4058 ;; If inside a string, skip it (and the following comments)
4076 ;; 4059 ;;
4077 ((ada-in-string-p parse-result) 4060 ((ada-in-string-p parse-result)
4078 (if (featurep 'xemacs) 4061 (if (featurep 'xemacs)
4079 (search-backward "\"" nil t) 4062 (search-backward "\"" nil t)
4080 (goto-char (nth 8 parse-result))) 4063 (goto-char (nth 8 parse-result)))
4081 (unless backward (forward-sexp 1))) 4064 (unless backward (forward-sexp 1)))
4082 ;; 4065 ;;
4083 ;; If inside a comment, skip it (and the following comments) 4066 ;; If inside a comment, skip it (and the following comments)
4084 ;; There is a special code for comments at the end of the file 4067 ;; There is a special code for comments at the end of the file
4085 ;; 4068 ;;
4086 ((ada-in-comment-p parse-result) 4069 ((ada-in-comment-p parse-result)
4087 (if (featurep 'xemacs) 4070 (if (featurep 'xemacs)
4088 (progn 4071 (progn
4089 (forward-line 1) 4072 (forward-line 1)
4090 (beginning-of-line) 4073 (beginning-of-line)
4091 (forward-comment -1)) 4074 (forward-comment -1))
4092 (goto-char (nth 8 parse-result))) 4075 (goto-char (nth 8 parse-result)))
4093 (unless backward 4076 (unless backward
4094 ;; at the end of the file, it is not possible to skip a comment 4077 ;; at the end of the file, it is not possible to skip a comment
4095 ;; so we just go at the end of the line 4078 ;; so we just go at the end of the line
4096 (if (forward-comment 1) 4079 (if (forward-comment 1)
4097 (progn 4080 (progn
4098 (forward-comment 1000) 4081 (forward-comment 1000)
4099 (beginning-of-line)) 4082 (beginning-of-line))
4100 (end-of-line)))) 4083 (end-of-line))))
4101 ;; 4084 ;;
4102 ;; directly in front of a comment => skip it, if searching forward 4085 ;; directly in front of a comment => skip it, if searching forward
4103 ;; 4086 ;;
4104 ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) 4087 ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
4105 (unless backward (progn (forward-char -1) (forward-comment 1000)))) 4088 (unless backward (progn (forward-char -1) (forward-comment 1000))))
4106 4089
4107 ;; 4090 ;;
4108 ;; found a parameter-list but should ignore it => skip it 4091 ;; found a parameter-list but should ignore it => skip it
4109 ;; 4092 ;;
4110 ((and (not paramlists) (ada-in-paramlist-p)) 4093 ((and (not paramlists) (ada-in-paramlist-p))
4111 (if backward 4094 (if backward
4112 (search-backward "(" nil t) 4095 (search-backward "(" nil t)
4113 (search-forward ")" nil t))) 4096 (search-forward ")" nil t)))
4114 ;; 4097 ;;
4115 ;; found what we were looking for 4098 ;; found what we were looking for
4116 ;; 4099 ;;
4117 (t 4100 (t
4118 (setq found t)))) ; end of loop 4101 (setq found t))))) ; end of loop
4119
4120 (set-syntax-table previous-syntax-table)
4121 4102
4122 (if found 4103 (if found
4123 (cons begin end) 4104 (cons begin end)
@@ -4398,122 +4379,109 @@ of the region. Otherwise, operate only on the current line."
4398(defun ada-move-to-start () 4379(defun ada-move-to-start ()
4399 "Move point to the matching start of the current Ada structure." 4380 "Move point to the matching start of the current Ada structure."
4400 (interactive) 4381 (interactive)
4401 (let ((pos (point)) 4382 (let ((pos (point)))
4402 (previous-syntax-table (syntax-table))) 4383 (with-syntax-table ada-mode-symbol-syntax-table
4403 (unwind-protect
4404 (progn
4405 (set-syntax-table ada-mode-symbol-syntax-table)
4406 4384
4407 (save-excursion 4385 (save-excursion
4408 ;; 4386 ;;
4409 ;; do nothing if in string or comment or not on 'end ...;' 4387 ;; do nothing if in string or comment or not on 'end ...;'
4410 ;; or if an error occurs during processing 4388 ;; or if an error occurs during processing
4411 ;; 4389 ;;
4412 (or 4390 (or
4413 (ada-in-string-or-comment-p) 4391 (ada-in-string-or-comment-p)
4414 (and (progn 4392 (and (progn
4415 (or (looking-at "[ \t]*\\<end\\>") 4393 (or (looking-at "[ \t]*\\<end\\>")
4416 (backward-word 1)) 4394 (backward-word 1))
4417 (or (looking-at "[ \t]*\\<end\\>") 4395 (or (looking-at "[ \t]*\\<end\\>")
4418 (backward-word 1)) 4396 (backward-word 1))
4419 (or (looking-at "[ \t]*\\<end\\>") 4397 (or (looking-at "[ \t]*\\<end\\>")
4420 (error "Not on end ...;"))) 4398 (error "Not on end ...;")))
4421 (ada-goto-matching-start 1) 4399 (ada-goto-matching-start 1)
4422 (setq pos (point)) 4400 (setq pos (point))
4423 4401
4424 ;; 4402 ;;
4425 ;; on 'begin' => go on, according to user option 4403 ;; on 'begin' => go on, according to user option
4426 ;; 4404 ;;
4427 ada-move-to-declaration 4405 ada-move-to-declaration
4428 (looking-at "\\<begin\\>") 4406 (looking-at "\\<begin\\>")
4429 (ada-goto-decl-start) 4407 (ada-goto-decl-start)
4430 (setq pos (point)))) 4408 (setq pos (point))))
4431 4409
4432 ) ; end of save-excursion 4410 ) ; end of save-excursion
4433 4411
4434 ;; now really move to the found position 4412 ;; now really move to the found position
4435 (goto-char pos)) 4413 (goto-char pos))))
4436
4437 ;; restore syntax-table
4438 (set-syntax-table previous-syntax-table))))
4439 4414
4440(defun ada-move-to-end () 4415(defun ada-move-to-end ()
4441 "Move point to the end of the block around point. 4416 "Move point to the end of the block around point.
4442Moves to 'begin' if in a declarative part." 4417Moves to 'begin' if in a declarative part."
4443 (interactive) 4418 (interactive)
4444 (let ((pos (point)) 4419 (let ((pos (point))
4445 decl-start 4420 decl-start)
4446 (previous-syntax-table (syntax-table))) 4421 (with-syntax-table ada-mode-symbol-syntax-table
4447 (unwind-protect
4448 (progn
4449 (set-syntax-table ada-mode-symbol-syntax-table)
4450
4451 (save-excursion
4452
4453 (cond
4454 ;; Go to the beginning of the current word, and check if we are
4455 ;; directly on 'begin'
4456 ((save-excursion
4457 (skip-syntax-backward "w")
4458 (looking-at "\\<begin\\>"))
4459 (ada-goto-matching-end 1)
4460 )
4461
4462 ;; on first line of subprogram body
4463 ;; Do nothing for specs or generic instantion, since these are
4464 ;; handled as the general case (find the enclosing block)
4465 ;; We also need to make sure that we ignore nested subprograms
4466 ((save-excursion
4467 (and (skip-syntax-backward "w")
4468 (looking-at "\\<function\\>\\|\\<procedure\\>" )
4469 (ada-search-ignore-string-comment "is\\|;")
4470 (not (= (char-before) ?\;))
4471 ))
4472 (skip-syntax-backward "w")
4473 (ada-goto-matching-end 0 t))
4474
4475 ;; on first line of task declaration
4476 ((save-excursion
4477 (and (ada-goto-stmt-start)
4478 (looking-at "\\<task\\>" )
4479 (forward-word 1)
4480 (ada-goto-next-non-ws)
4481 (looking-at "\\<body\\>")))
4482 (ada-search-ignore-string-comment "begin" nil nil nil
4483 'word-search-forward))
4484 ;; accept block start
4485 ((save-excursion
4486 (and (ada-goto-stmt-start)
4487 (looking-at "\\<accept\\>" )))
4488 (ada-goto-matching-end 0))
4489 ;; package start
4490 ((save-excursion
4491 (setq decl-start (and (ada-goto-decl-start t) (point)))
4492 (and decl-start (looking-at "\\<package\\>")))
4493 (ada-goto-matching-end 1))
4494
4495 ;; On a "declare" keyword
4496 ((save-excursion
4497 (skip-syntax-backward "w")
4498 (looking-at "\\<declare\\>"))
4499 (ada-goto-matching-end 0 t))
4500
4501 ;; inside a 'begin' ... 'end' block
4502 (decl-start
4503 (goto-char decl-start)
4504 (ada-goto-matching-end 0 t))
4505
4506 ;; (hopefully ;-) everything else
4507 (t
4508 (ada-goto-matching-end 1)))
4509 (setq pos (point))
4510 )
4511 4422
4512 ;; now really move to the position found 4423 (save-excursion
4513 (goto-char pos))
4514 4424
4515 ;; restore syntax-table 4425 (cond
4516 (set-syntax-table previous-syntax-table)))) 4426 ;; Go to the beginning of the current word, and check if we are
4427 ;; directly on 'begin'
4428 ((save-excursion
4429 (skip-syntax-backward "w")
4430 (looking-at "\\<begin\\>"))
4431 (ada-goto-matching-end 1))
4432
4433 ;; on first line of subprogram body
4434 ;; Do nothing for specs or generic instantion, since these are
4435 ;; handled as the general case (find the enclosing block)
4436 ;; We also need to make sure that we ignore nested subprograms
4437 ((save-excursion
4438 (and (skip-syntax-backward "w")
4439 (looking-at "\\<function\\>\\|\\<procedure\\>" )
4440 (ada-search-ignore-string-comment "is\\|;")
4441 (not (= (char-before) ?\;))
4442 ))
4443 (skip-syntax-backward "w")
4444 (ada-goto-matching-end 0 t))
4445
4446 ;; on first line of task declaration
4447 ((save-excursion
4448 (and (ada-goto-stmt-start)
4449 (looking-at "\\<task\\>" )
4450 (forward-word 1)
4451 (ada-goto-next-non-ws)
4452 (looking-at "\\<body\\>")))
4453 (ada-search-ignore-string-comment "begin" nil nil nil
4454 'word-search-forward))
4455 ;; accept block start
4456 ((save-excursion
4457 (and (ada-goto-stmt-start)
4458 (looking-at "\\<accept\\>" )))
4459 (ada-goto-matching-end 0))
4460 ;; package start
4461 ((save-excursion
4462 (setq decl-start (and (ada-goto-decl-start t) (point)))
4463 (and decl-start (looking-at "\\<package\\>")))
4464 (ada-goto-matching-end 1))
4465
4466 ;; On a "declare" keyword
4467 ((save-excursion
4468 (skip-syntax-backward "w")
4469 (looking-at "\\<declare\\>"))
4470 (ada-goto-matching-end 0 t))
4471
4472 ;; inside a 'begin' ... 'end' block
4473 (decl-start
4474 (goto-char decl-start)
4475 (ada-goto-matching-end 0 t))
4476
4477 ;; (hopefully ;-) everything else
4478 (t
4479 (ada-goto-matching-end 1)))
4480 (setq pos (point))
4481 )
4482
4483 ;; now really move to the position found
4484 (goto-char pos))))
4517 4485
4518(defun ada-next-procedure () 4486(defun ada-next-procedure ()
4519 "Move point to next procedure." 4487 "Move point to next procedure."
@@ -4818,7 +4786,7 @@ Moves to 'begin' if in a declarative part."
4818 (if (featurep 'xemacs) 4786 (if (featurep 'xemacs)
4819 (progn 4787 (progn
4820 (define-key ada-mode-map [menu-bar] ada-mode-menu) 4788 (define-key ada-mode-map [menu-bar] ada-mode-menu)
4821 (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) 4789 (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
4822 4790
4823 4791
4824;; ------------------------------------------------------- 4792;; -------------------------------------------------------
@@ -5040,7 +5008,7 @@ or the spec otherwise."
5040 (ada-find-src-file-in-dir 5008 (ada-find-src-file-in-dir
5041 (file-name-nondirectory (concat name (car suffixes)))))) 5009 (file-name-nondirectory (concat name (car suffixes))))))
5042 (if other 5010 (if other
5043 (set 'is-spec other))) 5011 (setq is-spec other)))
5044 5012
5045 ;; Else search in the current directory 5013 ;; Else search in the current directory
5046 (if (file-exists-p (concat name (car suffixes))) 5014 (if (file-exists-p (concat name (car suffixes)))
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 9b24ac7a1f4..742bcf726eb 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -951,7 +951,7 @@ group. The string matched by the first group is highlighted with
951 (3 antlr-keyword-face) 951 (3 antlr-keyword-face)
952 (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) 952 (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
953 antlr-keyword-face 953 antlr-keyword-face
954 type-face))) 954 font-lock-type-face)))
955 (,(lambda (limit) 955 (,(lambda (limit)
956 (antlr-re-search-forward 956 (antlr-re-search-forward
957 "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" 957 "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index a56623f22da..004bb3de78d 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -43,9 +43,6 @@
43(defvar autoconf-mode-hook nil 43(defvar autoconf-mode-hook nil
44 "Hook run by `autoconf-mode'.") 44 "Hook run by `autoconf-mode'.")
45 45
46(defconst autoconf-font-lock-syntactic-keywords
47 '(("\\<dnl\\>" 0 '(11))))
48
49(defconst autoconf-definition-regexp 46(defconst autoconf-definition-regexp
50 "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*") 47 "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
51 48
@@ -94,8 +91,8 @@ searching backwards at another AC_... command."
94 "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") 91 "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
95 (set (make-local-variable 'comment-start) "dnl ") 92 (set (make-local-variable 'comment-start) "dnl ")
96 (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +") 93 (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +")
97 (set (make-local-variable 'font-lock-syntactic-keywords) 94 (set (make-local-variable 'syntax-propertize-function)
98 autoconf-font-lock-syntactic-keywords) 95 (syntax-propertize-rules ("\\<dnl\\>" (0 "<"))))
99 (set (make-local-variable 'font-lock-defaults) 96 (set (make-local-variable 'font-lock-defaults)
100 `(autoconf-font-lock-keywords nil nil (("_" . "w")))) 97 `(autoconf-font-lock-keywords nil nil (("_" . "w"))))
101 (set (make-local-variable 'imenu-generic-expression) 98 (set (make-local-variable 'imenu-generic-expression)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e389007065a..2a24bf1ce90 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -5449,49 +5449,47 @@ comment at the start of cc-engine.el for more info."
5449 (forward-char) 5449 (forward-char)
5450 5450
5451 (unless (looking-at c-<-op-cont-regexp) 5451 (unless (looking-at c-<-op-cont-regexp)
5452 (while (and 5452 (while (and
5453 (progn 5453 (progn
5454 (c-forward-syntactic-ws) 5454 (c-forward-syntactic-ws)
5455 (let ((orig-record-found-types c-record-found-types)) 5455 (let ((orig-record-found-types c-record-found-types))
5456 (when (or (and c-record-type-identifiers all-types) 5456 (when (or (and c-record-type-identifiers all-types)
5457 (c-major-mode-is 'java-mode)) 5457 (c-major-mode-is 'java-mode))
5458 ;; All encountered identifiers are types, so set the 5458 ;; All encountered identifiers are types, so set the
5459 ;; promote flag and parse the type. 5459 ;; promote flag and parse the type.
5460 (progn 5460 (progn
5461 (c-forward-syntactic-ws) 5461 (c-forward-syntactic-ws)
5462 (if (looking-at "\\?") 5462 (if (looking-at "\\?")
5463 (forward-char) 5463 (forward-char)
5464 (when (looking-at c-identifier-start) 5464 (when (looking-at c-identifier-start)
5465 (let ((c-promote-possible-types t) 5465 (let ((c-promote-possible-types t)
5466 (c-record-found-types t)) 5466 (c-record-found-types t))
5467 (c-forward-type)))) 5467 (c-forward-type))))
5468 5468
5469 (c-forward-syntactic-ws) 5469 (c-forward-syntactic-ws)
5470 5470
5471 (when (or (looking-at "extends") 5471 (when (or (looking-at "extends")
5472 (looking-at "super")) 5472 (looking-at "super"))
5473 (forward-word) 5473 (forward-word)
5474 (c-forward-syntactic-ws) 5474 (c-forward-syntactic-ws)
5475 (let ((c-promote-possible-types t) 5475 (let ((c-promote-possible-types t)
5476 (c-record-found-types t)) 5476 (c-record-found-types t))
5477 (c-forward-type) 5477 (c-forward-type)
5478 (c-forward-syntactic-ws)))))) 5478 (c-forward-syntactic-ws))))))
5479
5480 (setq pos (point))
5481
5482 (or
5483 ;; Note: These regexps exploit the match order in \| so
5484 ;; that "<>" is matched by "<" rather than "[^>:-]>".
5485 (c-syntactic-re-search-forward
5486 ;; Stop on ',', '|', '&', '+' and '-' to catch
5487 ;; common binary operators that could be between
5488 ;; two comparison expressions "a<b" and "c>d".
5489 "[<;{},|+&-]\\|[>)]"
5490 nil t t)
5491 t))
5492 5479
5493 (cond 5480 (setq pos (point))
5494 ((eq (char-before) ?>) 5481
5482 ;; Note: These regexps exploit the match order in \| so
5483 ;; that "<>" is matched by "<" rather than "[^>:-]>".
5484 (c-syntactic-re-search-forward
5485 ;; Stop on ',', '|', '&', '+' and '-' to catch
5486 ;; common binary operators that could be between
5487 ;; two comparison expressions "a<b" and "c>d".
5488 "[<;{},|+&-]\\|[>)]"
5489 nil t t))
5490
5491 (cond
5492 ((eq (char-before) ?>)
5495 ;; Either an operator starting with '>' or the end of 5493 ;; Either an operator starting with '>' or the end of
5496 ;; the angle bracket arglist. 5494 ;; the angle bracket arglist.
5497 5495
@@ -5532,14 +5530,14 @@ comment at the start of cc-engine.el for more info."
5532 (when (or (setq keyword-match 5530 (when (or (setq keyword-match
5533 (looking-at c-opt-<>-sexp-key)) 5531 (looking-at c-opt-<>-sexp-key))
5534 (not (looking-at c-keywords-regexp))) 5532 (not (looking-at c-keywords-regexp)))
5535 (setq id-start (point)))) 5533 (setq id-start (point))))
5536 5534
5537 (setq subres 5535 (setq subres
5538 (let ((c-promote-possible-types t) 5536 (let ((c-promote-possible-types t)
5539 (c-record-found-types t)) 5537 (c-record-found-types t))
5540 (c-forward-<>-arglist-recur 5538 (c-forward-<>-arglist-recur
5541 (and keyword-match 5539 (and keyword-match
5542 (c-keyword-member 5540 (c-keyword-member
5543 (c-keyword-sym (match-string 1)) 5541 (c-keyword-sym (match-string 1))
5544 'c-<>-type-kwds))))) 5542 'c-<>-type-kwds)))))
5545 ))) 5543 )))
@@ -5560,16 +5558,16 @@ comment at the start of cc-engine.el for more info."
5560 (c-forward-syntactic-ws) 5558 (c-forward-syntactic-ws)
5561 (looking-at c-opt-identifier-concat-key))) 5559 (looking-at c-opt-identifier-concat-key)))
5562 (c-record-ref-id (cons id-start id-end)) 5560 (c-record-ref-id (cons id-start id-end))
5563 (c-record-type-id (cons id-start id-end)))))) 5561 (c-record-type-id (cons id-start id-end))))))
5564 t) 5562 t)
5565 5563
5566 ((and (not c-restricted-<>-arglists) 5564 ((and (not c-restricted-<>-arglists)
5567 (or (and (eq (char-before) ?&) 5565 (or (and (eq (char-before) ?&)
5568 (not (eq (char-after) ?&))) 5566 (not (eq (char-after) ?&)))
5569 (eq (char-before) ?,))) 5567 (eq (char-before) ?,)))
5570 ;; Just another argument. Record the position. The 5568 ;; Just another argument. Record the position. The
5571 ;; type check stuff that made us stop at it is at 5569 ;; type check stuff that made us stop at it is at
5572 ;; the top of the loop. 5570 ;; the top of the loop.
5573 (setq arg-start-pos (cons (point) arg-start-pos))) 5571 (setq arg-start-pos (cons (point) arg-start-pos)))
5574 5572
5575 (t 5573 (t
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 86a6be40cc5..e074e92fbe5 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -83,12 +83,6 @@ This includes those for cfservd as well as cfagent."))
83 ;; File, acl &c in group: { token ... } 83 ;; File, acl &c in group: { token ... }
84 ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) 84 ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
85 85
86(defconst cfengine-font-lock-syntactic-keywords
87 ;; In the main syntax-table, backslash is marked as a punctuation, because
88 ;; of its use in DOS-style directory separators. Here we try to recognize
89 ;; the cases where backslash is used as an escape inside strings.
90 '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\")))
91
92(defvar cfengine-imenu-expression 86(defvar cfengine-imenu-expression
93 `((nil ,(concat "^[ \t]*" (eval-when-compile 87 `((nil ,(concat "^[ \t]*" (eval-when-compile
94 (regexp-opt cfengine-actions t)) 88 (regexp-opt cfengine-actions t))
@@ -237,13 +231,15 @@ to the action header."
237 (set (make-local-variable 'fill-paragraph-function) 231 (set (make-local-variable 'fill-paragraph-function)
238 #'cfengine-fill-paragraph) 232 #'cfengine-fill-paragraph)
239 (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs) 233 (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs)
240 ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of
241 ;; functions in evaluated classes to string syntax, and then obey
242 ;; syntax properties.
243 (setq font-lock-defaults 234 (setq font-lock-defaults
244 '(cfengine-font-lock-keywords nil nil nil beginning-of-line 235 '(cfengine-font-lock-keywords nil nil nil beginning-of-line))
245 (font-lock-syntactic-keywords 236 ;; Fixme: set the args of functions in evaluated classes to string
246 . cfengine-font-lock-syntactic-keywords))) 237 ;; syntax, and then obey syntax properties.
238 (set (make-local-variable 'syntax-propertize-function)
239 ;; In the main syntax-table, \ is marked as a punctuation, because
240 ;; of its use in DOS-style directory separators. Here we try to
241 ;; recognize the cases where \ is used as an escape inside strings.
242 (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
247 (setq imenu-generic-expression cfengine-imenu-expression) 243 (setq imenu-generic-expression cfengine-imenu-expression)
248 (set (make-local-variable 'beginning-of-defun-function) 244 (set (make-local-variable 'beginning-of-defun-function)
249 #'cfengine-beginning-of-defun) 245 #'cfengine-beginning-of-defun)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 598733cb5d7..7f0732ecffc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -164,7 +164,7 @@ and a string describing how the process finished.")
164 164
165(defvar compilation-num-errors-found) 165(defvar compilation-num-errors-found)
166 166
167(defconst compilation-error-regexp-alist-alist 167(defvar compilation-error-regexp-alist-alist
168 '((absoft 168 '((absoft
169 "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ 169 "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
170of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) 170of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -263,9 +263,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
263 ;; The core of the regexp is the one with *?. It says that a file name 263 ;; The core of the regexp is the one with *?. It says that a file name
264 ;; can be composed of any non-newline char, but it also rules out some 264 ;; can be composed of any non-newline char, but it also rules out some
265 ;; valid but unlikely cases, such as a trailing space or a space 265 ;; valid but unlikely cases, such as a trailing space or a space
266 ;; followed by a -. 266 ;; followed by a -, or a colon followed by a space.
267
268 ;; The "in \\|from " exception was added to handle messages from Ruby.
267 "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ 269 "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
268\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\ 270\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
269\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ 271\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
270\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\ 272\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
271\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ 273\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@@ -766,12 +768,27 @@ The value can be either 2 -- skip anything less than error, 1 --
766skip anything less than warning or 0 -- don't skip any messages. 768skip anything less than warning or 0 -- don't skip any messages.
767Note that all messages not positively identified as warning or 769Note that all messages not positively identified as warning or
768info, are considered errors." 770info, are considered errors."
769 :type '(choice (const :tag "Warnings and info" 2) 771 :type '(choice (const :tag "Skip warnings and info" 2)
770 (const :tag "Info" 1) 772 (const :tag "Skip info" 1)
771 (const :tag "None" 0)) 773 (const :tag "No skip" 0))
772 :group 'compilation 774 :group 'compilation
773 :version "22.1") 775 :version "22.1")
774 776
777(defun compilation-set-skip-threshold (level)
778 "Switch the `compilation-skip-threshold' level."
779 (interactive
780 (list
781 (mod (if current-prefix-arg
782 (prefix-numeric-value current-prefix-arg)
783 (1+ compilation-skip-threshold))
784 3)))
785 (setq compilation-skip-threshold level)
786 (message "Skipping %s"
787 (case compilation-skip-threshold
788 (0 "Nothing")
789 (1 "Info messages")
790 (2 "Warnings and info"))))
791
775(defcustom compilation-skip-visited nil 792(defcustom compilation-skip-visited nil
776 "Compilation motion commands skip visited messages if this is t. 793 "Compilation motion commands skip visited messages if this is t.
777Visited messages are ones for which the file, line and column have been jumped 794Visited messages are ones for which the file, line and column have been jumped
@@ -1212,7 +1229,7 @@ Returns the compilation buffer created."
1212 (let* ((name-of-mode 1229 (let* ((name-of-mode
1213 (if (eq mode t) 1230 (if (eq mode t)
1214 "compilation" 1231 "compilation"
1215 (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) 1232 (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
1216 (thisdir default-directory) 1233 (thisdir default-directory)
1217 outwin outbuf) 1234 outwin outbuf)
1218 (with-current-buffer 1235 (with-current-buffer
@@ -2377,7 +2394,7 @@ The file-structure looks like this:
2377(defun compilation-forget-errors () 2394(defun compilation-forget-errors ()
2378 ;; In case we hit the same file/line specs, we want to recompute a new 2395 ;; In case we hit the same file/line specs, we want to recompute a new
2379 ;; marker for them, so flush our cache. 2396 ;; marker for them, so flush our cache.
2380 (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) 2397 (clrhash compilation-locs)
2381 (setq compilation-gcpro nil) 2398 (setq compilation-gcpro nil)
2382 ;; FIXME: the old code reset the directory-stack, so maybe we should 2399 ;; FIXME: the old code reset the directory-stack, so maybe we should
2383 ;; put a `directory change' marker of some sort, but where? -stef 2400 ;; put a `directory change' marker of some sort, but where? -stef
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d69cce76faa..d89e41b38fb 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1840,7 +1840,13 @@ or as help on variables `cperl-tips', `cperl-problems',
1840 (make-local-variable 'cperl-syntax-state) 1840 (make-local-variable 'cperl-syntax-state)
1841 (setq cperl-syntax-state nil) ; reset syntaxification cache 1841 (setq cperl-syntax-state nil) ; reset syntaxification cache
1842 (if cperl-use-syntax-table-text-property 1842 (if cperl-use-syntax-table-text-property
1843 (progn 1843 (if (boundp 'syntax-propertize-function)
1844 (progn
1845 ;; Reset syntaxification cache.
1846 (set (make-local-variable 'cperl-syntax-done-to) nil)
1847 (set (make-local-variable 'syntax-propertize-function)
1848 (lambda (start end)
1849 (goto-char start) (cperl-fontify-syntaxically end))))
1844 (make-local-variable 'parse-sexp-lookup-properties) 1850 (make-local-variable 'parse-sexp-lookup-properties)
1845 ;; Do not introduce variable if not needed, we check it! 1851 ;; Do not introduce variable if not needed, we check it!
1846 (set 'parse-sexp-lookup-properties t) 1852 (set 'parse-sexp-lookup-properties t)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index c37744bfe45..daa0fd07364 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -483,6 +483,7 @@ The only difference is, it returns t in a case when the default returns nil."
483 "Maximum highlighting for Fortran mode. 483 "Maximum highlighting for Fortran mode.
484Consists of level 3 plus all other intrinsics not already highlighted.") 484Consists of level 3 plus all other intrinsics not already highlighted.")
485 485
486(defvar fortran--font-lock-syntactic-keywords)
486;; Comments are real pain in Fortran because there is no way to 487;; Comments are real pain in Fortran because there is no way to
487;; represent the standard comment syntax in an Emacs syntax table. 488;; represent the standard comment syntax in an Emacs syntax table.
488;; (We can do so for F90-style). Therefore an unmatched quote in a 489;; (We can do so for F90-style). Therefore an unmatched quote in a
@@ -887,9 +888,11 @@ with no args, if that value is non-nil."
887 fortran-font-lock-keywords-3 888 fortran-font-lock-keywords-3
888 fortran-font-lock-keywords-4) 889 fortran-font-lock-keywords-4)
889 nil t ((?/ . "$/") ("_$" . "w")) 890 nil t ((?/ . "$/") ("_$" . "w"))
890 fortran-beginning-of-subprogram 891 fortran-beginning-of-subprogram))
891 (font-lock-syntactic-keywords 892 (set (make-local-variable 'fortran--font-lock-syntactic-keywords)
892 . fortran-font-lock-syntactic-keywords))) 893 (fortran-make-syntax-propertize-function))
894 (set (make-local-variable 'syntax-propertize-function)
895 (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords))
893 (set (make-local-variable 'imenu-case-fold-search) t) 896 (set (make-local-variable 'imenu-case-fold-search) t)
894 (set (make-local-variable 'imenu-generic-expression) 897 (set (make-local-variable 'imenu-generic-expression)
895 fortran-imenu-generic-expression) 898 fortran-imenu-generic-expression)
@@ -917,11 +920,13 @@ affects all Fortran buffers, and also the default."
917 (when (eq major-mode 'fortran-mode) 920 (when (eq major-mode 'fortran-mode)
918 (setq fortran-line-length nchars 921 (setq fortran-line-length nchars
919 fill-column fortran-line-length 922 fill-column fortran-line-length
920 new (fortran-font-lock-syntactic-keywords)) 923 new (fortran-make-syntax-propertize-function))
921 ;; Refontify only if necessary. 924 ;; Refontify only if necessary.
922 (unless (equal new font-lock-syntactic-keywords) 925 (unless (equal new fortran--font-lock-syntactic-keywords)
923 (setq font-lock-syntactic-keywords 926 (setq fortran--font-lock-syntactic-keywords new)
924 (fortran-font-lock-syntactic-keywords)) 927 (setq syntax-propertize-function
928 (syntax-propertize-via-font-lock new))
929 (syntax-ppss-flush-cache (point-min))
925 (if font-lock-mode (font-lock-mode 1)))))) 930 (if font-lock-mode (font-lock-mode 1))))))
926 (if global 931 (if global
927 (buffer-list) 932 (buffer-list)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index d20a14682c7..4c1471e39ec 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3123,10 +3123,12 @@ class of the file (using s to separate nested class ids)."
3123 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) 3123 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
3124 ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) 3124 ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
3125 3125
3126(defvar gdb-script-font-lock-syntactic-keywords 3126(defconst gdb-script-syntax-propertize-function
3127 '(("^document\\s-.*\\(\n\\)" (1 "< b")) 3127 (syntax-propertize-rules
3128 ("^end\\>" 3128 ("^document\\s-.*\\(\n\\)" (1 "< b"))
3129 (0 (unless (eq (match-beginning 0) (point-min)) 3129 ("^end\\(\\>\\)"
3130 (1 (ignore
3131 (unless (eq (match-beginning 0) (point-min))
3130 ;; We change the \n in front, which is more difficult, but results 3132 ;; We change the \n in front, which is more difficult, but results
3131 ;; in better highlighting. If the doc is empty, the single \n is 3133 ;; in better highlighting. If the doc is empty, the single \n is
3132 ;; both the beginning and the end of the docstring, which can't be 3134 ;; both the beginning and the end of the docstring, which can't be
@@ -3138,10 +3140,9 @@ class of the file (using s to separate nested class ids)."
3138 'syntax-table (eval-when-compile 3140 'syntax-table (eval-when-compile
3139 (string-to-syntax "> b"))) 3141 (string-to-syntax "> b")))
3140 ;; Make sure that rehighlighting the previous line won't erase our 3142 ;; Make sure that rehighlighting the previous line won't erase our
3141 ;; syntax-table property. 3143 ;; syntax-table property and that modifying `end' will.
3142 (put-text-property (1- (match-beginning 0)) (match-end 0) 3144 (put-text-property (1- (match-beginning 0)) (match-end 0)
3143 'font-lock-multiline t) 3145 'syntax-multiline t)))))))
3144 nil)))))
3145 3146
3146(defun gdb-script-font-lock-syntactic-face (state) 3147(defun gdb-script-font-lock-syntactic-face (state)
3147 (cond 3148 (cond
@@ -3239,10 +3240,13 @@ Treats actions as defuns."
3239 #'gdb-script-end-of-defun) 3240 #'gdb-script-end-of-defun)
3240 (set (make-local-variable 'font-lock-defaults) 3241 (set (make-local-variable 'font-lock-defaults)
3241 '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil 3242 '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
3242 (font-lock-syntactic-keywords
3243 . gdb-script-font-lock-syntactic-keywords)
3244 (font-lock-syntactic-face-function 3243 (font-lock-syntactic-face-function
3245 . gdb-script-font-lock-syntactic-face)))) 3244 . gdb-script-font-lock-syntactic-face)))
3245 ;; Recognize docstrings.
3246 (set (make-local-variable 'syntax-propertize-function)
3247 gdb-script-syntax-propertize-function)
3248 (add-hook 'syntax-propertize-extend-region-functions
3249 #'syntax-propertize-multiline 'append 'local))
3246 3250
3247 3251
3248;;; tooltips for GUD 3252;;; tooltips for GUD
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 5e854f852e1..ba70bb8ecce 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -45,16 +45,16 @@
45 45
46;;; Code: 46;;; Code:
47 47
48(eval-and-compile 48
49 (require 'cc-mode) 49(require 'cc-mode)
50 (require 'font-lock) 50(require 'font-lock)
51 (require 'newcomment) 51(require 'newcomment)
52 (require 'imenu) 52(require 'imenu)
53 (require 'etags) 53(require 'etags)
54 (require 'thingatpt) 54(require 'thingatpt)
55 (require 'easymenu) 55(require 'easymenu)
56 (require 'moz nil t) 56(require 'moz nil t)
57 (require 'json nil t)) 57(require 'json nil t)
58 58
59(eval-when-compile 59(eval-when-compile
60 (require 'cl) 60 (require 'cl)
@@ -725,20 +725,19 @@ as if strings, cpp macros, and comments have been removed.
725 725
726If invoked while inside a macro, it treats the contents of the 726If invoked while inside a macro, it treats the contents of the
727macro as normal text." 727macro as normal text."
728 (unless count (setq count 1))
728 (let ((saved-point (point)) 729 (let ((saved-point (point))
729 (search-expr 730 (search-fun
730 (cond ((null count) 731 (cond ((< count 0) (setq count (- count))
731 '(js--re-search-forward-inner regexp bound 1)) 732 #'js--re-search-backward-inner)
732 ((< count 0) 733 ((> count 0) #'js--re-search-forward-inner)
733 '(js--re-search-backward-inner regexp bound (- count))) 734 (t #'ignore))))
734 ((> count 0)
735 '(js--re-search-forward-inner regexp bound count)))))
736 (condition-case err 735 (condition-case err
737 (eval search-expr) 736 (funcall search-fun regexp bound count)
738 (search-failed 737 (search-failed
739 (goto-char saved-point) 738 (goto-char saved-point)
740 (unless noerror 739 (unless noerror
741 (error (error-message-string err))))))) 740 (signal (car err) (cdr err)))))))
742 741
743 742
744(defun js--re-search-backward-inner (regexp &optional bound count) 743(defun js--re-search-backward-inner (regexp &optional bound count)
@@ -782,20 +781,7 @@ as if strings, preprocessor macros, and comments have been
782removed. 781removed.
783 782
784If invoked while inside a macro, treat the macro as normal text." 783If invoked while inside a macro, treat the macro as normal text."
785 (let ((saved-point (point)) 784 (js--re-search-forward regexp bound noerror (if count (- count) -1)))
786 (search-expr
787 (cond ((null count)
788 '(js--re-search-backward-inner regexp bound 1))
789 ((< count 0)
790 '(js--re-search-forward-inner regexp bound (- count)))
791 ((> count 0)
792 '(js--re-search-backward-inner regexp bound count)))))
793 (condition-case err
794 (eval search-expr)
795 (search-failed
796 (goto-char saved-point)
797 (unless noerror
798 (error (error-message-string err)))))))
799 785
800(defun js--forward-expression () 786(defun js--forward-expression ()
801 "Move forward over a whole JavaScript expression. 787 "Move forward over a whole JavaScript expression.
@@ -1674,18 +1660,19 @@ This performs fontification according to `js--class-styles'."
1674;; XXX: Javascript can continue a regexp literal across lines so long 1660;; XXX: Javascript can continue a regexp literal across lines so long
1675;; as the newline is escaped with \. Account for that in the regexp 1661;; as the newline is escaped with \. Account for that in the regexp
1676;; below. 1662;; below.
1677(defconst js--regexp-literal 1663(eval-and-compile
1664 (defconst js--regexp-literal
1678 "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)" 1665 "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)"
1679 "Regexp matching a JavaScript regular expression literal. 1666 "Regexp matching a JavaScript regular expression literal.
1680Match groups 1 and 2 are the characters forming the beginning and 1667Match groups 1 and 2 are the characters forming the beginning and
1681end of the literal.") 1668end of the literal."))
1669
1682 1670
1683;; we want to match regular expressions only at the beginning of 1671(defconst js-syntax-propertize-function
1684;; expressions 1672 (syntax-propertize-rules
1685(defconst js-font-lock-syntactic-keywords 1673 ;; We want to match regular expressions only at the beginning of
1686 `((,js--regexp-literal (1 "|") (2 "|"))) 1674 ;; expressions.
1687 "Syntactic font lock keywords matching regexps in JavaScript. 1675 (js--regexp-literal (1 "\"") (2 "\""))))
1688See `font-lock-keywords'.")
1689 1676
1690;;; Indentation 1677;;; Indentation
1691 1678
@@ -3317,10 +3304,9 @@ Key bindings:
3317 3304
3318 (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) 3305 (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
3319 (set (make-local-variable 'font-lock-defaults) 3306 (set (make-local-variable 'font-lock-defaults)
3320 (list js--font-lock-keywords 3307 '(js--font-lock-keywords))
3321 nil nil nil nil 3308 (set (make-local-variable 'syntax-propertize-function)
3322 '(font-lock-syntactic-keywords 3309 js-syntax-propertize-function)
3323 . js-font-lock-syntactic-keywords)))
3324 3310
3325 (set (make-local-variable 'parse-sexp-ignore-comments) t) 3311 (set (make-local-variable 'parse-sexp-ignore-comments) t)
3326 (set (make-local-variable 'parse-sexp-lookup-properties) t) 3312 (set (make-local-variable 'parse-sexp-lookup-properties) t)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 362a1db6c10..187c838382b 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -505,15 +505,16 @@ not be enclosed in { } or ( )."
505 cpp-font-lock-keywords)) 505 cpp-font-lock-keywords))
506 506
507 507
508(defconst makefile-font-lock-syntactic-keywords 508(defconst makefile-syntax-propertize-function
509 ;; From sh-script.el. 509 (syntax-propertize-rules
510 ;; A `#' begins a comment in sh when it is unquoted and at the beginning 510 ;; From sh-script.el.
511 ;; of a word. In the shell, words are separated by metacharacters. 511 ;; A `#' begins a comment in sh when it is unquoted and at the beginning
512 ;; The list of special chars is taken from the single-unix spec of the 512 ;; of a word. In the shell, words are separated by metacharacters.
513 ;; shell command language (under `quoting') but with `$' removed. 513 ;; The list of special chars is taken from the single-unix spec of the
514 '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_") 514 ;; shell command language (under `quoting') but with `$' removed.
515 ;; Change the syntax of a quoted newline so that it does not end a comment. 515 ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
516 ("\\\\\n" 0 "."))) 516 ;; Change the syntax of a quoted newline so that it does not end a comment.
517 ("\\\\\n" (0 "."))))
517 518
518(defvar makefile-imenu-generic-expression 519(defvar makefile-imenu-generic-expression
519 `(("Dependencies" makefile-previous-dependency 1) 520 `(("Dependencies" makefile-previous-dependency 1)
@@ -872,9 +873,9 @@ Makefile mode can be configured by modifying the following variables:
872 '(makefile-font-lock-keywords 873 '(makefile-font-lock-keywords
873 nil nil 874 nil nil
874 ((?$ . ".")) 875 ((?$ . "."))
875 backward-paragraph 876 backward-paragraph))
876 (font-lock-syntactic-keywords 877 (set (make-local-variable 'syntax-propertize-function)
877 . makefile-font-lock-syntactic-keywords))) 878 makefile-syntax-propertize-function)
878 879
879 ;; Add-log. 880 ;; Add-log.
880 (set (make-local-variable 'add-log-current-defun-function) 881 (set (make-local-variable 'add-log-current-defun-function)
@@ -943,15 +944,9 @@ Makefile mode can be configured by modifying the following variables:
943(define-derived-mode makefile-imake-mode makefile-mode "Imakefile" 944(define-derived-mode makefile-imake-mode makefile-mode "Imakefile"
944 "An adapted `makefile-mode' that knows about imake." 945 "An adapted `makefile-mode' that knows about imake."
945 :syntax-table makefile-imake-mode-syntax-table 946 :syntax-table makefile-imake-mode-syntax-table
946 (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))) 947 (set (make-local-variable 'syntax-propertize-function) nil)
947 new) 948 (setq font-lock-defaults
948 ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults. 949 `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
949 (mapc (lambda (elt)
950 (unless (and (consp elt)
951 (eq (car elt) 'font-lock-syntactic-keywords))
952 (setq new (cons elt new))))
953 base)
954 (setq font-lock-defaults (nreverse new))))
955 950
956 951
957 952
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index ecb8461a9f2..94af563d88f 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -89,7 +89,7 @@
89(defvar mixal-mode-syntax-table 89(defvar mixal-mode-syntax-table
90 (let ((st (make-syntax-table))) 90 (let ((st (make-syntax-table)))
91 ;; We need to do a bit more to make fontlocking for comments work. 91 ;; We need to do a bit more to make fontlocking for comments work.
92 ;; See mixal-font-lock-syntactic-keywords. 92 ;; See use of syntax-propertize-function.
93 ;; (modify-syntax-entry ?* "<" st) 93 ;; (modify-syntax-entry ?* "<" st)
94 (modify-syntax-entry ?\n ">" st) 94 (modify-syntax-entry ?\n ">" st)
95 st) 95 st)
@@ -1028,13 +1028,14 @@ EXECUTION-TIME holds info about the time it takes, number or string.")
1028 1028
1029 1029
1030;;; Font-locking: 1030;;; Font-locking:
1031(defvar mixal-font-lock-syntactic-keywords 1031(defconst mixal-syntax-propertize-function
1032 ;; Normal comments start with a * in column 0 and end at end of line. 1032 (syntax-propertize-rules
1033 '(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11) 1033 ;; Normal comments start with a * in column 0 and end at end of line.
1034 ;; Every line can end with a comment which is placed after the operand. 1034 ("^\\*" (0 "<"))
1035 ;; I assume here that mnemonics without operands can not have a comment. 1035 ;; Every line can end with a comment which is placed after the operand.
1036 ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" 1036 ;; I assume here that mnemonics without operands can not have a comment.
1037 (1 '(11))))) 1037 ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
1038 (1 "<"))))
1038 1039
1039(defvar mixal-font-lock-keywords 1040(defvar mixal-font-lock-keywords
1040 `(("^\\([A-Z0-9a-z]+\\)" 1041 `(("^\\([A-Z0-9a-z]+\\)"
@@ -1110,9 +1111,9 @@ Assumes that file has been compiled with debugging support."
1110 (set (make-local-variable 'comment-start) "*") 1111 (set (make-local-variable 'comment-start) "*")
1111 (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") 1112 (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
1112 (set (make-local-variable 'font-lock-defaults) 1113 (set (make-local-variable 'font-lock-defaults)
1113 `(mixal-font-lock-keywords nil nil nil nil 1114 `(mixal-font-lock-keywords))
1114 (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords) 1115 (set (make-local-variable 'syntax-propertize-function)
1115 (parse-sexp-lookup-properties . t))) 1116 mixal-syntax-propertize-function)
1116 ;; might add an indent function in the future 1117 ;; might add an indent function in the future
1117 ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) 1118 ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
1118 (set (make-local-variable 'compile-command) (concat "mixasm " 1119 (set (make-local-variable 'compile-command) (concat "mixasm "
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index ede850f87ab..bbefdaa2ccf 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -179,38 +179,28 @@ parenthetical grouping.")
179 '(3 font-lock-function-name-face nil t))) 179 '(3 font-lock-function-name-face nil t)))
180 "Additional Octave expressions to highlight.") 180 "Additional Octave expressions to highlight.")
181 181
182(defvar octave-font-lock-syntactic-keywords 182(defun octave-syntax-propertize-function (start end)
183 (goto-char start)
184 (octave-syntax-propertize-sqs end)
185 (funcall (syntax-propertize-rules
183 ;; Try to distinguish the string-quotes from the transpose-quotes. 186 ;; Try to distinguish the string-quotes from the transpose-quotes.
184 '(("[[({,; ]\\('\\)" (1 "\"'")) 187 ("[[({,; ]\\('\\)"
185 (octave-font-lock-close-quotes))) 188 (1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
186 189 (point) end))
187(defun octave-font-lock-close-quotes (limit) 190
188 "Fix the syntax-table of the closing quotes of single-quote strings." 191(defun octave-syntax-propertize-sqs (end)
189 ;; Freely inspired from perl-font-lock-special-syntactic-constructs. 192 "Propertize the content/end of single-quote strings."
190 (let ((state (syntax-ppss))) 193 (when (eq (nth 3 (syntax-ppss)) ?\')
191 (while (< (point) limit)
192 (cond
193 ((eq (nth 3 state) ?\')
194 ;; A '..' string. 194 ;; A '..' string.
195 (save-excursion 195 (when (re-search-forward
196 (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']" 196 "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
197 nil t) 197 (goto-char (match-beginning 2))
198 (goto-char (1- (point)))
199 ;; Remove any syntax-table property we may have applied to
200 ;; some of the (doubled) single quotes within the string.
201 ;; Since these are the only chars on which we place properties,
202 ;; we take a shortcut and just remove all properties.
203 (remove-text-properties (1+ (nth 8 state)) (match-beginning 1)
204 '(syntax-table nil))
205 (when (eq (char-before (match-beginning 1)) ?\\) 198 (when (eq (char-before (match-beginning 1)) ?\\)
206 ;; Backslash cannot escape a single quote. 199 ;; Backslash cannot escape a single quote.
207 (put-text-property (1- (match-beginning 1)) (match-beginning 1) 200 (put-text-property (1- (match-beginning 1)) (match-beginning 1)
208 'syntax-table (string-to-syntax "."))) 201 'syntax-table (string-to-syntax ".")))
209 (put-text-property (match-beginning 1) (match-end 1) 202 (put-text-property (match-beginning 1) (match-end 1)
210 'syntax-table (string-to-syntax "\"'")))))) 203 'syntax-table (string-to-syntax "\"'")))))
211
212 (setq state (parse-partial-sexp (point) limit nil nil state
213 'syntax-table)))))
214 204
215(defcustom inferior-octave-buffer "*Inferior Octave*" 205(defcustom inferior-octave-buffer "*Inferior Octave*"
216 "Name of buffer for running an inferior Octave process." 206 "Name of buffer for running an inferior Octave process."
@@ -544,6 +534,8 @@ Non-nil means always go to the next Octave code line after sending."
544 0) 534 0)
545 ((:before . "case") octave-block-offset))) 535 ((:before . "case") octave-block-offset)))
546 536
537(defvar electric-indent-chars)
538
547;;;###autoload 539;;;###autoload
548(define-derived-mode octave-mode prog-mode "Octave" 540(define-derived-mode octave-mode prog-mode "Octave"
549 "Major mode for editing Octave code. 541 "Major mode for editing Octave code.
@@ -682,9 +674,10 @@ including a reproducible test case and send the message."
682 (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) 674 (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill)
683 675
684 (set (make-local-variable 'font-lock-defaults) 676 (set (make-local-variable 'font-lock-defaults)
685 '(octave-font-lock-keywords nil nil nil nil 677 '(octave-font-lock-keywords))
686 (font-lock-syntactic-keywords . octave-font-lock-syntactic-keywords) 678
687 (parse-sexp-lookup-properties . t))) 679 (set (make-local-variable 'syntax-propertize-function)
680 #'octave-syntax-propertize-function)
688 681
689 (set (make-local-variable 'imenu-generic-expression) 682 (set (make-local-variable 'imenu-generic-expression)
690 octave-mode-imenu-generic-expression) 683 octave-mode-imenu-generic-expression)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f8eba5accdb..ae3acc3cda3 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -250,59 +250,76 @@ The expansion is entirely correct because it uses the C preprocessor."
250;; y /.../.../ 250;; y /.../.../
251;; 251;;
252;; <file*glob> 252;; <file*glob>
253(defvar perl-font-lock-syntactic-keywords 253(defun perl-syntax-propertize-function (start end)
254 ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") 254 (let ((case-fold-search nil))
255 `(;; Turn POD into b-style comments 255 (goto-char start)
256 ("^\\(=\\)\\sw" (1 "< b")) 256 (perl-syntax-propertize-special-constructs end)
257 ("^=cut[ \t]*\\(\n\\)" (1 "> b")) 257 ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
258 ;; Catch ${ so that ${var} doesn't screw up indentation. 258 (funcall
259 ;; This also catches $' to handle 'foo$', although it should really 259 (syntax-propertize-rules
260 ;; check that it occurs inside a '..' string. 260 ;; Turn POD into b-style comments. Place the cut rule first since it's
261 ("\\(\\$\\)[{']" (1 ". p")) 261 ;; more specific.
262 ;; Handle funny names like $DB'stop. 262 ("^=cut\\>.*\\(\n\\)" (1 "> b"))
263 ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) 263 ("^\\(=\\)\\sw" (1 "< b"))
264 ;; format statements 264 ;; Catch ${ so that ${var} doesn't screw up indentation.
265 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) 265 ;; This also catches $' to handle 'foo$', although it should really
266 ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. 266 ;; check that it occurs inside a '..' string.
267 ;; Be careful not to match "sub { (...) ... }". 267 ("\\(\\$\\)[{']" (1 ". p"))
268 ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" 268 ;; Handle funny names like $DB'stop.
269 1 '(1)) 269 ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
270 ;; Regexp and funny quotes. Distinguishing a / that starts a regexp 270 ;; format statements
271 ;; match from the division operator is ...interesting. 271 ("^[ \t]*format.*=[ \t]*\\(\n\\)"
272 ;; Basically, / is a regexp match if it's preceded by an infix operator 272 (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
273 ;; (or some similar separator), or by one of the special keywords 273 ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
274 ;; corresponding to builtin functions that can take their first arg 274 ;; Be careful not to match "sub { (...) ... }".
275 ;; without parentheses. Of course, that presume we're looking at the 275 ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
276 ;; *opening* slash. We can afford to mis-match the closing ones 276 (1 "."))
277 ;; here, because they will be re-treated separately later in 277 ;; Regexp and funny quotes. Distinguishing a / that starts a regexp
278 ;; perl-font-lock-special-syntactic-constructs. 278 ;; match from the division operator is ...interesting.
279 (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" 279 ;; Basically, / is a regexp match if it's preceded by an infix operator
280 (regexp-opt '("split" "if" "unless" "until" "while" "split" 280 ;; (or some similar separator), or by one of the special keywords
281 "grep" "map" "not" "or" "and")) 281 ;; corresponding to builtin functions that can take their first arg
282 "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") 282 ;; without parentheses. Of course, that presume we're looking at the
283 (2 (if (and (match-end 1) 283 ;; *opening* slash. We can afford to mis-match the closing ones
284 (save-excursion 284 ;; here, because they will be re-treated separately later in
285 (goto-char (match-end 1)) 285 ;; perl-font-lock-special-syntactic-constructs.
286 ;; Not 100% correct since we haven't finished setting up 286 ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
287 ;; the syntax-table before point, but better than nothing. 287 (regexp-opt '("split" "if" "unless" "until" "while" "split"
288 (forward-comment (- (point-max))) 288 "grep" "map" "not" "or" "and"))
289 (put-text-property (point) (match-end 2) 289 "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
290 'jit-lock-defer-multiline t) 290 (2 (ignore
291 (not (memq (char-before) 291 (if (and (match-end 1) ; / at BOL.
292 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) 292 (save-excursion
293 nil ;; A division sign instead of a regexp-match. 293 (goto-char (match-end 1))
294 '(7)))) 294 (forward-comment (- (point-max)))
295 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" 295 (put-text-property (point) (match-end 2)
296 ;; Nasty cases: 296 'syntax-multiline t)
297 ;; /foo/m $a->m $#m $m @m %m 297 (not (memq (char-before)
298 ;; \s (appears often in regexps). 298 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
299 ;; -s file 299 nil ;; A division sign instead of a regexp-match.
300 (3 (if (assoc (char-after (match-beginning 3)) 300 (put-text-property (match-beginning 2) (match-end 2)
301 perl-quote-like-pairs) 301 'syntax-table (string-to-syntax "\""))
302 '(15) '(7)))) 302 (perl-syntax-propertize-special-constructs end)))))
303 ;; Find and mark the end of funny quotes and format statements. 303 ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
304 (perl-font-lock-special-syntactic-constructs) 304 ;; Nasty cases:
305 )) 305 ;; /foo/m $a->m $#m $m @m %m
306 ;; \s (appears often in regexps).
307 ;; -s file
308 ;; sub tr {...}
309 (3 (ignore
310 (if (save-excursion (goto-char (match-beginning 0))
311 (forward-word -1)
312 (looking-at-p "sub[ \t\n]"))
313 ;; This is defining a function.
314 nil
315 (put-text-property (match-beginning 3) (match-end 3)
316 'syntax-table
317 (if (assoc (char-after (match-beginning 3))
318 perl-quote-like-pairs)
319 (string-to-syntax "|")
320 (string-to-syntax "\"")))
321 (perl-syntax-propertize-special-constructs end))))))
322 (point) end)))
306 323
307(defvar perl-empty-syntax-table 324(defvar perl-empty-syntax-table
308 (let ((st (copy-syntax-table))) 325 (let ((st (copy-syntax-table)))
@@ -321,95 +338,123 @@ The expansion is entirely correct because it uses the C preprocessor."
321 (modify-syntax-entry close ")" st)) 338 (modify-syntax-entry close ")" st))
322 st)) 339 st))
323 340
324(defun perl-font-lock-special-syntactic-constructs (limit) 341(defun perl-syntax-propertize-special-constructs (limit)
325 ;; We used to do all this in a font-lock-syntactic-face-function, which 342 "Propertize special constructs like regexps and formats."
326 ;; did not work correctly because sometimes some parts of the buffer are
327 ;; treated with font-lock-syntactic-keywords but not with
328 ;; font-lock-syntactic-face-function (mostly because of
329 ;; font-lock-syntactically-fontified). That meant that some syntax-table
330 ;; properties were missing. So now we do the parse-partial-sexp loop
331 ;; ourselves directly from font-lock-syntactic-keywords, so we're sure
332 ;; it's done when necessary.
333 (let ((state (syntax-ppss)) 343 (let ((state (syntax-ppss))
334 char) 344 char)
335 (while (< (point) limit) 345 (cond
336 (cond 346 ((or (null (setq char (nth 3 state)))
337 ((or (null (setq char (nth 3 state))) 347 (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
338 (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) 348 ;; Normal text, or comment, or docstring, or normal string.
339 ;; Normal text, or comment, or docstring, or normal string. 349 nil)
340 nil) 350 ((eq (nth 3 state) ?\n)
341 ((eq (nth 3 state) ?\n) 351 ;; A `format' command.
342 ;; A `format' command. 352 (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move)
343 (save-excursion 353 (put-text-property (1- (point)) (point)
344 (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) 354 'syntax-table (string-to-syntax "\""))))
345 (not (eobp))) 355 (t
346 (put-text-property (point) (1+ (point)) 'syntax-table '(7))))) 356 ;; This is regexp like quote thingy.
347 (t 357 (setq char (char-after (nth 8 state)))
348 ;; This is regexp like quote thingy. 358 (let ((twoargs (save-excursion
349 (setq char (char-after (nth 8 state))) 359 (goto-char (nth 8 state))
350 (save-excursion 360 (skip-syntax-backward " ")
351 (let ((twoargs (save-excursion 361 (skip-syntax-backward "w")
352 (goto-char (nth 8 state)) 362 (member (buffer-substring
353 (skip-syntax-backward " ") 363 (point) (progn (forward-word 1) (point)))
354 (skip-syntax-backward "w") 364 '("tr" "s" "y"))))
355 (member (buffer-substring 365 (close (cdr (assq char perl-quote-like-pairs)))
356 (point) (progn (forward-word 1) (point))) 366 (st (perl-quote-syntax-table char)))
357 '("tr" "s" "y")))) 367 (when (with-syntax-table st
358 (close (cdr (assq char perl-quote-like-pairs))) 368 (if close
359 (pos (point)) 369 ;; For paired delimiters, Perl allows nesting them, but
360 (st (perl-quote-syntax-table char))) 370 ;; since we treat them as strings, Emacs does not count
361 (if (not close) 371 ;; those delimiters in `state', so we don't know how deep
362 ;; The closing char is the same as the opening char. 372 ;; we are: we have to go back to the beginning of this
363 (with-syntax-table st 373 ;; "string" and count from there.
364 (parse-partial-sexp (point) (point-max) 374 (condition-case nil
365 nil nil state 'syntax-table) 375 (progn
366 (when twoargs 376 ;; Start after the first char since it doesn't have
367 (parse-partial-sexp (point) (point-max) 377 ;; paren-syntax (an alternative would be to let-bind
368 nil nil state 'syntax-table))) 378 ;; parse-sexp-lookup-properties).
369 ;; The open/close chars are matched like () [] {} and <>. 379 (goto-char (1+ (nth 8 state)))
370 (let ((parse-sexp-lookup-properties nil)) 380 (up-list 1)
371 (condition-case err 381 t)
372 (progn 382 (scan-error nil))
373 (with-syntax-table st 383 (not (or (nth 8 (parse-partial-sexp
374 (goto-char (nth 8 state)) (forward-sexp 1)) 384 (point) limit nil nil state 'syntax-table))
375 (when twoargs 385 ;; If we have a self-paired opener and a twoargs
376 (save-excursion 386 ;; command, the form is s/../../ so we have to skip
377 ;; Skip whitespace and make sure that font-lock will 387 ;; a second time.
378 ;; refontify the second part in the proper context. 388 ;; In the case of s{...}{...}, we only handle the
379 (put-text-property 389 ;; first part here and the next below.
380 (point) (progn (forward-comment (point-max)) (point)) 390 (when (and twoargs (not close))
381 'font-lock-multiline t) 391 (nth 8 (parse-partial-sexp
382 ;; 392 (point) limit
383 (unless 393 nil nil state 'syntax-table)))))))
384 (or (eobp) 394 ;; Point is now right after the arg(s).
385 (save-excursion 395 (when (eq (char-before (1- (point))) ?$)
386 (with-syntax-table 396 (put-text-property (- (point) 2) (1- (point))
387 (perl-quote-syntax-table (char-after)) 397 'syntax-table '(1)))
388 (forward-sexp 1)) 398 (put-text-property (1- (point)) (point)
389 (put-text-property pos (line-end-position) 399 'syntax-table
390 'jit-lock-defer-multiline t) 400 (if close
391 (looking-at "\\s-*\\sw*e"))) 401 (string-to-syntax "|")
392 (put-text-property (point) (1+ (point)) 402 (string-to-syntax "\"")))
393 'syntax-table 403 ;; If we have two args with a non-self-paired starter (e.g.
394 (if (assoc (char-after) 404 ;; s{...}{...}) we're right after the first arg, so we still have to
395 perl-quote-like-pairs) 405 ;; handle the second part.
396 '(15) '(7))))))) 406 (when (and twoargs close)
397 ;; The arg(s) is not terminated, so it extends until EOB. 407 ;; Skip whitespace and make sure that font-lock will
398 (scan-error (goto-char (point-max)))))) 408 ;; refontify the second part in the proper context.
399 ;; Point is now right after the arg(s). 409 (put-text-property
400 ;; Erase any syntactic marks within the quoted text. 410 (point) (progn (forward-comment (point-max)) (point))
401 (put-text-property pos (1- (point)) 'syntax-table nil) 411 'syntax-multiline t)
402 (when (eq (char-before (1- (point))) ?$) 412 ;;
403 (put-text-property (- (point) 2) (1- (point)) 413 (when (< (point) limit)
404 'syntax-table '(1))) 414 (put-text-property (point) (1+ (point))
405 (put-text-property (1- (point)) (point) 415 'syntax-table
406 'syntax-table (if close '(15) '(7))))))) 416 (if (assoc (char-after)
407 417 perl-quote-like-pairs)
408 (setq state (parse-partial-sexp (point) limit nil nil state 418 ;; Put an `e' in the cdr to mark this
409 'syntax-table)))) 419 ;; char as "second arg starter".
410 ;; Tell font-lock that this needs not further processing. 420 (string-to-syntax "|e")
411 nil) 421 (string-to-syntax "\"e")))
412 422 (forward-char 1)
423 ;; Re-use perl-syntax-propertize-special-constructs to handle the
424 ;; second part (the first delimiter of second part can't be
425 ;; preceded by "s" or "tr" or "y", so it will not be considered
426 ;; as twoarg).
427 (perl-syntax-propertize-special-constructs limit)))))))))
428
429(defun perl-font-lock-syntactic-face-function (state)
430 (cond
431 ((and (nth 3 state)
432 (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
433 ;; This is a second-arg of s{..}{...} form; let's check if this second
434 ;; arg is executable code rather than a string. For that, we need to
435 ;; look for an "e" after this second arg, so we have to hunt for the
436 ;; end of the arg. Depending on whether the whole arg has already
437 ;; been syntax-propertized or not, the end-char will have different
438 ;; syntaxes, so let's ignore syntax-properties temporarily so we can
439 ;; pretend it has not been syntax-propertized yet.
440 (let* ((parse-sexp-lookup-properties nil)
441 (char (char-after (nth 8 state)))
442 (paired (assq char perl-quote-like-pairs)))
443 (with-syntax-table (perl-quote-syntax-table char)
444 (save-excursion
445 (if (not paired)
446 (parse-partial-sexp (point) (point-max)
447 nil nil state 'syntax-table)
448 (condition-case nil
449 (progn
450 (goto-char (1+ (nth 8 state)))
451 (up-list 1))
452 (scan-error (goto-char (point-max)))))
453 (put-text-property (nth 8 state) (point)
454 'jit-lock-defer-multiline t)
455 (looking-at "[ \t]*\\sw*e")))))
456 nil)
457 (t (funcall (default-value 'font-lock-syntactic-face-function) state))))
413 458
414(defcustom perl-indent-level 4 459(defcustom perl-indent-level 4
415 "*Indentation of Perl statements with respect to containing block." 460 "*Indentation of Perl statements with respect to containing block."
@@ -574,9 +619,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
574 perl-font-lock-keywords-1 619 perl-font-lock-keywords-1
575 perl-font-lock-keywords-2) 620 perl-font-lock-keywords-2)
576 nil nil ((?\_ . "w")) nil 621 nil nil ((?\_ . "w")) nil
577 (font-lock-syntactic-keywords 622 (font-lock-syntactic-face-function
578 . perl-font-lock-syntactic-keywords) 623 . perl-font-lock-syntactic-face-function)))
579 (parse-sexp-lookup-properties . t))) 624 (set (make-local-variable 'syntax-propertize-function)
625 #'perl-syntax-propertize-function)
626 (add-hook 'syntax-propertize-extend-region-functions
627 #'syntax-propertize-multiline 'append 'local)
580 ;; Tell imenu how to handle Perl. 628 ;; Tell imenu how to handle Perl.
581 (set (make-local-variable 'imenu-generic-expression) 629 (set (make-local-variable 'imenu-generic-expression)
582 perl-imenu-generic-expression) 630 perl-imenu-generic-expression)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2f65ffa1e17..10e852223ce 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -166,29 +166,32 @@
166 symbol-end) 166 symbol-end)
167 . font-lock-builtin-face))) 167 . font-lock-builtin-face)))
168 168
169(defconst python-font-lock-syntactic-keywords 169(defconst python-syntax-propertize-function
170 ;; Make outer chars of matching triple-quote sequences into generic 170 ;; Make outer chars of matching triple-quote sequences into generic
171 ;; string delimiters. Fixme: Is there a better way? 171 ;; string delimiters. Fixme: Is there a better way?
172 ;; First avoid a sequence preceded by an odd number of backslashes. 172 ;; First avoid a sequence preceded by an odd number of backslashes.
173 `((,(rx (not (any ?\\)) 173 (syntax-propertize-rules
174 ?\\ (* (and ?\\ ?\\)) 174 (;; (rx (not (any ?\\))
175 (group (syntax string-quote)) 175 ;; ?\\ (* (and ?\\ ?\\))
176 (backref 1) 176 ;; (group (syntax string-quote))
177 (group (backref 1))) 177 ;; (backref 1)
178 (2 ,(string-to-syntax "\""))) ; dummy 178 ;; (group (backref 1)))
179 (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property 179 ;; ¡Backrefs don't work in syntax-propertize-rules!
180 (optional (any "rR")) ; possible second prefix 180 "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)"
181 (group (syntax string-quote)) ; maybe gets property 181 (2 "\"")) ; dummy
182 (backref 2) ; per first quote 182 (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property
183 (group (backref 2))) ; maybe gets property 183 ;; (optional (any "rR")) ; possible second prefix
184 (1 (python-quote-syntax 1)) 184 ;; (group (syntax string-quote)) ; maybe gets property
185 (2 (python-quote-syntax 2)) 185 ;; (backref 2) ; per first quote
186 (3 (python-quote-syntax 3))) 186 ;; (group (backref 2))) ; maybe gets property
187 ;; This doesn't really help. 187 ;; ¡Backrefs don't work in syntax-propertize-rules!
188;;; (,(rx (and ?\\ (group ?\n))) (1 " ")) 188 "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)"
189 )) 189 (3 (ignore (python-quote-syntax))))
190 190 ;; This doesn't really help.
191(defun python-quote-syntax (n) 191 ;;((rx (and ?\\ (group ?\n))) (1 " "))
192 ))
193
194(defun python-quote-syntax ()
192 "Put `syntax-table' property correctly on triple quote. 195 "Put `syntax-table' property correctly on triple quote.
193Used for syntactic keywords. N is the match number (1, 2 or 3)." 196Used for syntactic keywords. N is the match number (1, 2 or 3)."
194 ;; Given a triple quote, we have to check the context to know 197 ;; Given a triple quote, we have to check the context to know
@@ -206,28 +209,25 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
206 ;; x '"""' x """ \"""" x 209 ;; x '"""' x """ \"""" x
207 (save-excursion 210 (save-excursion
208 (goto-char (match-beginning 0)) 211 (goto-char (match-beginning 0))
209 (cond 212 (let ((syntax (save-match-data (syntax-ppss))))
210 ;; Consider property for the last char if in a fenced string. 213 (cond
211 ((= n 3) 214 ((eq t (nth 3 syntax)) ; after unclosed fence
212 (let* ((font-lock-syntactic-keywords nil) 215 ;; Consider property for the last char if in a fenced string.
213 (syntax (syntax-ppss))) 216 (goto-char (nth 8 syntax)) ; fence position
214 (when (eq t (nth 3 syntax)) ; after unclosed fence 217 (skip-chars-forward "uUrR") ; skip any prefix
215 (goto-char (nth 8 syntax)) ; fence position 218 ;; Is it a matching sequence?
216 (skip-chars-forward "uUrR") ; skip any prefix 219 (if (eq (char-after) (char-after (match-beginning 2)))
217 ;; Is it a matching sequence? 220 (put-text-property (match-beginning 3) (match-end 3)
218 (if (eq (char-after) (char-after (match-beginning 2))) 221 'syntax-table (string-to-syntax "|"))))
219 (eval-when-compile (string-to-syntax "|")))))) 222 ((match-end 1)
220 ;; Consider property for initial char, accounting for prefixes. 223 ;; Consider property for initial char, accounting for prefixes.
221 ((or (and (= n 2) ; leading quote (not prefix) 224 (put-text-property (match-beginning 1) (match-end 1)
222 (= (match-beginning 1) (match-end 1))) ; prefix is null 225 'syntax-table (string-to-syntax "|")))
223 (and (= n 1) ; prefix 226 (t
224 (/= (match-beginning 1) (match-end 1)))) ; non-empty 227 ;; Consider property for initial char, accounting for prefixes.
225 (let ((font-lock-syntactic-keywords nil)) 228 (put-text-property (match-beginning 2) (match-end 2)
226 (unless (eq 'string (syntax-ppss-context (syntax-ppss))) 229 'syntax-table (string-to-syntax "|"))))
227 (eval-when-compile (string-to-syntax "|"))))) 230 )))
228 ;; Otherwise (we're in a non-matching string) the property is
229 ;; nil, which is OK.
230 )))
231 231
232;; This isn't currently in `font-lock-defaults' as probably not worth 232;; This isn't currently in `font-lock-defaults' as probably not worth
233;; it -- we basically only mess with a few normally-symbol characters. 233;; it -- we basically only mess with a few normally-symbol characters.
@@ -2495,12 +2495,12 @@ with skeleton expansions for compound statement templates.
2495 :group 'python 2495 :group 'python
2496 (set (make-local-variable 'font-lock-defaults) 2496 (set (make-local-variable 'font-lock-defaults)
2497 '(python-font-lock-keywords nil nil nil nil 2497 '(python-font-lock-keywords nil nil nil nil
2498 (font-lock-syntactic-keywords 2498 ;; This probably isn't worth it.
2499 . python-font-lock-syntactic-keywords) 2499 ;; (font-lock-syntactic-face-function
2500 ;; This probably isn't worth it. 2500 ;; . python-font-lock-syntactic-face-function)
2501 ;; (font-lock-syntactic-face-function 2501 ))
2502 ;; . python-font-lock-syntactic-face-function) 2502 (set (make-local-variable 'syntax-propertize-function)
2503 )) 2503 python-syntax-propertize-function)
2504 (set (make-local-variable 'parse-sexp-lookup-properties) t) 2504 (set (make-local-variable 'parse-sexp-lookup-properties) t)
2505 (set (make-local-variable 'parse-sexp-ignore-comments) t) 2505 (set (make-local-variable 'parse-sexp-ignore-comments) t)
2506 (set (make-local-variable 'comment-start) "# ") 2506 (set (make-local-variable 'comment-start) "# ")
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 0b92234bf1c..4d015de5198 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -100,17 +100,10 @@
100 100
101(defconst ruby-block-end-re "\\<end\\>") 101(defconst ruby-block-end-re "\\<end\\>")
102 102
103(defconst ruby-here-doc-beg-re 103(eval-and-compile
104 (defconst ruby-here-doc-beg-re
104 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" 105 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
105 "Regexp to match the beginning of a heredoc.") 106 "Regexp to match the beginning of a heredoc."))
106
107(defconst ruby-here-doc-end-re
108 "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$"
109 "Regexp to match the end of heredocs.
110
111This will actually match any line with one or more characters.
112It's useful in that it divides up the match string so that
113`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
114 107
115(defun ruby-here-doc-end-match () 108(defun ruby-here-doc-end-match ()
116 "Return a regexp to find the end of a heredoc. 109 "Return a regexp to find the end of a heredoc.
@@ -123,18 +116,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
123 (match-string 5) 116 (match-string 5)
124 (match-string 6))))) 117 (match-string 6)))))
125 118
126(defun ruby-here-doc-beg-match ()
127 "Return a regexp to find the beginning of a heredoc.
128
129This should only be called after matching against `ruby-here-doc-end-re'."
130 (let ((contents (regexp-quote (concat (match-string 2) (match-string 3)))))
131 (concat "<<"
132 (let ((match (match-string 1)))
133 (if (and match (> (length match) 0))
134 (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)"
135 contents "\\b\\(\\1\\|\\2\\)")
136 (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
137
138(defconst ruby-delimiter 119(defconst ruby-delimiter
139 (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" 120 (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\("
140 ruby-block-beg-re 121 ruby-block-beg-re
@@ -362,7 +343,7 @@ Also ignores spaces after parenthesis when 'space."
362 (back-to-indentation) 343 (back-to-indentation)
363 (current-column))) 344 (current-column)))
364 345
365(defun ruby-indent-line (&optional flag) 346(defun ruby-indent-line (&optional ignored)
366 "Correct the indentation of the current Ruby line." 347 "Correct the indentation of the current Ruby line."
367 (interactive) 348 (interactive)
368 (ruby-indent-to (ruby-calculate-indent))) 349 (ruby-indent-to (ruby-calculate-indent)))
@@ -405,8 +386,7 @@ and `\\' when preceded by `?'."
405 "TODO: document." 386 "TODO: document."
406 (save-excursion 387 (save-excursion
407 (store-match-data nil) 388 (store-match-data nil)
408 (let ((space (skip-chars-backward " \t")) 389 (let ((space (skip-chars-backward " \t")))
409 (start (point)))
410 (cond 390 (cond
411 ((bolp) t) 391 ((bolp) t)
412 ((progn 392 ((progn
@@ -700,7 +680,7 @@ and `\\' when preceded by `?'."
700 (beginning-of-line) 680 (beginning-of-line)
701 (let ((ruby-indent-point (point)) 681 (let ((ruby-indent-point (point))
702 (case-fold-search nil) 682 (case-fold-search nil)
703 state bol eol begin op-end 683 state eol begin op-end
704 (paren (progn (skip-syntax-forward " ") 684 (paren (progn (skip-syntax-forward " ")
705 (and (char-after) (matching-paren (char-after))))) 685 (and (char-after) (matching-paren (char-after)))))
706 (indent 0)) 686 (indent 0))
@@ -780,7 +760,6 @@ and `\\' when preceded by `?'."
780 (if (re-search-forward "^\\s *#" end t) 760 (if (re-search-forward "^\\s *#" end t)
781 (beginning-of-line) 761 (beginning-of-line)
782 (setq done t)))) 762 (setq done t))))
783 (setq bol (point))
784 (end-of-line) 763 (end-of-line)
785 ;; skip the comment at the end 764 ;; skip the comment at the end
786 (skip-chars-backward " \t") 765 (skip-chars-backward " \t")
@@ -1037,10 +1016,8 @@ With ARG, do it many times. Negative ARG means move forward."
1037 (ruby-beginning-of-defun) 1016 (ruby-beginning-of-defun)
1038 (re-search-backward "^\n" (- (point) 1) t)) 1017 (re-search-backward "^\n" (- (point) 1) t))
1039 1018
1040(defun ruby-indent-exp (&optional shutup-p) 1019(defun ruby-indent-exp (&optional ignored)
1041 "Indent each line in the balanced expression following the point. 1020 "Indent each line in the balanced expression following the point."
1042If a prefix arg is given or SHUTUP-P is non-nil, no errors
1043are signalled if a balanced expression isn't found."
1044 (interactive "*P") 1021 (interactive "*P")
1045 (let ((here (point-marker)) start top column (nest t)) 1022 (let ((here (point-marker)) start top column (nest t))
1046 (set-marker-insertion-type here t) 1023 (set-marker-insertion-type here t)
@@ -1133,58 +1110,208 @@ See `add-log-current-defun-function'."
1133 (if mlist (concat mlist mname) mname) 1110 (if mlist (concat mlist mname) mname)
1134 mlist))))) 1111 mlist)))))
1135 1112
1136(defconst ruby-font-lock-syntactic-keywords 1113(if (eval-when-compile (fboundp #'syntax-propertize-rules))
1137 `(;; #{ }, #$hoge, #@foo are not comments 1114 ;; New code that works independently from font-lock.
1138 ("\\(#\\)[{$@]" 1 (1 . nil)) 1115 (progn
1139 ;; the last $', $", $` in the respective string is not variable 1116 (defun ruby-syntax-propertize-function (start end)
1140 ;; the last ?', ?", ?` in the respective string is not ascii code 1117 "Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
1141 ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" 1118 (goto-char start)
1142 (2 (7 . nil)) 1119 (ruby-syntax-propertize-heredoc end)
1143 (4 (7 . nil))) 1120 (funcall
1144 ;; $' $" $` .... are variables 1121 (syntax-propertize-rules
1145 ;; ?' ?" ?` are ascii codes 1122 ;; #{ }, #$hoge, #@foo are not comments
1146 ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) 1123 ("\\(#\\)[{$@]" (1 "."))
1147 ;; regexps 1124 ;; the last $', $", $` in the respective string is not variable
1148 ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" 1125 ;; the last ?', ?", ?` in the respective string is not ascii code
1149 (4 (7 . ?/)) 1126 ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
1150 (6 (7 . ?/))) 1127 (2 "\"")
1151 ("^=en\\(d\\)\\_>" 1 "!") 1128 (4 "\""))
1152 ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) 1129 ;; $' $" $` .... are variables
1153 ;; Currently, the following case is highlighted incorrectly: 1130 ;; ?' ?" ?` are ascii codes
1154 ;; 1131 ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 "."))
1155 ;; <<FOO 1132 ;; regexps
1156 ;; FOO 1133 ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
1157 ;; <<BAR 1134 (4 "\"/")
1158 ;; <<BAZ 1135 (6 "\"/"))
1159 ;; BAZ 1136 ("^=en\\(d\\)\\_>" (1 "!"))
1160 ;; BAR 1137 ("^\\(=\\)begin\\_>" (1 "!"))
1161 ;; 1138 ;; Handle here documents.
1162 ;; This is because all here-doc beginnings are highlighted before any endings, 1139 ((concat ruby-here-doc-beg-re ".*\\(\n\\)")
1163 ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ 1140 (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))))
1164 ;; it thinks <<BAR is part of a string so it's marked as well. 1141 (point) end))
1165 ;; 1142
1166 ;; This may be fixable by modifying ruby-in-here-doc-p to use 1143 (defun ruby-syntax-propertize-heredoc (limit)
1167 ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, 1144 (let ((ppss (syntax-ppss))
1168 ;; but I don't want to try that until we've got unit tests set up 1145 (res '()))
1169 ;; to make sure I don't break anything else. 1146 (when (eq ?\n (nth 3 ppss))
1170 (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") 1147 (save-excursion
1171 ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) 1148 (goto-char (nth 8 ppss))
1172 (ruby-here-doc-beg-syntax)) 1149 (beginning-of-line)
1173 (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) 1150 (while (re-search-forward ruby-here-doc-beg-re
1174 "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") 1151 (line-end-position) t)
1175 1152 (push (concat (ruby-here-doc-end-match) "\n") res)))
1176(defun ruby-comment-beg-syntax () 1153 (let ((start (point)))
1177 "Return the syntax cell for a the first character of a =begin. 1154 ;; With multiple openers on the same line, we don't know in which
1155 ;; part `start' is, so we have to go back to the beginning.
1156 (when (cdr res)
1157 (goto-char (nth 8 ppss))
1158 (setq res (nreverse res)))
1159 (while (and res (re-search-forward (pop res) limit 'move))
1160 (if (null res)
1161 (put-text-property (1- (point)) (point)
1162 'syntax-table (string-to-syntax "\""))))
1163 ;; Make extra sure we don't move back, lest we could fall into an
1164 ;; inf-loop.
1165 (if (< (point) start) (goto-char start))))))
1166 )
1167
1168 ;; For Emacsen where syntax-propertize-rules is not (yet) available,
1169 ;; fallback on the old font-lock-syntactic-keywords stuff.
1170
1171 (defconst ruby-here-doc-end-re
1172 "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)"
1173 "Regexp to match the end of heredocs.
1174
1175This will actually match any line with one or more characters.
1176It's useful in that it divides up the match string so that
1177`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
1178
1179 (defun ruby-here-doc-beg-match ()
1180 "Return a regexp to find the beginning of a heredoc.
1181
1182This should only be called after matching against `ruby-here-doc-end-re'."
1183 (let ((contents (regexp-quote (match-string 2))))
1184 (concat "<<"
1185 (let ((match (match-string 1)))
1186 (if (and match (> (length match) 0))
1187 (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)"
1188 contents "\\b\\(\\1\\|\\2\\)")
1189 (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
1190
1191 (defconst ruby-font-lock-syntactic-keywords
1192 `( ;; #{ }, #$hoge, #@foo are not comments
1193 ("\\(#\\)[{$@]" 1 (1 . nil))
1194 ;; the last $', $", $` in the respective string is not variable
1195 ;; the last ?', ?", ?` in the respective string is not ascii code
1196 ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
1197 (2 (7 . nil))
1198 (4 (7 . nil)))
1199 ;; $' $" $` .... are variables
1200 ;; ?' ?" ?` are ascii codes
1201 ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
1202 ;; regexps
1203 ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
1204 (4 (7 . ?/))
1205 (6 (7 . ?/)))
1206 ("^=en\\(d\\)\\_>" 1 "!")
1207 ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
1208 ;; Currently, the following case is highlighted incorrectly:
1209 ;;
1210 ;; <<FOO
1211 ;; FOO
1212 ;; <<BAR
1213 ;; <<BAZ
1214 ;; BAZ
1215 ;; BAR
1216 ;;
1217 ;; This is because all here-doc beginnings are highlighted before any endings,
1218 ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
1219 ;; it thinks <<BAR is part of a string so it's marked as well.
1220 ;;
1221 ;; This may be fixable by modifying ruby-in-here-doc-p to use
1222 ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
1223 ;; but I don't want to try that until we've got unit tests set up
1224 ;; to make sure I don't break anything else.
1225 (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
1226 ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
1227 (ruby-here-doc-beg-syntax))
1228 (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
1229 "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
1230
1231 (defun ruby-comment-beg-syntax ()
1232 "Return the syntax cell for a the first character of a =begin.
1178See the definition of `ruby-font-lock-syntactic-keywords'. 1233See the definition of `ruby-font-lock-syntactic-keywords'.
1179 1234
1180This returns a comment-delimiter cell as long as the =begin 1235This returns a comment-delimiter cell as long as the =begin
1181isn't in a string or another comment." 1236isn't in a string or another comment."
1182 (when (not (nth 3 (syntax-ppss))) 1237 (when (not (nth 3 (syntax-ppss)))
1183 (string-to-syntax "!"))) 1238 (string-to-syntax "!")))
1239
1240 (defun ruby-in-here-doc-p ()
1241 "Return whether or not the point is in a heredoc."
1242 (save-excursion
1243 (let ((old-point (point)) (case-fold-search nil))
1244 (beginning-of-line)
1245 (catch 'found-beg
1246 (while (re-search-backward ruby-here-doc-beg-re nil t)
1247 (if (not (or (ruby-in-ppss-context-p 'anything)
1248 (ruby-here-doc-find-end old-point)))
1249 (throw 'found-beg t)))))))
1250
1251 (defun ruby-here-doc-find-end (&optional limit)
1252 "Expects the point to be on a line with one or more heredoc openers.
1253Returns the buffer position at which all heredocs on the line
1254are terminated, or nil if they aren't terminated before the
1255buffer position `limit' or the end of the buffer."
1256 (save-excursion
1257 (beginning-of-line)
1258 (catch 'done
1259 (let ((eol (save-excursion (end-of-line) (point)))
1260 (case-fold-search nil)
1261 ;; Fake match data such that (match-end 0) is at eol
1262 (end-match-data (progn (looking-at ".*$") (match-data)))
1263 beg-match-data end-re)
1264 (while (re-search-forward ruby-here-doc-beg-re eol t)
1265 (setq beg-match-data (match-data))
1266 (setq end-re (ruby-here-doc-end-match))
1267
1268 (set-match-data end-match-data)
1269 (goto-char (match-end 0))
1270 (unless (re-search-forward end-re limit t) (throw 'done nil))
1271 (setq end-match-data (match-data))
1272
1273 (set-match-data beg-match-data)
1274 (goto-char (match-end 0)))
1275 (set-match-data end-match-data)
1276 (goto-char (match-end 0))
1277 (point)))))
1278
1279 (defun ruby-here-doc-beg-syntax ()
1280 "Return the syntax cell for a line that may begin a heredoc.
1281See the definition of `ruby-font-lock-syntactic-keywords'.
1282
1283This sets the syntax cell for the newline ending the line
1284containing the heredoc beginning so that cases where multiple
1285heredocs are started on one line are handled correctly."
1286 (save-excursion
1287 (goto-char (match-beginning 0))
1288 (unless (or (ruby-in-ppss-context-p 'non-heredoc)
1289 (ruby-in-here-doc-p))
1290 (string-to-syntax "\""))))
1291
1292 (defun ruby-here-doc-end-syntax ()
1293 "Return the syntax cell for a line that may end a heredoc.
1294See the definition of `ruby-font-lock-syntactic-keywords'."
1295 (let ((pss (syntax-ppss)) (case-fold-search nil))
1296 ;; If we aren't in a string, we definitely aren't ending a heredoc,
1297 ;; so we can just give up.
1298 ;; This means we aren't doing a full-document search
1299 ;; every time we enter a character.
1300 (when (ruby-in-ppss-context-p 'heredoc pss)
1301 (save-excursion
1302 (goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
1303 (let ((eol (point)))
1304 (beginning-of-line)
1305 (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
1306 (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
1307 (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
1308 (not (re-search-forward ruby-here-doc-beg-re eol t))))
1309 (string-to-syntax "\"")))))))
1184 1310
1185(unless (functionp 'syntax-ppss) 1311 (unless (functionp 'syntax-ppss)
1186 (defun syntax-ppss (&optional pos) 1312 (defun syntax-ppss (&optional pos)
1187 (parse-partial-sexp (point-min) (or pos (point))))) 1313 (parse-partial-sexp (point-min) (or pos (point)))))
1314 )
1188 1315
1189(defun ruby-in-ppss-context-p (context &optional ppss) 1316(defun ruby-in-ppss-context-p (context &optional ppss)
1190 (let ((ppss (or ppss (syntax-ppss (point))))) 1317 (let ((ppss (or ppss (syntax-ppss (point)))))
@@ -1195,10 +1322,7 @@ isn't in a string or another comment."
1195 ((eq context 'string) 1322 ((eq context 'string)
1196 (nth 3 ppss)) 1323 (nth 3 ppss))
1197 ((eq context 'heredoc) 1324 ((eq context 'heredoc)
1198 (and (nth 3 ppss) 1325 (eq ?\n (nth 3 ppss)))
1199 ;; If it's generic string, it's a heredoc and we don't care
1200 ;; See `parse-partial-sexp'
1201 (not (numberp (nth 3 ppss)))))
1202 ((eq context 'non-heredoc) 1326 ((eq context 'non-heredoc)
1203 (and (ruby-in-ppss-context-p 'anything) 1327 (and (ruby-in-ppss-context-p 'anything)
1204 (not (ruby-in-ppss-context-p 'heredoc)))) 1328 (not (ruby-in-ppss-context-p 'heredoc))))
@@ -1210,77 +1334,6 @@ isn't in a string or another comment."
1210 "context name `" (symbol-name context) "' is unknown")))) 1334 "context name `" (symbol-name context) "' is unknown"))))
1211 t))) 1335 t)))
1212 1336
1213(defun ruby-in-here-doc-p ()
1214 "Return whether or not the point is in a heredoc."
1215 (save-excursion
1216 (let ((old-point (point)) (case-fold-search nil))
1217 (beginning-of-line)
1218 (catch 'found-beg
1219 (while (re-search-backward ruby-here-doc-beg-re nil t)
1220 (if (not (or (ruby-in-ppss-context-p 'anything)
1221 (ruby-here-doc-find-end old-point)))
1222 (throw 'found-beg t)))))))
1223
1224(defun ruby-here-doc-find-end (&optional limit)
1225 "Expects the point to be on a line with one or more heredoc openers.
1226Returns the buffer position at which all heredocs on the line
1227are terminated, or nil if they aren't terminated before the
1228buffer position `limit' or the end of the buffer."
1229 (save-excursion
1230 (beginning-of-line)
1231 (catch 'done
1232 (let ((eol (save-excursion (end-of-line) (point)))
1233 (case-fold-search nil)
1234 ;; Fake match data such that (match-end 0) is at eol
1235 (end-match-data (progn (looking-at ".*$") (match-data)))
1236 beg-match-data end-re)
1237 (while (re-search-forward ruby-here-doc-beg-re eol t)
1238 (setq beg-match-data (match-data))
1239 (setq end-re (ruby-here-doc-end-match))
1240
1241 (set-match-data end-match-data)
1242 (goto-char (match-end 0))
1243 (unless (re-search-forward end-re limit t) (throw 'done nil))
1244 (setq end-match-data (match-data))
1245
1246 (set-match-data beg-match-data)
1247 (goto-char (match-end 0)))
1248 (set-match-data end-match-data)
1249 (goto-char (match-end 0))
1250 (point)))))
1251
1252(defun ruby-here-doc-beg-syntax ()
1253 "Return the syntax cell for a line that may begin a heredoc.
1254See the definition of `ruby-font-lock-syntactic-keywords'.
1255
1256This sets the syntax cell for the newline ending the line
1257containing the heredoc beginning so that cases where multiple
1258heredocs are started on one line are handled correctly."
1259 (save-excursion
1260 (goto-char (match-beginning 0))
1261 (unless (or (ruby-in-ppss-context-p 'non-heredoc)
1262 (ruby-in-here-doc-p))
1263 (string-to-syntax "|"))))
1264
1265(defun ruby-here-doc-end-syntax ()
1266 "Return the syntax cell for a line that may end a heredoc.
1267See the definition of `ruby-font-lock-syntactic-keywords'."
1268 (let ((pss (syntax-ppss)) (case-fold-search nil))
1269 ;; If we aren't in a string, we definitely aren't ending a heredoc,
1270 ;; so we can just give up.
1271 ;; This means we aren't doing a full-document search
1272 ;; every time we enter a character.
1273 (when (ruby-in-ppss-context-p 'heredoc pss)
1274 (save-excursion
1275 (goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
1276 (let ((eol (point)))
1277 (beginning-of-line)
1278 (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
1279 (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
1280 (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
1281 (not (re-search-forward ruby-here-doc-beg-re eol t))))
1282 (string-to-syntax "|")))))))
1283
1284(if (featurep 'xemacs) 1337(if (featurep 'xemacs)
1285 (put 'ruby-mode 'font-lock-defaults 1338 (put 'ruby-mode 'font-lock-defaults
1286 '((ruby-font-lock-keywords) 1339 '((ruby-font-lock-keywords)
@@ -1377,8 +1430,10 @@ See `font-lock-syntax-table'.")
1377 ) 1430 )
1378 "Additional expressions to highlight in Ruby mode.") 1431 "Additional expressions to highlight in Ruby mode.")
1379 1432
1433(defvar electric-indent-chars)
1434
1380;;;###autoload 1435;;;###autoload
1381(defun ruby-mode () 1436(define-derived-mode ruby-mode prog-mode "Ruby"
1382 "Major mode for editing Ruby scripts. 1437 "Major mode for editing Ruby scripts.
1383\\[ruby-indent-line] properly indents subexpressions of multi-line 1438\\[ruby-indent-line] properly indents subexpressions of multi-line
1384class, module, def, if, while, for, do, and case statements, taking 1439class, module, def, if, while, for, do, and case statements, taking
@@ -1387,27 +1442,22 @@ nesting into account.
1387The variable `ruby-indent-level' controls the amount of indentation. 1442The variable `ruby-indent-level' controls the amount of indentation.
1388 1443
1389\\{ruby-mode-map}" 1444\\{ruby-mode-map}"
1390 (interactive)
1391 (kill-all-local-variables)
1392 (use-local-map ruby-mode-map)
1393 (setq mode-name "Ruby")
1394 (setq major-mode 'ruby-mode)
1395 (ruby-mode-variables) 1445 (ruby-mode-variables)
1396 1446
1397 (set (make-local-variable 'indent-line-function)
1398 'ruby-indent-line)
1399 (set (make-local-variable 'imenu-create-index-function) 1447 (set (make-local-variable 'imenu-create-index-function)
1400 'ruby-imenu-create-index) 1448 'ruby-imenu-create-index)
1401 (set (make-local-variable 'add-log-current-defun-function) 1449 (set (make-local-variable 'add-log-current-defun-function)
1402 'ruby-add-log-current-method) 1450 'ruby-add-log-current-method)
1403 1451
1404 (add-hook 1452 (add-hook
1405 (cond ((boundp 'before-save-hook) 1453 (cond ((boundp 'before-save-hook) 'before-save-hook)
1406 (make-local-variable 'before-save-hook)
1407 'before-save-hook)
1408 ((boundp 'write-contents-functions) 'write-contents-functions) 1454 ((boundp 'write-contents-functions) 'write-contents-functions)
1409 ((boundp 'write-contents-hooks) 'write-contents-hooks)) 1455 ((boundp 'write-contents-hooks) 'write-contents-hooks))
1410 'ruby-mode-set-encoding) 1456 'ruby-mode-set-encoding nil 'local)
1457
1458 (set (make-local-variable 'electric-indent-chars)
1459 (append '(?\{ ?\}) (if (boundp 'electric-indent-chars)
1460 (default-value 'electric-indent-chars))))
1411 1461
1412 (set (make-local-variable 'font-lock-defaults) 1462 (set (make-local-variable 'font-lock-defaults)
1413 '((ruby-font-lock-keywords) nil nil)) 1463 '((ruby-font-lock-keywords) nil nil))
@@ -1415,12 +1465,12 @@ The variable `ruby-indent-level' controls the amount of indentation.
1415 ruby-font-lock-keywords) 1465 ruby-font-lock-keywords)
1416 (set (make-local-variable 'font-lock-syntax-table) 1466 (set (make-local-variable 'font-lock-syntax-table)
1417 ruby-font-lock-syntax-table) 1467 ruby-font-lock-syntax-table)
1418 (set (make-local-variable 'font-lock-syntactic-keywords)
1419 ruby-font-lock-syntactic-keywords)
1420 1468
1421 (if (fboundp 'run-mode-hooks) 1469 (if (eval-when-compile (fboundp 'syntax-propertize-rules))
1422 (run-mode-hooks 'ruby-mode-hook) 1470 (set (make-local-variable 'syntax-propertize-function)
1423 (run-hooks 'ruby-mode-hook))) 1471 #'ruby-syntax-propertize-function)
1472 (set (make-local-variable 'font-lock-syntactic-keywords)
1473 ruby-font-lock-syntactic-keywords)))
1424 1474
1425;;; Invoke ruby-mode when appropriate 1475;;; Invoke ruby-mode when appropriate
1426 1476
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 9041bd50259..d41a81e38a6 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -939,7 +939,6 @@ See `sh-feature'.")
939;; These are used for the syntax table stuff (derived from cperl-mode). 939;; These are used for the syntax table stuff (derived from cperl-mode).
940;; Note: parse-sexp-lookup-properties must be set to t for it to work. 940;; Note: parse-sexp-lookup-properties must be set to t for it to work.
941(defconst sh-st-punc (string-to-syntax ".")) 941(defconst sh-st-punc (string-to-syntax "."))
942(defconst sh-st-symbol (string-to-syntax "_"))
943(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string 942(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
944 943
945(defconst sh-escaped-line-re 944(defconst sh-escaped-line-re
@@ -957,7 +956,7 @@ See `sh-feature'.")
957(defvar sh-here-doc-re sh-here-doc-open-re) 956(defvar sh-here-doc-re sh-here-doc-open-re)
958(make-variable-buffer-local 'sh-here-doc-re) 957(make-variable-buffer-local 'sh-here-doc-re)
959 958
960(defun sh-font-lock-close-heredoc (bol eof indented) 959(defun sh-font-lock-close-heredoc (bol eof indented eol)
961 "Determine the syntax of the \\n after an EOF. 960 "Determine the syntax of the \\n after an EOF.
962If non-nil INDENTED indicates that the EOF was indented." 961If non-nil INDENTED indicates that the EOF was indented."
963 (let* ((eof-re (if eof (regexp-quote eof) "")) 962 (let* ((eof-re (if eof (regexp-quote eof) ""))
@@ -971,6 +970,8 @@ If non-nil INDENTED indicates that the EOF was indented."
971 (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) 970 (ere (concat "^" (if indented "[ \t]*") eof-re "\n"))
972 (start (save-excursion 971 (start (save-excursion
973 (goto-char bol) 972 (goto-char bol)
973 ;; FIXME: will incorrectly find a <<EOF embedded inside
974 ;; the heredoc.
974 (re-search-backward (concat sre "\\|" ere) nil t)))) 975 (re-search-backward (concat sre "\\|" ere) nil t))))
975 ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first 976 ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first
976 ;; found a close-heredoc which makes the current close-heredoc inoperant. 977 ;; found a close-heredoc which makes the current close-heredoc inoperant.
@@ -990,7 +991,7 @@ If non-nil INDENTED indicates that the EOF was indented."
990 (sh-in-comment-or-string (point))))) 991 (sh-in-comment-or-string (point)))))
991 ;; No <<EOF2 found after our <<. 992 ;; No <<EOF2 found after our <<.
992 (= (point) start))) 993 (= (point) start)))
993 sh-here-doc-syntax) 994 (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))
994 ((not (or start (save-excursion (re-search-forward sre nil t)))) 995 ((not (or start (save-excursion (re-search-forward sre nil t))))
995 ;; There's no <<EOF either before or after us, 996 ;; There's no <<EOF either before or after us,
996 ;; so we should remove ourselves from font-lock's keywords. 997 ;; so we should remove ourselves from font-lock's keywords.
@@ -1000,7 +1001,7 @@ If non-nil INDENTED indicates that the EOF was indented."
1000 (regexp-opt sh-here-doc-markers t) "\\(\n\\)")) 1001 (regexp-opt sh-here-doc-markers t) "\\(\n\\)"))
1001 nil)))) 1002 nil))))
1002 1003
1003(defun sh-font-lock-open-heredoc (start string) 1004(defun sh-font-lock-open-heredoc (start string eol)
1004 "Determine the syntax of the \\n after a <<EOF. 1005 "Determine the syntax of the \\n after a <<EOF.
1005START is the position of <<. 1006START is the position of <<.
1006STRING is the actual word used as delimiter (e.g. \"EOF\"). 1007STRING is the actual word used as delimiter (e.g. \"EOF\").
@@ -1030,13 +1031,8 @@ Point is at the beginning of the next line."
1030 ;; Don't bother fixing it now, but place a multiline property so 1031 ;; Don't bother fixing it now, but place a multiline property so
1031 ;; that when jit-lock-context-* refontifies the rest of the 1032 ;; that when jit-lock-context-* refontifies the rest of the
1032 ;; buffer, it also refontifies the current line with it. 1033 ;; buffer, it also refontifies the current line with it.
1033 (put-text-property start (point) 'font-lock-multiline t))) 1034 (put-text-property start (point) 'syntax-multiline t)))
1034 sh-here-doc-syntax)) 1035 (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)))
1035
1036(defun sh-font-lock-here-doc (limit)
1037 "Search for a heredoc marker."
1038 ;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
1039 (re-search-forward sh-here-doc-re limit t))
1040 1036
1041(defun sh-font-lock-quoted-subshell (limit) 1037(defun sh-font-lock-quoted-subshell (limit)
1042 "Search for a subshell embedded in a string. 1038 "Search for a subshell embedded in a string.
@@ -1045,9 +1041,7 @@ subshells can nest."
1045 ;; FIXME: This can (and often does) match multiple lines, yet it makes no 1041 ;; FIXME: This can (and often does) match multiple lines, yet it makes no
1046 ;; effort to handle multiline cases correctly, so it ends up being 1042 ;; effort to handle multiline cases correctly, so it ends up being
1047 ;; rather flakey. 1043 ;; rather flakey.
1048 (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) 1044 (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote.
1049 ;; Make sure the " we matched is an opening quote.
1050 (eq ?\" (nth 3 (syntax-ppss))))
1051 ;; bingo we have a $( or a ` inside a "" 1045 ;; bingo we have a $( or a ` inside a ""
1052 (let ((char (char-after (point))) 1046 (let ((char (char-after (point)))
1053 ;; `state' can be: double-quote, backquote, code. 1047 ;; `state' can be: double-quote, backquote, code.
@@ -1082,8 +1076,7 @@ subshells can nest."
1082 (double-quote nil) 1076 (double-quote nil)
1083 (t (setq state (pop states))))) 1077 (t (setq state (pop states)))))
1084 (t (error "Internal error in sh-font-lock-quoted-subshell"))) 1078 (t (error "Internal error in sh-font-lock-quoted-subshell")))
1085 (forward-char 1))) 1079 (forward-char 1)))))
1086 t))
1087 1080
1088 1081
1089(defun sh-is-quoted-p (pos) 1082(defun sh-is-quoted-p (pos)
@@ -1122,7 +1115,7 @@ subshells can nest."
1122 (when (progn (backward-char 2) 1115 (when (progn (backward-char 2)
1123 (if (> start (line-end-position)) 1116 (if (> start (line-end-position))
1124 (put-text-property (point) (1+ start) 1117 (put-text-property (point) (1+ start)
1125 'font-lock-multiline t)) 1118 'syntax-multiline t))
1126 ;; FIXME: The `in' may just be a random argument to 1119 ;; FIXME: The `in' may just be a random argument to
1127 ;; a normal command rather than the real `in' keyword. 1120 ;; a normal command rather than the real `in' keyword.
1128 ;; I.e. we should look back to try and find the 1121 ;; I.e. we should look back to try and find the
@@ -1136,40 +1129,44 @@ subshells can nest."
1136 sh-st-punc 1129 sh-st-punc
1137 nil)) 1130 nil))
1138 1131
1139(defun sh-font-lock-flush-syntax-ppss-cache (limit) 1132(defun sh-syntax-propertize-function (start end)
1140 ;; This should probably be a standard function provided by font-lock.el 1133 (goto-char start)
1141 ;; (or syntax.el). 1134 (while (prog1
1142 (syntax-ppss-flush-cache (point)) 1135 (re-search-forward sh-here-doc-re end 'move)
1143 (goto-char limit) 1136 (save-excursion
1144 nil) 1137 (save-match-data
1145 1138 (funcall
1146(defconst sh-font-lock-syntactic-keywords 1139 (syntax-propertize-rules
1147 ;; A `#' begins a comment when it is unquoted and at the beginning of a 1140 ;; A `#' begins a comment when it is unquoted and at the
1148 ;; word. In the shell, words are separated by metacharacters. 1141 ;; beginning of a word. In the shell, words are separated by
1149 ;; The list of special chars is taken from the single-unix spec 1142 ;; metacharacters. The list of special chars is taken from
1150 ;; of the shell command language (under `quoting') but with `$' removed. 1143 ;; the single-unix spec of the shell command language (under
1151 `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) 1144 ;; `quoting') but with `$' removed.
1152 ;; In a '...' the backslash is not escaping. 1145 ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
1153 ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) 1146 ;; In a '...' the backslash is not escaping.
1154 ;; The previous rule uses syntax-ppss, but the subsequent rules may 1147 ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
1155 ;; change the syntax, so we have to tell syntax-ppss that the states it 1148 ;; Make sure $@ and $? are correctly recognized as sexps.
1156 ;; has just computed will need to be recomputed. 1149 ("\\$\\([?@]\\)" (1 "_"))
1157 (sh-font-lock-flush-syntax-ppss-cache) 1150 ;; Distinguish the special close-paren in `case'.
1158 ;; Make sure $@ and $? are correctly recognized as sexps. 1151 (")" (0 (sh-font-lock-paren (match-beginning 0))))
1159 ("\\$\\([?@]\\)" 1 ,sh-st-symbol) 1152 ;; Highlight (possibly nested) subshells inside "" quoted
1160 ;; Find HEREDOC starters and add a corresponding rule for the ender. 1153 ;; regions correctly.
1161 (sh-font-lock-here-doc 1154 ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)"
1162 (2 (sh-font-lock-open-heredoc 1155 (1 (ignore
1163 (match-beginning 0) (match-string 1)) nil t) 1156 ;; Save excursion because we want to also apply other
1164 (5 (sh-font-lock-close-heredoc 1157 ;; syntax-propertize rules within the affected region.
1165 (match-beginning 0) (match-string 4) 1158 (save-excursion
1166 (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) 1159 (sh-font-lock-quoted-subshell end))))))
1167 nil t)) 1160 (prog1 start (setq start (point))) (point)))))
1168 ;; Distinguish the special close-paren in `case'. 1161 (if (match-beginning 2)
1169 (")" 0 (sh-font-lock-paren (match-beginning 0))) 1162 ;; FIXME: actually, once we see an heredoc opener, we should just
1170 ;; highlight (possibly nested) subshells inside "" quoted regions correctly. 1163 ;; search for its ender without propertizing anything in it.
1171 ;; This should be at the very end because it uses syntax-ppss. 1164 (sh-font-lock-open-heredoc
1172 (sh-font-lock-quoted-subshell))) 1165 (match-beginning 0) (match-string 1) (match-beginning 2))
1166 (sh-font-lock-close-heredoc
1167 (match-beginning 0) (match-string 4)
1168 (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))
1169 (match-beginning 5)))))
1173 1170
1174(defun sh-font-lock-syntactic-face-function (state) 1171(defun sh-font-lock-syntactic-face-function (state)
1175 (let ((q (nth 3 state))) 1172 (let ((q (nth 3 state)))
@@ -1553,9 +1550,12 @@ with your script for an edit-interpret-debug cycle."
1553 sh-font-lock-keywords-1 sh-font-lock-keywords-2) 1550 sh-font-lock-keywords-1 sh-font-lock-keywords-2)
1554 nil nil 1551 nil nil
1555 ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil 1552 ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
1556 (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)
1557 (font-lock-syntactic-face-function 1553 (font-lock-syntactic-face-function
1558 . sh-font-lock-syntactic-face-function))) 1554 . sh-font-lock-syntactic-face-function)))
1555 (set (make-local-variable 'syntax-propertize-function)
1556 #'sh-syntax-propertize-function)
1557 (add-hook 'syntax-propertize-extend-region-functions
1558 #'syntax-propertize-multiline 'append 'local)
1559 (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`))) 1559 (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
1560 (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p) 1560 (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
1561 (set (make-local-variable 'skeleton-further-elements) 1561 (set (make-local-variable 'skeleton-further-elements)
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index f8d1a6aca97..34c50b6cfe5 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -163,17 +163,18 @@ for SIMULA mode to function correctly."
163(defvar simula-mode-syntax-table nil 163(defvar simula-mode-syntax-table nil
164 "Syntax table in SIMULA mode buffers.") 164 "Syntax table in SIMULA mode buffers.")
165 165
166(defconst simula-font-lock-syntactic-keywords 166(defconst simula-syntax-propertize-function
167 `(;; `comment' directive. 167 (syntax-propertize-rules
168 ("\\<\\(c\\)omment\\>" 1 "<") 168 ;; `comment' directive.
169 ;; end comments 169 ("\\<\\(c\\)omment\\>" (1 "<"))
170 (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" 170 ;; end comments
171 (regexp-opt '("end" "else" "when" "otherwise")) 171 ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
172 "\\)\\)") 172 (regexp-opt '("end" "else" "when" "otherwise"))
173 (1 "< b") 173 "\\)\\)")
174 (3 "> b" nil t)) 174 (1 "< b")
175 ;; non-quoted single-quote char. 175 (3 "> b"))
176 ("'\\('\\)'" 1 "."))) 176 ;; non-quoted single-quote char.
177 ("'\\('\\)'" (1 "."))))
177 178
178;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>. 179;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
179(defconst simula-font-lock-keywords-1 180(defconst simula-font-lock-keywords-1
@@ -396,8 +397,9 @@ with no arguments, if that value is non-nil."
396 (setq font-lock-defaults 397 (setq font-lock-defaults
397 '((simula-font-lock-keywords simula-font-lock-keywords-1 398 '((simula-font-lock-keywords simula-font-lock-keywords-1
398 simula-font-lock-keywords-2 simula-font-lock-keywords-3) 399 simula-font-lock-keywords-2 simula-font-lock-keywords-3)
399 nil t ((?_ . "w")) nil 400 nil t ((?_ . "w"))))
400 (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords))) 401 (set (make-local-variable 'syntax-propertize-function)
402 simula-syntax-propertize-function)
401 (abbrev-mode 1)) 403 (abbrev-mode 1))
402 404
403(defun simula-indent-exp () 405(defun simula-indent-exp ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index e44504688f2..e9860c5fa71 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -5,7 +5,7 @@
5 5
6;; Author: Alex Schroeder <alex@gnu.org> 6;; Author: Alex Schroeder <alex@gnu.org>
7;; Maintainer: Michael Mauger <mmaug@yahoo.com> 7;; Maintainer: Michael Mauger <mmaug@yahoo.com>
8;; Version: 2.5 8;; Version: 2.7
9;; Keywords: comm languages processes 9;; Keywords: comm languages processes
10;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el 10;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
11;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode 11;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
@@ -187,10 +187,10 @@
187 187
188;; 6) Define a convienence function to invoke the SQL interpreter. 188;; 6) Define a convienence function to invoke the SQL interpreter.
189 189
190;; (defun my-sql-xyz () 190;; (defun my-sql-xyz (&optional buffer)
191;; "Run ixyz by XyzDB as an inferior process." 191;; "Run ixyz by XyzDB as an inferior process."
192;; (interactive) 192;; (interactive "P")
193;; (sql-product-interactive 'xyz)) 193;; (sql-product-interactive 'xyz buffer))
194 194
195;;; To Do: 195;;; To Do:
196 196
@@ -275,8 +275,8 @@ Customizing your password will store it in your ~/.emacs file."
275 :group 'SQL 275 :group 'SQL
276 :safe 'stringp) 276 :safe 'stringp)
277 277
278(defcustom sql-port nil 278(defcustom sql-port 0
279 "Default server or host." 279 "Default port."
280 :version "24.1" 280 :version "24.1"
281 :type 'number 281 :type 'number
282 :group 'SQL 282 :group 'SQL
@@ -430,9 +430,9 @@ Customizing your password will store it in your ~/.emacs file."
430 :sqli-comint-func sql-comint-postgres 430 :sqli-comint-func sql-comint-postgres
431 :prompt-regexp "^.*=[#>] " 431 :prompt-regexp "^.*=[#>] "
432 :prompt-length 5 432 :prompt-length 5
433 :prompt-cont-regexp "^.*-[#>] " 433 :prompt-cont-regexp "^.*[-(][#>] "
434 :input-filter sql-remove-tabs-filter 434 :input-filter sql-remove-tabs-filter
435 :terminator ("\\(^[\\]g\\|;\\)" . ";")) 435 :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
436 436
437 (solid 437 (solid
438 :name "Solid" 438 :name "Solid"
@@ -551,7 +551,6 @@ settings.")
551(defvar sql-indirect-features 551(defvar sql-indirect-features
552 '(:font-lock :sqli-program :sqli-options :sqli-login)) 552 '(:font-lock :sqli-program :sqli-options :sqli-login))
553 553
554;;;###autoload
555(defcustom sql-connection-alist nil 554(defcustom sql-connection-alist nil
556 "An alist of connection parameters for interacting with a SQL 555 "An alist of connection parameters for interacting with a SQL
557 product. 556 product.
@@ -600,7 +599,6 @@ prompted for during login."
600 :version "24.1" 599 :version "24.1"
601 :group 'SQL) 600 :group 'SQL)
602 601
603;;;###autoload
604(defcustom sql-product 'ansi 602(defcustom sql-product 'ansi
605 "Select the SQL database product used so that buffers can be 603 "Select the SQL database product used so that buffers can be
606highlighted properly when you open them." 604highlighted properly when you open them."
@@ -613,6 +611,7 @@ highlighted properly when you open them."
613 sql-product-alist)) 611 sql-product-alist))
614 :group 'SQL 612 :group 'SQL
615 :safe 'symbolp) 613 :safe 'symbolp)
614(defvaralias 'sql-dialect 'sql-product)
616 615
617;; misc customization of sql.el behaviour 616;; misc customization of sql.el behaviour
618 617
@@ -788,7 +787,9 @@ to be safe:
788 787
789;; Customization for SQLite 788;; Customization for SQLite
790 789
791(defcustom sql-sqlite-program "sqlite3" 790(defcustom sql-sqlite-program (or (executable-find "sqlite3")
791 (executable-find "sqlite")
792 "sqlite")
792 "Command to start SQLite. 793 "Command to start SQLite.
793 794
794Starts `sql-interactive-mode' after doing some setup." 795Starts `sql-interactive-mode' after doing some setup."
@@ -801,7 +802,7 @@ Starts `sql-interactive-mode' after doing some setup."
801 :version "20.8" 802 :version "20.8"
802 :group 'SQL) 803 :group 'SQL)
803 804
804(defcustom sql-sqlite-login-params '((database :file ".*\\.db")) 805(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)"))
805 "List of login parameters needed to connect to SQLite." 806 "List of login parameters needed to connect to SQLite."
806 :type 'sql-login-params 807 :type 'sql-login-params
807 :version "24.1" 808 :version "24.1"
@@ -1022,9 +1023,6 @@ Starts `sql-interactive-mode' after doing some setup."
1022(defvar sql-server-history nil 1023(defvar sql-server-history nil
1023 "History of servers used.") 1024 "History of servers used.")
1024 1025
1025(defvar sql-port-history nil
1026 "History of ports used.")
1027
1028;; Passwords are not kept in a history. 1026;; Passwords are not kept in a history.
1029 1027
1030(defvar sql-buffer nil 1028(defvar sql-buffer nil
@@ -1054,6 +1052,25 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
1054 1052
1055Used by `sql-rename-buffer'.") 1053Used by `sql-rename-buffer'.")
1056 1054
1055(defun sql-buffer-live-p (buffer &optional product)
1056 "Returns non-nil if the process associated with buffer is live.
1057
1058BUFFER can be a buffer object or a buffer name. The buffer must
1059be a live buffer, have an running process attached to it, be in
1060`sql-interactive-mode', and, if PRODUCT is specified, it's
1061`sql-product' must match."
1062
1063 (when buffer
1064 (setq buffer (get-buffer buffer))
1065 (and buffer
1066 (buffer-live-p buffer)
1067 (get-buffer-process buffer)
1068 (comint-check-proc buffer)
1069 (with-current-buffer buffer
1070 (and (derived-mode-p 'sql-product-interactive)
1071 (or (not product)
1072 (eq product sql-product)))))))
1073
1057;; Keymap for sql-interactive-mode. 1074;; Keymap for sql-interactive-mode.
1058 1075
1059(defvar sql-interactive-mode-map 1076(defvar sql-interactive-mode-map
@@ -1091,15 +1108,11 @@ Based on `comint-mode-map'.")
1091 sql-mode-menu sql-mode-map 1108 sql-mode-menu sql-mode-map
1092 "Menu for `sql-mode'." 1109 "Menu for `sql-mode'."
1093 `("SQL" 1110 `("SQL"
1094 ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer) 1111 ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)]
1095 (get-buffer-process sql-buffer))]
1096 ["Send Region" sql-send-region (and mark-active 1112 ["Send Region" sql-send-region (and mark-active
1097 (buffer-live-p sql-buffer) 1113 (sql-buffer-live-p sql-buffer))]
1098 (get-buffer-process sql-buffer))] 1114 ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
1099 ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer) 1115 ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
1100 (get-buffer-process sql-buffer))]
1101 ["Send String" sql-send-string (and (buffer-live-p sql-buffer)
1102 (get-buffer-process sql-buffer))]
1103 "--" 1116 "--"
1104 ["Start SQLi session" sql-product-interactive 1117 ["Start SQLi session" sql-product-interactive
1105 :visible (not sql-connection-alist) 1118 :visible (not sql-connection-alist)
@@ -1364,7 +1377,7 @@ to add functions and PL/SQL keywords.")
1364 ;; Oracle SQL*Plus Commands 1377 ;; Oracle SQL*Plus Commands
1365 (cons 1378 (cons
1366 (concat 1379 (concat
1367 "^\\(?:\\(?:" (regexp-opt '( 1380 "^\\s-*\\(?:\\(?:" (regexp-opt '(
1368"@" "@@" "accept" "append" "archive" "attribute" "break" 1381"@" "@@" "accept" "append" "archive" "attribute" "break"
1369"btitle" "change" "clear" "column" "connect" "copy" "define" 1382"btitle" "change" "clear" "column" "connect" "copy" "define"
1370"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" 1383"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
@@ -1403,7 +1416,7 @@ to add functions and PL/SQL keywords.")
1403 "\\)\\b.*" 1416 "\\)\\b.*"
1404 ) 1417 )
1405 'font-lock-doc-face) 1418 'font-lock-doc-face)
1406 '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face) 1419 '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
1407 1420
1408 ;; Oracle Functions 1421 ;; Oracle Functions
1409 (sql-font-lock-keywords-builder 'font-lock-builtin-face nil 1422 (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
@@ -1585,81 +1598,153 @@ to add functions and PL/SQL keywords.")
1585(defvar sql-mode-postgres-font-lock-keywords 1598(defvar sql-mode-postgres-font-lock-keywords
1586 (eval-when-compile 1599 (eval-when-compile
1587 (list 1600 (list
1588 ;; Postgres Functions 1601 ;; Postgres psql commands
1602 '("^\\s-*\\\\.*$" . font-lock-doc-face)
1603
1604 ;; Postgres unreserved words but may have meaning
1605 (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a"
1606"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg"
1607"asensitive" "atomic" "attribute" "attributes" "avg" "base64"
1608"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c"
1609"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length"
1610"character_length" "character_set_catalog" "character_set_name"
1611"character_set_schema" "characters" "checked" "class_origin" "clob"
1612"cobol" "collation" "collation_catalog" "collation_name"
1613"collation_schema" "collect" "column_name" "columns"
1614"command_function" "command_function_code" "completion" "condition"
1615"condition_number" "connect" "connection_name" "constraint_catalog"
1616"constraint_name" "constraint_schema" "constructor" "contains"
1617"control" "convert" "corr" "corresponding" "count" "covar_pop"
1618"covar_samp" "cube" "cume_dist" "current_default_transform_group"
1619"current_path" "current_transform_group_for_type" "cursor_name"
1620"datalink" "datetime_interval_code" "datetime_interval_precision" "db"
1621"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe"
1622"descriptor" "destroy" "destructor" "deterministic" "diagnostics"
1623"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete"
1624"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly"
1625"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic"
1626"dynamic_function" "dynamic_function_code" "element" "empty"
1627"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file"
1628"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free"
1629"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping"
1630"hex" "hierarchy" "host" "id" "ignore" "implementation" "import"
1631"indent" "indicator" "infix" "initialize" "instance" "instantiable"
1632"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag"
1633"last_value" "lateral" "lead" "length" "less" "library" "like_regex"
1634"link" "ln" "locator" "lower" "m" "map" "matched" "max"
1635"max_cardinality" "member" "merge" "message_length"
1636"message_octet_length" "message_text" "method" "min" "mod" "modifies"
1637"modify" "module" "more" "multiset" "mumps" "namespace" "nclob"
1638"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize"
1639"normalized" "nth_value" "ntile" "nullable" "number"
1640"occurrences_regex" "octet_length" "octets" "old" "open" "operation"
1641"ordering" "ordinality" "others" "output" "overriding" "p" "pad"
1642"parameter" "parameter_mode" "parameter_name"
1643"parameter_ordinal_position" "parameter_specific_catalog"
1644"parameter_specific_name" "parameter_specific_schema" "parameters"
1645"pascal" "passing" "passthrough" "percent_rank" "percentile_cont"
1646"percentile_disc" "permission" "pli" "position_regex" "postfix"
1647"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref"
1648"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept"
1649"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring"
1650"respect" "restore" "result" "return" "returned_cardinality"
1651"returned_length" "returned_octet_length" "returned_sqlstate" "rollup"
1652"routine" "routine_catalog" "routine_name" "routine_schema"
1653"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog"
1654"scope_name" "scope_schema" "section" "selective" "self" "sensitive"
1655"server_name" "sets" "size" "source" "space" "specific"
1656"specific_name" "specifictype" "sql" "sqlcode" "sqlerror"
1657"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static"
1658"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin"
1659"sublist" "submultiset" "substring_regex" "sum" "system_user" "t"
1660"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour"
1661"timezone_minute" "token" "top_level_count" "transaction_active"
1662"transactions_committed" "transactions_rolled_back" "transform"
1663"transforms" "translate" "translate_regex" "translation"
1664"trigger_catalog" "trigger_name" "trigger_schema" "trim_array"
1665"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri"
1666"usage" "user_defined_type_catalog" "user_defined_type_code"
1667"user_defined_type_name" "user_defined_type_schema" "var_pop"
1668"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within"
1669"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration"
1670"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery"
1671"xmlschema" "xmltable" "xmltext" "xmlvalidate"
1672)
1673
1674 ;; Postgres non-reserved words
1589 (sql-font-lock-keywords-builder 'font-lock-builtin-face nil 1675 (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
1590"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan" 1676"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
1591"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil" 1677"also" "alter" "always" "assertion" "assignment" "at" "backward"
1592"center" "char_length" "chr" "coalesce" "col_description" "convert" 1678"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
1593"cos" "cot" "count" "current_database" "current_date" "current_schema" 1679"catalog" "chain" "characteristics" "checkpoint" "class" "close"
1594"current_schemas" "current_setting" "current_time" "current_timestamp" 1680"cluster" "coalesce" "comment" "comments" "commit" "committed"
1595"current_user" "currval" "date_part" "date_trunc" "decode" "degrees" 1681"configuration" "connection" "constraints" "content" "continue"
1596"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte" 1682"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv"
1597"has_database_privilege" "has_function_privilege" 1683"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec"
1598"has_language_privilege" "has_schema_privilege" "has_table_privilege" 1684"declare" "defaults" "deferred" "definer" "delete" "delimiter"
1599"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading" 1685"delimiters" "dictionary" "disable" "discard" "document" "domain"
1600"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad" 1686"drop" "each" "enable" "encoding" "encrypted" "enum" "escape"
1601"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval" 1687"exclude" "excluding" "exclusive" "execute" "exists" "explain"
1602"now" "npoints" "nullif" "obj_description" "octet_length" "overlay" 1688"external" "extract" "family" "first" "float" "following" "force"
1603"pclose" "pg_client_encoding" "pg_function_is_visible" 1689"forward" "function" "functions" "global" "granted" "greatest"
1604"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef" 1690"handler" "header" "hold" "hour" "identity" "if" "immediate"
1605"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible" 1691"immutable" "implicit" "including" "increment" "index" "indexes"
1606"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible" 1692"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert"
1607"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians" 1693"instead" "invoker" "isolation" "key" "language" "large" "last"
1608"radius" "random" "repeat" "replace" "round" "rpad" "rtrim" 1694"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local"
1609"session_user" "set_bit" "set_byte" "set_config" "set_masklen" 1695"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
1610"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr" 1696"minvalue" "mode" "month" "move" "name" "names" "national" "nchar"
1611"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date" 1697"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit"
1612"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim" 1698"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif"
1613"trunc" "upper" "variance" "version" "width" 1699"nulls" "object" "of" "oids" "operator" "option" "options" "out"
1700"overlay" "owned" "owner" "parser" "partial" "partition" "password"
1701"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior"
1702"privileges" "procedural" "procedure" "quote" "range" "read"
1703"reassign" "recheck" "recursive" "reindex" "relative" "release"
1704"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
1705"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
1706"schema" "scroll" "search" "second" "security" "sequence" "sequences"
1707"serializable" "server" "session" "set" "setof" "share" "show"
1708"simple" "stable" "standalone" "start" "statement" "statistics"
1709"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser"
1710"sysid" "system" "tables" "tablespace" "temp" "template" "temporary"
1711"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type"
1712"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until"
1713"update" "vacuum" "valid" "validator" "value" "values" "version"
1714"view" "volatile" "whitespace" "work" "wrapper" "write"
1715"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse"
1716"xmlpi" "xmlroot" "xmlserialize" "year" "yes"
1614) 1717)
1718
1615 ;; Postgres Reserved 1719 ;; Postgres Reserved
1616 (sql-font-lock-keywords-builder 'font-lock-keyword-face nil 1720 (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
1617"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter" 1721"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
1618"analyze" "and" "any" "as" "asc" "assignment" "authorization" 1722"authorization" "binary" "both" "case" "cast" "check" "collate"
1619"backward" "basetype" "before" "begin" "between" "binary" "by" "cache" 1723"column" "concurrently" "constraint" "create" "cross"
1620"called" "cascade" "case" "cast" "characteristics" "check" 1724"current_catalog" "current_date" "current_role" "current_schema"
1621"checkpoint" "class" "close" "cluster" "column" "comment" "commit" 1725"current_time" "current_timestamp" "current_user" "default"
1622"committed" "commutator" "constraint" "constraints" "conversion" 1726"deferrable" "desc" "distinct" "do" "else" "end" "except" "false"
1623"copy" "create" "createdb" "createuser" "cursor" "cycle" "database" 1727"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group"
1624"deallocate" "declare" "default" "deferrable" "deferred" "definer" 1728"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull"
1625"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each" 1729"is" "join" "leading" "left" "like" "limit" "localtime"
1626"element" "else" "encoding" "encrypted" "end" "escape" "except" 1730"localtimestamp" "natural" "notnull" "not" "null" "off" "offset"
1627"exclusive" "execute" "exists" "explain" "extended" "external" "false" 1731"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary"
1628"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from" 1732"references" "returning" "right" "select" "session_user" "similar"
1629"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having" 1733"some" "symmetric" "table" "then" "to" "trailing" "true" "union"
1630"immediate" "immutable" "implicit" "in" "increment" "index" "inherits" 1734"unique" "user" "using" "variadic" "verbose" "when" "where" "window"
1631"initcond" "initially" "input" "insensitive" "insert" "instead" 1735"with"
1632"internallength" "intersect" "into" "invoker" "is" "isnull"
1633"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
1634"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
1635"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
1636"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
1637"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
1638"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
1639"prepare" "primary" "prior" "privileges" "procedural" "procedure"
1640"public" "read" "recheck" "references" "reindex" "relative" "rename"
1641"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
1642"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
1643"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
1644"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
1645"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
1646"transaction" "trigger" "true" "truncate" "trusted" "type"
1647"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
1648"usage" "user" "using" "vacuum" "valid" "validator" "values"
1649"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
1650"work"
1651) 1736)
1652 1737
1653 ;; Postgres Data Types 1738 ;; Postgres Data Types
1654 (sql-font-lock-keywords-builder 'font-lock-type-face nil 1739 (sql-font-lock-keywords-builder 'font-lock-type-face nil
1655"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char" 1740"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char"
1656"character" "cidr" "circle" "cstring" "date" "decimal" "double" 1741"character" "cidr" "circle" "date" "decimal" "double" "float4"
1657"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal" 1742"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line"
1658"interval" "language_handler" "line" "lseg" "macaddr" "money" 1743"lseg" "macaddr" "money" "numeric" "path" "point" "polygon"
1659"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real" 1744"precision" "real" "serial" "serial4" "serial8" "smallint" "text"
1660"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure" 1745"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
1661"regtype" "serial" "serial4" "serial8" "smallint" "text" "time" 1746"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
1662"timestamp" "varchar" "varying" "void" "zone" 1747"xml" "zone"
1663))) 1748)))
1664 1749
1665 "Postgres SQL keywords used by font-lock. 1750 "Postgres SQL keywords used by font-lock.
@@ -1979,6 +2064,9 @@ you define your own `sql-mode-mysql-font-lock-keywords'.")
1979(defvar sql-mode-sqlite-font-lock-keywords 2064(defvar sql-mode-sqlite-font-lock-keywords
1980 (eval-when-compile 2065 (eval-when-compile
1981 (list 2066 (list
2067 ;; SQLite commands
2068 '("^[.].*$" . font-lock-doc-face)
2069
1982 ;; SQLite Keyword 2070 ;; SQLite Keyword
1983 (sql-font-lock-keywords-builder 'font-lock-keyword-face nil 2071 (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
1984"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" 2072"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as"
@@ -2493,29 +2581,31 @@ function like this: (sql-get-login 'user 'password 'database)."
2493 2581
2494 ((eq token 'port) ; port 2582 ((eq token 'port) ; port
2495 (setq sql-port 2583 (setq sql-port
2496 (read-number "Port: " sql-port)))))) 2584 (read-number "Port: " (if (numberp sql-port)
2497 what)) 2585 sql-port
2586 0)))))))
2587 what))
2498 2588
2499(defun sql-find-sqli-buffer () 2589(defun sql-find-sqli-buffer ()
2500 "Returns the current default SQLi buffer or nil. 2590 "Returns the name of the current default SQLi buffer or nil.
2501In order to qualify, the SQLi buffer must be alive, 2591In order to qualify, the SQLi buffer must be alive, be in
2502be in `sql-interactive-mode' and have a process." 2592`sql-interactive-mode' and have a process."
2503 (let ((default-buffer (default-value 'sql-buffer))) 2593 (let ((buf sql-buffer)
2504 (if (and (buffer-live-p default-buffer) 2594 (prod sql-product))
2505 (get-buffer-process default-buffer)) 2595 (or
2506 default-buffer 2596 ;; Current sql-buffer, if there is one.
2507 (save-current-buffer 2597 (and (sql-buffer-live-p buf prod)
2508 (let ((buflist (buffer-list)) 2598 buf)
2509 (found)) 2599 ;; Global sql-buffer
2510 (while (not (or (null buflist) 2600 (and (setq buf (default-value 'sql-buffer))
2511 found)) 2601 (sql-buffer-live-p buf prod)
2512 (let ((candidate (car buflist))) 2602 buf)
2513 (set-buffer candidate) 2603 ;; Look thru each buffer
2514 (if (and (derived-mode-p 'sql-interactive-mode) 2604 (car (apply 'append
2515 (get-buffer-process candidate)) 2605 (mapcar (lambda (b)
2516 (setq found candidate)) 2606 (and (sql-buffer-live-p b prod)
2517 (setq buflist (cdr buflist)))) 2607 (list (buffer-name b))))
2518 found))))) 2608 (buffer-list)))))))
2519 2609
2520(defun sql-set-sqli-buffer-generally () 2610(defun sql-set-sqli-buffer-generally ()
2521 "Set SQLi buffer for all SQL buffers that have none. 2611 "Set SQLi buffer for all SQL buffers that have none.
@@ -2527,16 +2617,17 @@ using `sql-find-sqli-buffer'. If `sql-buffer' is set,
2527 (interactive) 2617 (interactive)
2528 (save-excursion 2618 (save-excursion
2529 (let ((buflist (buffer-list)) 2619 (let ((buflist (buffer-list))
2530 (default-sqli-buffer (sql-find-sqli-buffer))) 2620 (default-buffer (sql-find-sqli-buffer)))
2531 (setq-default sql-buffer default-sqli-buffer) 2621 (setq-default sql-buffer default-buffer)
2532 (while (not (null buflist)) 2622 (while (not (null buflist))
2533 (let ((candidate (car buflist))) 2623 (let ((candidate (car buflist)))
2534 (set-buffer candidate) 2624 (set-buffer candidate)
2535 (if (and (derived-mode-p 'sql-mode) 2625 (if (and (derived-mode-p 'sql-mode)
2536 (not (buffer-live-p sql-buffer))) 2626 (not (sql-buffer-live-p sql-buffer)))
2537 (progn 2627 (progn
2538 (setq sql-buffer default-sqli-buffer) 2628 (setq sql-buffer default-buffer)
2539 (run-hooks 'sql-set-sqli-hook)))) 2629 (when default-buffer
2630 (run-hooks 'sql-set-sqli-hook)))))
2540 (setq buflist (cdr buflist)))))) 2631 (setq buflist (cdr buflist))))))
2541 2632
2542(defun sql-set-sqli-buffer () 2633(defun sql-set-sqli-buffer ()
@@ -2554,19 +2645,13 @@ If you call it from anywhere else, it sets the global copy of
2554 (interactive) 2645 (interactive)
2555 (let ((default-buffer (sql-find-sqli-buffer))) 2646 (let ((default-buffer (sql-find-sqli-buffer)))
2556 (if (null default-buffer) 2647 (if (null default-buffer)
2557 (error "There is no suitable SQLi buffer")) 2648 (error "There is no suitable SQLi buffer")
2558 (let ((new-buffer 2649 (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
2559 (get-buffer 2650 (if (null (sql-buffer-live-p new-buffer))
2560 (read-buffer "New SQLi buffer: " default-buffer t)))) 2651 (error "Buffer %s is not a working SQLi buffer" new-buffer)
2561 (if (null (get-buffer-process new-buffer)) 2652 (when new-buffer
2562 (error "Buffer %s has no process" (buffer-name new-buffer))) 2653 (setq sql-buffer new-buffer)
2563 (if (null (with-current-buffer new-buffer 2654 (run-hooks 'sql-set-sqli-hook)))))))
2564 (equal major-mode 'sql-interactive-mode)))
2565 (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
2566 (if new-buffer
2567 (progn
2568 (setq sql-buffer new-buffer)
2569 (run-hooks 'sql-set-sqli-hook))))))
2570 2655
2571(defun sql-show-sqli-buffer () 2656(defun sql-show-sqli-buffer ()
2572 "Show the name of current SQLi buffer. 2657 "Show the name of current SQLi buffer.
@@ -2574,11 +2659,11 @@ If you call it from anywhere else, it sets the global copy of
2574This is the buffer SQL strings are sent to. It is stored in the 2659This is the buffer SQL strings are sent to. It is stored in the
2575variable `sql-buffer'. See `sql-help' on how to create such a buffer." 2660variable `sql-buffer'. See `sql-help' on how to create such a buffer."
2576 (interactive) 2661 (interactive)
2577 (if (null (buffer-live-p sql-buffer)) 2662 (if (null (buffer-live-p (get-buffer sql-buffer)))
2578 (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) 2663 (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
2579 (if (null (get-buffer-process sql-buffer)) 2664 (if (null (get-buffer-process sql-buffer))
2580 (message "Buffer %s has no process." (buffer-name sql-buffer)) 2665 (message "Buffer %s has no process." sql-buffer)
2581 (message "Current SQLi buffer is %s." (buffer-name sql-buffer))))) 2666 (message "Current SQLi buffer is %s." sql-buffer))))
2582 2667
2583(defun sql-make-alternate-buffer-name () 2668(defun sql-make-alternate-buffer-name ()
2584 "Return a string that can be used to rename a SQLi buffer. 2669 "Return a string that can be used to rename a SQLi buffer.
@@ -2610,8 +2695,9 @@ server/database name."
2610 (unless (string= "" sql-user) 2695 (unless (string= "" sql-user)
2611 (list "/" sql-user))) 2696 (list "/" sql-user)))
2612 ((eq token 'port) 2697 ((eq token 'port)
2613 (unless (= 0 sql-port) 2698 (unless (or (not (numberp sql-port))
2614 (list ":" sql-port))) 2699 (= 0 sql-port))
2700 (list ":" (number-to-string sql-port))))
2615 ((eq token 'server) 2701 ((eq token 'server)
2616 (unless (string= "" sql-server) 2702 (unless (string= "" sql-server)
2617 (list "." 2703 (list "."
@@ -2619,7 +2705,7 @@ server/database name."
2619 (file-name-nondirectory sql-server) 2705 (file-name-nondirectory sql-server)
2620 sql-server)))) 2706 sql-server))))
2621 ((eq token 'database) 2707 ((eq token 'database)
2622 (when (string= "" sql-database) 2708 (unless (string= "" sql-database)
2623 (list "@" 2709 (list "@"
2624 (if (eq type :file) 2710 (if (eq type :file)
2625 (file-name-nondirectory sql-database) 2711 (file-name-nondirectory sql-database)
@@ -2649,10 +2735,32 @@ server/database name."
2649 ;; Use the name we've got 2735 ;; Use the name we've got
2650 name)))) 2736 name))))
2651 2737
2652(defun sql-rename-buffer () 2738(defun sql-rename-buffer (&optional new-name)
2653 "Rename a SQLi buffer." 2739 "Rename a SQL interactive buffer.
2654 (interactive) 2740
2655 (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t)) 2741Prompts for the new name if command is preceeded by
2742\\[universal-argument]. If no buffer name is provided, then the
2743`sql-alternate-buffer-name' is used.
2744
2745The actual buffer name set will be \"*SQL: NEW-NAME*\". If
2746NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
2747 (interactive "P")
2748
2749 (if (not (derived-mode-p 'sql-interactive-mode))
2750 (message "Current buffer is not a SQL interactive buffer")
2751
2752 (setq sql-alternate-buffer-name
2753 (cond
2754 ((stringp new-name) new-name)
2755 ((consp new-name)
2756 (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): "
2757 sql-alternate-buffer-name))
2758 (t sql-alternate-buffer-name)))
2759
2760 (rename-buffer (if (string= "" sql-alternate-buffer-name)
2761 "*SQL*"
2762 (format "*SQL: %s*" sql-alternate-buffer-name))
2763 t)))
2656 2764
2657(defun sql-copy-column () 2765(defun sql-copy-column ()
2658 "Copy current column to the end of buffer. 2766 "Copy current column to the end of buffer.
@@ -2801,7 +2909,7 @@ to force the output from the query to appear on a new line."
2801 2909
2802 (let ((comint-input-sender-no-newline nil) 2910 (let ((comint-input-sender-no-newline nil)
2803 (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str))) 2911 (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str)))
2804 (if (buffer-live-p sql-buffer) 2912 (if (sql-buffer-live-p sql-buffer)
2805 (progn 2913 (progn
2806 ;; Ignore the hoping around... 2914 ;; Ignore the hoping around...
2807 (save-excursion 2915 (save-excursion
@@ -2814,7 +2922,7 @@ to force the output from the query to appear on a new line."
2814 (if sql-send-terminator 2922 (if sql-send-terminator
2815 (sql-send-magic-terminator sql-buffer s sql-send-terminator)) 2923 (sql-send-magic-terminator sql-buffer s sql-send-terminator))
2816 2924
2817 (message "Sent string to buffer %s." (buffer-name sql-buffer)))) 2925 (message "Sent string to buffer %s." sql-buffer)))
2818 2926
2819 ;; Display the sql buffer 2927 ;; Display the sql buffer
2820 (if sql-pop-to-buffer-after-send-region 2928 (if sql-pop-to-buffer-after-send-region
@@ -2893,6 +3001,91 @@ If given the optional parameter VALUE, sets
2893 3001
2894 3002
2895 3003
3004;;; Redirect output functions
3005
3006(defun sql-redirect (command combuf &optional outbuf save-prior)
3007 "Execute the SQL command and send output to OUTBUF.
3008
3009COMBUF must be an active SQL interactive buffer. OUTBUF may be
3010an existing buffer, or the name of a non-existing buffer. If
3011omitted the output is sent to a temporary buffer which will be
3012killed after the command completes. COMMAND should be a string
3013of commands accepted by the SQLi program."
3014
3015 (with-current-buffer combuf
3016 (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*")))
3017 (proc (get-buffer-process (current-buffer)))
3018 (comint-prompt-regexp (sql-get-product-feature sql-product
3019 :prompt-regexp))
3020 (start nil))
3021 (with-current-buffer buf
3022 (unless save-prior
3023 (erase-buffer))
3024 (goto-char (point-max))
3025 (setq start (point)))
3026
3027 ;; Run the command
3028 (comint-redirect-send-command-to-process command buf proc nil t)
3029 (while (null comint-redirect-completed)
3030 (accept-process-output nil 1))
3031
3032 ;; Remove echo if there was one
3033 (with-current-buffer buf
3034 (goto-char start)
3035 (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
3036 (delete-region (match-beginning 0) (match-end 0)))
3037 (goto-char start)))))
3038
3039(defun sql-redirect-value (command combuf regexp &optional regexp-groups)
3040 "Execute the SQL command and return part of result.
3041
3042COMBUF must be an active SQL interactive buffer. COMMAND should
3043be a string of commands accepted by the SQLi program. From the
3044output, the REGEXP is repeatedly matched and the list of
3045REGEXP-GROUPS submatches is returned. This behaves much like
3046\\[comint-redirect-results-list-from-process] but instead of
3047returning a single submatch it returns a list of each submatch
3048for each match."
3049
3050 (let ((outbuf " *SQL-Redirect-values*")
3051 (results nil))
3052 (sql-redirect command combuf outbuf nil)
3053 (with-current-buffer outbuf
3054 (while (re-search-forward regexp nil t)
3055 (push
3056 (cond
3057 ;; no groups-return all of them
3058 ((null regexp-groups)
3059 (let ((i 1)
3060 (r nil))
3061 (while (match-beginning i)
3062 (push (match-string i) r))
3063 (nreverse r)))
3064 ;; one group specified
3065 ((numberp regexp-groups)
3066 (match-string regexp-groups))
3067 ;; (buffer-substring-no-properties
3068 ;; (match-beginning regexp-groups)
3069 ;; (match-end regexp-groups)))
3070 ;; list of numbers; return the specified matches only
3071 ((consp regexp-groups)
3072 (mapcar (lambda (c)
3073 (cond
3074 ((numberp c) (match-string c))
3075 ((stringp c) (match-substitute-replacement c))
3076 (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
3077 regexp-groups))
3078 ;; String is specified; return replacement string
3079 ((stringp regexp-groups)
3080 (match-substitute-replacement regexp-groups))
3081 (t
3082 (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
3083 regexp-groups)))
3084 results)))
3085 (nreverse results)))
3086
3087
3088
2896;;; SQL mode -- uses SQL interactive mode 3089;;; SQL mode -- uses SQL interactive mode
2897 3090
2898;;;###autoload 3091;;;###autoload
@@ -3063,7 +3256,7 @@ you entered, right above the output it created.
3063 (setq local-abbrev-table sql-mode-abbrev-table) 3256 (setq local-abbrev-table sql-mode-abbrev-table)
3064 (setq abbrev-all-caps 1) 3257 (setq abbrev-all-caps 1)
3065 ;; Exiting the process will call sql-stop. 3258 ;; Exiting the process will call sql-stop.
3066 (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop) 3259 (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
3067 ;; Save the connection name 3260 ;; Save the connection name
3068 (make-local-variable 'sql-connection) 3261 (make-local-variable 'sql-connection)
3069 ;; Create a usefull name for renaming this buffer later. 3262 ;; Create a usefull name for renaming this buffer later.
@@ -3248,49 +3441,57 @@ optionally is saved to the user's init file."
3248;;; Entry functions for different SQL interpreters. 3441;;; Entry functions for different SQL interpreters.
3249 3442
3250;;;###autoload 3443;;;###autoload
3251(defun sql-product-interactive (&optional product) 3444(defun sql-product-interactive (&optional product new-name)
3252 "Run PRODUCT interpreter as an inferior process. 3445 "Run PRODUCT interpreter as an inferior process.
3253 3446
3254If buffer `*SQL*' exists but no process is running, make a new process. 3447If buffer `*SQL*' exists but no process is running, make a new process.
3255If buffer exists and a process is running, just switch to buffer `*SQL*'. 3448If buffer exists and a process is running, just switch to buffer `*SQL*'.
3256 3449
3450To specify the SQL product, prefix the call with
3451\\[universal-argument]. To set the buffer name as well, prefix
3452the call to \\[sql-product-interactive] with
3453\\[universal-argument] \\[universal-argument].
3454
3257\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3455\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3258 (interactive "P") 3456 (interactive "P")
3259 3457
3458 ;; Handle universal arguments if specified
3459 (when (not (or executing-kbd-macro noninteractive))
3460 (when (and (consp product)
3461 (not (cdr product))
3462 (numberp (car product)))
3463 (when (>= (car product) 16)
3464 (when (not new-name)
3465 (setq new-name '(4)))
3466 (setq product '(4)))))
3467
3468 ;; Get the value of product that we need
3260 (setq product 3469 (setq product
3261 (cond 3470 (cond
3262 ((equal product '(4)) ; Universal arg, prompt for product 3471 ((equal product '(4)) ; C-u, prompt for product
3263 (intern (completing-read "SQL product: " 3472 (intern (completing-read "SQL product: "
3264 (mapcar (lambda (info) (symbol-name (car info))) 3473 (mapcar (lambda (info) (symbol-name (car info)))
3265 sql-product-alist) 3474 sql-product-alist)
3266 nil 'require-match 3475 nil 'require-match
3267 (or (and sql-product (symbol-name sql-product)) "ansi")))) 3476 (or (and sql-product
3477 (symbol-name sql-product))
3478 "ansi"))))
3268 ((and product ; Product specified 3479 ((and product ; Product specified
3269 (symbolp product)) product) 3480 (symbolp product)) product)
3270 (t sql-product))) ; Default to sql-product 3481 (t sql-product))) ; Default to sql-product
3271 3482
3483 ;; If we have a product and it has a interactive mode
3272 (if product 3484 (if product
3273 (when (sql-get-product-feature product :sqli-comint-func) 3485 (when (sql-get-product-feature product :sqli-comint-func)
3274 (if (and sql-buffer 3486 ;; If no new name specified, fall back on sql-buffer if its for
3275 (buffer-live-p sql-buffer) 3487 ;; the same product
3276 (comint-check-proc sql-buffer)) 3488 (if (and (not new-name)
3489 (sql-buffer-live-p sql-buffer product))
3277 (pop-to-buffer sql-buffer) 3490 (pop-to-buffer sql-buffer)
3278 3491
3279 ;; Is the current buffer in sql-mode and 3492 ;; We have a new name or sql-buffer doesn't exist or match
3280 ;; there is a buffer local setting of sql-buffer 3493 ;; Start by remembering where we start
3281 (let* ((start-buffer 3494 (let* ((start-buffer (current-buffer))
3282 (and (derived-mode-p 'sql-mode)
3283 (current-buffer)))
3284 (start-sql-buffer
3285 (and start-buffer
3286 (let (found)
3287 (dolist (var (buffer-local-variables))
3288 (and (consp var)
3289 (eq (car var) 'sql-buffer)
3290 (buffer-live-p (cdr var))
3291 (get-buffer-process (cdr var))
3292 (setq found (cdr var))))
3293 found)))
3294 new-sqli-buffer) 3495 new-sqli-buffer)
3295 3496
3296 ;; Get credentials. 3497 ;; Get credentials.
@@ -3303,15 +3504,19 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
3303 (sql-get-product-feature product :sqli-options)) 3504 (sql-get-product-feature product :sqli-options))
3304 3505
3305 ;; Set SQLi mode. 3506 ;; Set SQLi mode.
3306 (setq sql-interactive-product product 3507 (setq new-sqli-buffer (current-buffer))
3307 new-sqli-buffer (current-buffer) 3508 (let ((sql-interactive-product product))
3308 sql-buffer new-sqli-buffer) 3509 (sql-interactive-mode))
3309 (sql-interactive-mode) 3510
3511 ;; Set the new buffer name
3512 (when new-name
3513 (sql-rename-buffer new-name))
3310 3514
3311 ;; Set `sql-buffer' in the start buffer 3515 ;; Set `sql-buffer' in the new buffer and the start buffer
3312 (when (and start-buffer (not start-sql-buffer)) 3516 (setq sql-buffer (buffer-name new-sqli-buffer))
3313 (with-current-buffer start-buffer 3517 (with-current-buffer start-buffer
3314 (setq sql-buffer new-sqli-buffer))) 3518 (setq sql-buffer (buffer-name new-sqli-buffer))
3519 (run-hooks 'sql-set-sqli-hook))
3315 3520
3316 ;; All done. 3521 ;; All done.
3317 (message "Login...done") 3522 (message "Login...done")
@@ -3323,12 +3528,22 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
3323 3528
3324PRODUCT is the SQL product. PARAMS is a list of strings which are 3529PRODUCT is the SQL product. PARAMS is a list of strings which are
3325passed as command line arguments." 3530passed as command line arguments."
3326 (let ((program (sql-get-product-feature product :sqli-program))) 3531 (let ((program (sql-get-product-feature product :sqli-program))
3532 (buf-name "SQL"))
3533 ;; Make sure buffer name is unique
3534 (when (get-buffer (format "*%s*" buf-name))
3535 (setq buf-name (format "SQL-%s" product))
3536 (when (get-buffer (format "*%s*" buf-name))
3537 (let ((i 1))
3538 (while (get-buffer (format "*%s*"
3539 (setq buf-name
3540 (format "SQL-%s%d" product i))))
3541 (setq i (1+ i))))))
3327 (set-buffer 3542 (set-buffer
3328 (apply 'make-comint "SQL" program nil params)))) 3543 (apply 'make-comint buf-name program nil params))))
3329 3544
3330;;;###autoload 3545;;;###autoload
3331(defun sql-oracle () 3546(defun sql-oracle (&optional buffer)
3332 "Run sqlplus by Oracle as an inferior process. 3547 "Run sqlplus by Oracle as an inferior process.
3333 3548
3334If buffer `*SQL*' exists but no process is running, make a new process. 3549If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3343,6 +3558,11 @@ the list `sql-oracle-options'.
3343The buffer is put in SQL interactive mode, giving commands for sending 3558The buffer is put in SQL interactive mode, giving commands for sending
3344input. See `sql-interactive-mode'. 3559input. See `sql-interactive-mode'.
3345 3560
3561To set the buffer name directly, use \\[universal-argument]
3562before \\[sql-oracle]. Once session has started,
3563\\[sql-rename-buffer] can be called separately to rename the
3564buffer.
3565
3346To specify a coding system for converting non-ASCII characters 3566To specify a coding system for converting non-ASCII characters
3347in the input and output to the process, use \\[universal-coding-system-argument] 3567in the input and output to the process, use \\[universal-coding-system-argument]
3348before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system] 3568before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3351,8 +3571,8 @@ The default comes from `process-coding-system-alist' and
3351`default-process-coding-system'. 3571`default-process-coding-system'.
3352 3572
3353\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3573\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3354 (interactive) 3574 (interactive "P")
3355 (sql-product-interactive 'oracle)) 3575 (sql-product-interactive 'oracle buffer))
3356 3576
3357(defun sql-comint-oracle (product options) 3577(defun sql-comint-oracle (product options)
3358 "Create comint buffer and connect to Oracle." 3578 "Create comint buffer and connect to Oracle."
@@ -3375,7 +3595,7 @@ The default comes from `process-coding-system-alist' and
3375 3595
3376 3596
3377;;;###autoload 3597;;;###autoload
3378(defun sql-sybase () 3598(defun sql-sybase (&optional buffer)
3379 "Run isql by Sybase as an inferior process. 3599 "Run isql by Sybase as an inferior process.
3380 3600
3381If buffer `*SQL*' exists but no process is running, make a new process. 3601If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3390,6 +3610,11 @@ can be stored in the list `sql-sybase-options'.
3390The buffer is put in SQL interactive mode, giving commands for sending 3610The buffer is put in SQL interactive mode, giving commands for sending
3391input. See `sql-interactive-mode'. 3611input. See `sql-interactive-mode'.
3392 3612
3613To set the buffer name directly, use \\[universal-argument]
3614before \\[sql-sybase]. Once session has started,
3615\\[sql-rename-buffer] can be called separately to rename the
3616buffer.
3617
3393To specify a coding system for converting non-ASCII characters 3618To specify a coding system for converting non-ASCII characters
3394in the input and output to the process, use \\[universal-coding-system-argument] 3619in the input and output to the process, use \\[universal-coding-system-argument]
3395before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system] 3620before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3398,8 +3623,8 @@ The default comes from `process-coding-system-alist' and
3398`default-process-coding-system'. 3623`default-process-coding-system'.
3399 3624
3400\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3625\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3401 (interactive) 3626 (interactive "P")
3402 (sql-product-interactive 'sybase)) 3627 (sql-product-interactive 'sybase buffer))
3403 3628
3404(defun sql-comint-sybase (product options) 3629(defun sql-comint-sybase (product options)
3405 "Create comint buffer and connect to Sybase." 3630 "Create comint buffer and connect to Sybase."
@@ -3419,7 +3644,7 @@ The default comes from `process-coding-system-alist' and
3419 3644
3420 3645
3421;;;###autoload 3646;;;###autoload
3422(defun sql-informix () 3647(defun sql-informix (&optional buffer)
3423 "Run dbaccess by Informix as an inferior process. 3648 "Run dbaccess by Informix as an inferior process.
3424 3649
3425If buffer `*SQL*' exists but no process is running, make a new process. 3650If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3432,6 +3657,11 @@ the variable `sql-database' as default, if set.
3432The buffer is put in SQL interactive mode, giving commands for sending 3657The buffer is put in SQL interactive mode, giving commands for sending
3433input. See `sql-interactive-mode'. 3658input. See `sql-interactive-mode'.
3434 3659
3660To set the buffer name directly, use \\[universal-argument]
3661before \\[sql-informix]. Once session has started,
3662\\[sql-rename-buffer] can be called separately to rename the
3663buffer.
3664
3435To specify a coding system for converting non-ASCII characters 3665To specify a coding system for converting non-ASCII characters
3436in the input and output to the process, use \\[universal-coding-system-argument] 3666in the input and output to the process, use \\[universal-coding-system-argument]
3437before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system] 3667before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3440,8 +3670,8 @@ The default comes from `process-coding-system-alist' and
3440`default-process-coding-system'. 3670`default-process-coding-system'.
3441 3671
3442\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3672\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3443 (interactive) 3673 (interactive "P")
3444 (sql-product-interactive 'informix)) 3674 (sql-product-interactive 'informix buffer))
3445 3675
3446(defun sql-comint-informix (product options) 3676(defun sql-comint-informix (product options)
3447 "Create comint buffer and connect to Informix." 3677 "Create comint buffer and connect to Informix."
@@ -3456,7 +3686,7 @@ The default comes from `process-coding-system-alist' and
3456 3686
3457 3687
3458;;;###autoload 3688;;;###autoload
3459(defun sql-sqlite () 3689(defun sql-sqlite (&optional buffer)
3460 "Run sqlite as an inferior process. 3690 "Run sqlite as an inferior process.
3461 3691
3462SQLite is free software. 3692SQLite is free software.
@@ -3473,6 +3703,11 @@ can be stored in the list `sql-sqlite-options'.
3473The buffer is put in SQL interactive mode, giving commands for sending 3703The buffer is put in SQL interactive mode, giving commands for sending
3474input. See `sql-interactive-mode'. 3704input. See `sql-interactive-mode'.
3475 3705
3706To set the buffer name directly, use \\[universal-argument]
3707before \\[sql-sqlite]. Once session has started,
3708\\[sql-rename-buffer] can be called separately to rename the
3709buffer.
3710
3476To specify a coding system for converting non-ASCII characters 3711To specify a coding system for converting non-ASCII characters
3477in the input and output to the process, use \\[universal-coding-system-argument] 3712in the input and output to the process, use \\[universal-coding-system-argument]
3478before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system] 3713before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3481,8 +3716,8 @@ The default comes from `process-coding-system-alist' and
3481`default-process-coding-system'. 3716`default-process-coding-system'.
3482 3717
3483\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3718\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3484 (interactive) 3719 (interactive "P")
3485 (sql-product-interactive 'sqlite)) 3720 (sql-product-interactive 'sqlite buffer))
3486 3721
3487(defun sql-comint-sqlite (product options) 3722(defun sql-comint-sqlite (product options)
3488 "Create comint buffer and connect to SQLite." 3723 "Create comint buffer and connect to SQLite."
@@ -3498,7 +3733,7 @@ The default comes from `process-coding-system-alist' and
3498 3733
3499 3734
3500;;;###autoload 3735;;;###autoload
3501(defun sql-mysql () 3736(defun sql-mysql (&optional buffer)
3502 "Run mysql by TcX as an inferior process. 3737 "Run mysql by TcX as an inferior process.
3503 3738
3504Mysql versions 3.23 and up are free software. 3739Mysql versions 3.23 and up are free software.
@@ -3515,6 +3750,11 @@ can be stored in the list `sql-mysql-options'.
3515The buffer is put in SQL interactive mode, giving commands for sending 3750The buffer is put in SQL interactive mode, giving commands for sending
3516input. See `sql-interactive-mode'. 3751input. See `sql-interactive-mode'.
3517 3752
3753To set the buffer name directly, use \\[universal-argument]
3754before \\[sql-mysql]. Once session has started,
3755\\[sql-rename-buffer] can be called separately to rename the
3756buffer.
3757
3518To specify a coding system for converting non-ASCII characters 3758To specify a coding system for converting non-ASCII characters
3519in the input and output to the process, use \\[universal-coding-system-argument] 3759in the input and output to the process, use \\[universal-coding-system-argument]
3520before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system] 3760before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3523,8 +3763,8 @@ The default comes from `process-coding-system-alist' and
3523`default-process-coding-system'. 3763`default-process-coding-system'.
3524 3764
3525\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3765\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3526 (interactive) 3766 (interactive "P")
3527 (sql-product-interactive 'mysql)) 3767 (sql-product-interactive 'mysql buffer))
3528 3768
3529(defun sql-comint-mysql (product options) 3769(defun sql-comint-mysql (product options)
3530 "Create comint buffer and connect to MySQL." 3770 "Create comint buffer and connect to MySQL."
@@ -3535,7 +3775,7 @@ The default comes from `process-coding-system-alist' and
3535 (setq params (append (list sql-database) params))) 3775 (setq params (append (list sql-database) params)))
3536 (if (not (string= "" sql-server)) 3776 (if (not (string= "" sql-server))
3537 (setq params (append (list (concat "--host=" sql-server)) params))) 3777 (setq params (append (list (concat "--host=" sql-server)) params)))
3538 (if (and sql-port (numberp sql-port)) 3778 (if (not (= 0 sql-port))
3539 (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) 3779 (setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
3540 (if (not (string= "" sql-password)) 3780 (if (not (string= "" sql-password))
3541 (setq params (append (list (concat "--password=" sql-password)) params))) 3781 (setq params (append (list (concat "--password=" sql-password)) params)))
@@ -3547,7 +3787,7 @@ The default comes from `process-coding-system-alist' and
3547 3787
3548 3788
3549;;;###autoload 3789;;;###autoload
3550(defun sql-solid () 3790(defun sql-solid (&optional buffer)
3551 "Run solsql by Solid as an inferior process. 3791 "Run solsql by Solid as an inferior process.
3552 3792
3553If buffer `*SQL*' exists but no process is running, make a new process. 3793If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3561,6 +3801,11 @@ defaults, if set.
3561The buffer is put in SQL interactive mode, giving commands for sending 3801The buffer is put in SQL interactive mode, giving commands for sending
3562input. See `sql-interactive-mode'. 3802input. See `sql-interactive-mode'.
3563 3803
3804To set the buffer name directly, use \\[universal-argument]
3805before \\[sql-solid]. Once session has started,
3806\\[sql-rename-buffer] can be called separately to rename the
3807buffer.
3808
3564To specify a coding system for converting non-ASCII characters 3809To specify a coding system for converting non-ASCII characters
3565in the input and output to the process, use \\[universal-coding-system-argument] 3810in the input and output to the process, use \\[universal-coding-system-argument]
3566before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system] 3811before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3569,8 +3814,8 @@ The default comes from `process-coding-system-alist' and
3569`default-process-coding-system'. 3814`default-process-coding-system'.
3570 3815
3571\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3816\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3572 (interactive) 3817 (interactive "P")
3573 (sql-product-interactive 'solid)) 3818 (sql-product-interactive 'solid buffer))
3574 3819
3575(defun sql-comint-solid (product options) 3820(defun sql-comint-solid (product options)
3576 "Create comint buffer and connect to Solid." 3821 "Create comint buffer and connect to Solid."
@@ -3588,7 +3833,7 @@ The default comes from `process-coding-system-alist' and
3588 3833
3589 3834
3590;;;###autoload 3835;;;###autoload
3591(defun sql-ingres () 3836(defun sql-ingres (&optional buffer)
3592 "Run sql by Ingres as an inferior process. 3837 "Run sql by Ingres as an inferior process.
3593 3838
3594If buffer `*SQL*' exists but no process is running, make a new process. 3839If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3601,6 +3846,11 @@ the variable `sql-database' as default, if set.
3601The buffer is put in SQL interactive mode, giving commands for sending 3846The buffer is put in SQL interactive mode, giving commands for sending
3602input. See `sql-interactive-mode'. 3847input. See `sql-interactive-mode'.
3603 3848
3849To set the buffer name directly, use \\[universal-argument]
3850before \\[sql-ingres]. Once session has started,
3851\\[sql-rename-buffer] can be called separately to rename the
3852buffer.
3853
3604To specify a coding system for converting non-ASCII characters 3854To specify a coding system for converting non-ASCII characters
3605in the input and output to the process, use \\[universal-coding-system-argument] 3855in the input and output to the process, use \\[universal-coding-system-argument]
3606before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system] 3856before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3609,8 +3859,8 @@ The default comes from `process-coding-system-alist' and
3609`default-process-coding-system'. 3859`default-process-coding-system'.
3610 3860
3611\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3861\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3612 (interactive) 3862 (interactive "P")
3613 (sql-product-interactive 'ingres)) 3863 (sql-product-interactive 'ingres buffer))
3614 3864
3615(defun sql-comint-ingres (product options) 3865(defun sql-comint-ingres (product options)
3616 "Create comint buffer and connect to Ingres." 3866 "Create comint buffer and connect to Ingres."
@@ -3624,7 +3874,7 @@ The default comes from `process-coding-system-alist' and
3624 3874
3625 3875
3626;;;###autoload 3876;;;###autoload
3627(defun sql-ms () 3877(defun sql-ms (&optional buffer)
3628 "Run osql by Microsoft as an inferior process. 3878 "Run osql by Microsoft as an inferior process.
3629 3879
3630If buffer `*SQL*' exists but no process is running, make a new process. 3880If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3639,6 +3889,11 @@ in the list `sql-ms-options'.
3639The buffer is put in SQL interactive mode, giving commands for sending 3889The buffer is put in SQL interactive mode, giving commands for sending
3640input. See `sql-interactive-mode'. 3890input. See `sql-interactive-mode'.
3641 3891
3892To set the buffer name directly, use \\[universal-argument]
3893before \\[sql-ms]. Once session has started,
3894\\[sql-rename-buffer] can be called separately to rename the
3895buffer.
3896
3642To specify a coding system for converting non-ASCII characters 3897To specify a coding system for converting non-ASCII characters
3643in the input and output to the process, use \\[universal-coding-system-argument] 3898in the input and output to the process, use \\[universal-coding-system-argument]
3644before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system] 3899before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3647,8 +3902,8 @@ The default comes from `process-coding-system-alist' and
3647`default-process-coding-system'. 3902`default-process-coding-system'.
3648 3903
3649\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3904\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3650 (interactive) 3905 (interactive "P")
3651 (sql-product-interactive 'ms)) 3906 (sql-product-interactive 'ms buffer))
3652 3907
3653(defun sql-comint-ms (product options) 3908(defun sql-comint-ms (product options)
3654 "Create comint buffer and connect to Microsoft SQL Server." 3909 "Create comint buffer and connect to Microsoft SQL Server."
@@ -3675,7 +3930,7 @@ The default comes from `process-coding-system-alist' and
3675 3930
3676 3931
3677;;;###autoload 3932;;;###autoload
3678(defun sql-postgres () 3933(defun sql-postgres (&optional buffer)
3679 "Run psql by Postgres as an inferior process. 3934 "Run psql by Postgres as an inferior process.
3680 3935
3681If buffer `*SQL*' exists but no process is running, make a new process. 3936If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3690,6 +3945,11 @@ Additional command line parameters can be stored in the list
3690The buffer is put in SQL interactive mode, giving commands for sending 3945The buffer is put in SQL interactive mode, giving commands for sending
3691input. See `sql-interactive-mode'. 3946input. See `sql-interactive-mode'.
3692 3947
3948To set the buffer name directly, use \\[universal-argument]
3949before \\[sql-postgres]. Once session has started,
3950\\[sql-rename-buffer] can be called separately to rename the
3951buffer.
3952
3693To specify a coding system for converting non-ASCII characters 3953To specify a coding system for converting non-ASCII characters
3694in the input and output to the process, use \\[universal-coding-system-argument] 3954in the input and output to the process, use \\[universal-coding-system-argument]
3695before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system] 3955before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3703,8 +3963,8 @@ Try to set `comint-output-filter-functions' like this:
3703 '(comint-strip-ctrl-m))) 3963 '(comint-strip-ctrl-m)))
3704 3964
3705\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 3965\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3706 (interactive) 3966 (interactive "P")
3707 (sql-product-interactive 'postgres)) 3967 (sql-product-interactive 'postgres buffer))
3708 3968
3709(defun sql-comint-postgres (product options) 3969(defun sql-comint-postgres (product options)
3710 "Create comint buffer and connect to Postgres." 3970 "Create comint buffer and connect to Postgres."
@@ -3725,7 +3985,7 @@ Try to set `comint-output-filter-functions' like this:
3725 3985
3726 3986
3727;;;###autoload 3987;;;###autoload
3728(defun sql-interbase () 3988(defun sql-interbase (&optional buffer)
3729 "Run isql by Interbase as an inferior process. 3989 "Run isql by Interbase as an inferior process.
3730 3990
3731If buffer `*SQL*' exists but no process is running, make a new process. 3991If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3739,6 +3999,11 @@ defaults, if set.
3739The buffer is put in SQL interactive mode, giving commands for sending 3999The buffer is put in SQL interactive mode, giving commands for sending
3740input. See `sql-interactive-mode'. 4000input. See `sql-interactive-mode'.
3741 4001
4002To set the buffer name directly, use \\[universal-argument]
4003before \\[sql-interbase]. Once session has started,
4004\\[sql-rename-buffer] can be called separately to rename the
4005buffer.
4006
3742To specify a coding system for converting non-ASCII characters 4007To specify a coding system for converting non-ASCII characters
3743in the input and output to the process, use \\[universal-coding-system-argument] 4008in the input and output to the process, use \\[universal-coding-system-argument]
3744before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system] 4009before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3747,8 +4012,8 @@ The default comes from `process-coding-system-alist' and
3747`default-process-coding-system'. 4012`default-process-coding-system'.
3748 4013
3749\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 4014\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3750 (interactive) 4015 (interactive "P")
3751 (sql-product-interactive 'interbase)) 4016 (sql-product-interactive 'interbase buffer))
3752 4017
3753(defun sql-comint-interbase (product options) 4018(defun sql-comint-interbase (product options)
3754 "Create comint buffer and connect to Interbase." 4019 "Create comint buffer and connect to Interbase."
@@ -3766,7 +4031,7 @@ The default comes from `process-coding-system-alist' and
3766 4031
3767 4032
3768;;;###autoload 4033;;;###autoload
3769(defun sql-db2 () 4034(defun sql-db2 (&optional buffer)
3770 "Run db2 by IBM as an inferior process. 4035 "Run db2 by IBM as an inferior process.
3771 4036
3772If buffer `*SQL*' exists but no process is running, make a new process. 4037If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3784,6 +4049,11 @@ db2, newlines will be escaped if necessary. If you don't want that, set
3784`comint-input-sender' back to `comint-simple-send' by writing an after 4049`comint-input-sender' back to `comint-simple-send' by writing an after
3785advice. See the elisp manual for more information. 4050advice. See the elisp manual for more information.
3786 4051
4052To set the buffer name directly, use \\[universal-argument]
4053before \\[sql-db2]. Once session has started,
4054\\[sql-rename-buffer] can be called separately to rename the
4055buffer.
4056
3787To specify a coding system for converting non-ASCII characters 4057To specify a coding system for converting non-ASCII characters
3788in the input and output to the process, use \\[universal-coding-system-argument] 4058in the input and output to the process, use \\[universal-coding-system-argument]
3789before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system] 4059before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3792,8 +4062,8 @@ The default comes from `process-coding-system-alist' and
3792`default-process-coding-system'. 4062`default-process-coding-system'.
3793 4063
3794\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 4064\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3795 (interactive) 4065 (interactive "P")
3796 (sql-product-interactive 'db2)) 4066 (sql-product-interactive 'db2 buffer))
3797 4067
3798(defun sql-comint-db2 (product options) 4068(defun sql-comint-db2 (product options)
3799 "Create comint buffer and connect to DB2." 4069 "Create comint buffer and connect to DB2."
@@ -3801,11 +4071,9 @@ The default comes from `process-coding-system-alist' and
3801 ;; make-comint. 4071 ;; make-comint.
3802 (sql-comint product options) 4072 (sql-comint product options)
3803) 4073)
3804;; ;; Properly escape newlines when DB2 is interactive.
3805;; (setq comint-input-sender 'sql-escape-newlines-and-send))
3806 4074
3807;;;###autoload 4075;;;###autoload
3808(defun sql-linter () 4076(defun sql-linter (&optional buffer)
3809 "Run inl by RELEX as an inferior process. 4077 "Run inl by RELEX as an inferior process.
3810 4078
3811If buffer `*SQL*' exists but no process is running, make a new process. 4079If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3827,9 +4095,14 @@ an empty password.
3827The buffer is put in SQL interactive mode, giving commands for sending 4095The buffer is put in SQL interactive mode, giving commands for sending
3828input. See `sql-interactive-mode'. 4096input. See `sql-interactive-mode'.
3829 4097
4098To set the buffer name directly, use \\[universal-argument]
4099before \\[sql-linter]. Once session has started,
4100\\[sql-rename-buffer] can be called separately to rename the
4101buffer.
4102
3830\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" 4103\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
3831 (interactive) 4104 (interactive "P")
3832 (sql-product-interactive 'linter)) 4105 (sql-product-interactive 'linter buffer))
3833 4106
3834(defun sql-comint-linter (product options) 4107(defun sql-comint-linter (product options)
3835 "Create comint buffer and connect to Linter." 4108 "Create comint buffer and connect to Linter."
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 29096a23046..8f80d13bab6 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -411,9 +411,10 @@ This variable is generally set from `tcl-proc-regexp',
411`tcl-typeword-list', and `tcl-keyword-list' by the function 411`tcl-typeword-list', and `tcl-keyword-list' by the function
412`tcl-set-font-lock-keywords'.") 412`tcl-set-font-lock-keywords'.")
413 413
414(defvar tcl-font-lock-syntactic-keywords 414(defconst tcl-syntax-propertize-function
415 ;; Mark the few `#' that are not comment-markers. 415 (syntax-propertize-rules
416 '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) 416 ;; Mark the few `#' that are not comment-markers.
417 ("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
417 "Syntactic keywords for `tcl-mode'.") 418 "Syntactic keywords for `tcl-mode'.")
418 419
419;; FIXME need some way to recognize variables because array refs look 420;; FIXME need some way to recognize variables because array refs look
@@ -593,9 +594,9 @@ Commands:
593 (set (make-local-variable 'outline-level) 'tcl-outline-level) 594 (set (make-local-variable 'outline-level) 'tcl-outline-level)
594 595
595 (set (make-local-variable 'font-lock-defaults) 596 (set (make-local-variable 'font-lock-defaults)
596 '(tcl-font-lock-keywords nil nil nil beginning-of-defun 597 '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
597 (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords) 598 (set (make-local-variable 'syntax-propertize-function)
598 (parse-sexp-lookup-properties . t))) 599 tcl-syntax-propertize-function)
599 600
600 (set (make-local-variable 'imenu-generic-expression) 601 (set (make-local-variable 'imenu-generic-expression)
601 tcl-imenu-generic-expression) 602 tcl-imenu-generic-expression)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 4ff9cf92b8d..24768d93e6a 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -4693,8 +4693,15 @@ Key bindings:
4693 (set (make-local-variable 'font-lock-defaults) 4693 (set (make-local-variable 'font-lock-defaults)
4694 (list 4694 (list
4695 '(nil vhdl-font-lock-keywords) nil 4695 '(nil vhdl-font-lock-keywords) nil
4696 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line 4696 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
4697 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) 4697 (if (eval-when-compile (fboundp 'syntax-propertize-rules))
4698 (set (make-local-variable 'syntax-propertize-function)
4699 (syntax-propertize-rules
4700 ;; Mark single quotes as having string quote syntax in
4701 ;; 'c' instances.
4702 ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
4703 (set (make-local-variable 'font-lock-syntactic-keywords)
4704 vhdl-font-lock-syntactic-keywords))
4698 (unless vhdl-emacs-21 4705 (unless vhdl-emacs-21
4699 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) 4706 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4700 (set (make-local-variable 'lazy-lock-defer-contextually) nil) 4707 (set (make-local-variable 'lazy-lock-defer-contextually) nil)
@@ -12914,10 +12921,9 @@ This does background highlighting of translate-off regions.")
12914 "Re-initialize fontification and fontify buffer." 12921 "Re-initialize fontification and fontify buffer."
12915 (interactive) 12922 (interactive)
12916 (setq font-lock-defaults 12923 (setq font-lock-defaults
12917 (list 12924 `(vhdl-font-lock-keywords
12918 'vhdl-font-lock-keywords nil 12925 nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
12919 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line 12926 beginning-of-line))
12920 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
12921 (when (fboundp 'font-lock-unset-defaults) 12927 (when (fboundp 'font-lock-unset-defaults)
12922 (font-lock-unset-defaults)) ; not implemented in XEmacs 12928 (font-lock-unset-defaults)) ; not implemented in XEmacs
12923 (font-lock-set-defaults) 12929 (font-lock-set-defaults)
diff --git a/lisp/repeat.el b/lisp/repeat.el
index eddaf4f020e..86484ec68d6 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -335,7 +335,12 @@ recently executed command not bound to an input event\"."
335 (setq real-last-command 'repeat) 335 (setq real-last-command 'repeat)
336 (setq repeat-undo-count 1) 336 (setq repeat-undo-count 1)
337 (unwind-protect 337 (unwind-protect
338 (while (eq (read-event) repeat-repeat-char) 338 (while (let ((evt (read-event))) ;FIXME: read-key maybe?
339 ;; For clicks, we need to strip the meta-data to
340 ;; check the underlying event name.
341 (eq (or (car-safe evt) evt)
342 (or (car-safe repeat-repeat-char)
343 repeat-repeat-char)))
339 (repeat repeat-arg)) 344 (repeat repeat-arg))
340 ;; Make sure `repeat-undo-count' is reset. 345 ;; Make sure `repeat-undo-count' is reset.
341 (setq repeat-undo-count nil)) 346 (setq repeat-undo-count nil))
diff --git a/lisp/simple.el b/lisp/simple.el
index 18b2c3a300a..1ab737d5ec1 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4343,7 +4343,7 @@ into account variable-width characters and line continuation."
4343 (or (and (= (vertical-motion 4343 (or (and (= (vertical-motion
4344 (cons (or goal-column 4344 (cons (or goal-column
4345 (if (consp temporary-goal-column) 4345 (if (consp temporary-goal-column)
4346 (truncate (car temporary-goal-column)) 4346 (car temporary-goal-column)
4347 temporary-goal-column)) 4347 temporary-goal-column))
4348 arg)) 4348 arg))
4349 arg) 4349 arg)
@@ -5541,6 +5541,7 @@ The function should return non-nil if the two tokens do not match.")
5541 (if (minibufferp) 5541 (if (minibufferp)
5542 (minibuffer-message " [Unmatched parenthesis]") 5542 (minibuffer-message " [Unmatched parenthesis]")
5543 (message "Unmatched parenthesis")))) 5543 (message "Unmatched parenthesis"))))
5544 ((not blinkpos) nil)
5544 ((pos-visible-in-window-p blinkpos) 5545 ((pos-visible-in-window-p blinkpos)
5545 ;; Matching open within window, temporarily move to blinkpos but only 5546 ;; Matching open within window, temporarily move to blinkpos but only
5546 ;; if `blink-matching-paren-on-screen' is non-nil. 5547 ;; if `blink-matching-paren-on-screen' is non-nil.
diff --git a/lisp/subr.el b/lisp/subr.el
index 83cf7211906..b391f1f0b93 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -239,7 +239,7 @@ letter but *do not* end with a period. Please follow this convention
239for the sake of consistency." 239for the sake of consistency."
240 (while t 240 (while t
241 (signal 'error (list (apply 'format args))))) 241 (signal 'error (list (apply 'format args)))))
242(set-advertised-calling-convention 'error '(string &rest args)) 242(set-advertised-calling-convention 'error '(string &rest args) "23.1")
243 243
244;; We put this here instead of in frame.el so that it's defined even on 244;; We put this here instead of in frame.el so that it's defined even on
245;; systems where frame.el isn't loaded. 245;; systems where frame.el isn't loaded.
@@ -1039,9 +1039,10 @@ is converted into a string by expressing it in decimal."
1039(make-obsolete 'make-variable-frame-local 1039(make-obsolete 'make-variable-frame-local
1040 "explicitly check for a frame-parameter instead." "22.2") 1040 "explicitly check for a frame-parameter instead." "22.2")
1041(make-obsolete 'interactive-p 'called-interactively-p "23.2") 1041(make-obsolete 'interactive-p 'called-interactively-p "23.2")
1042(set-advertised-calling-convention 'called-interactively-p '(kind)) 1042(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
1043(set-advertised-calling-convention 1043(set-advertised-calling-convention
1044 'all-completions '(string collection &optional predicate)) 1044 'all-completions '(string collection &optional predicate) "23.1")
1045(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
1045 1046
1046;;;; Obsolescence declarations for variables, and aliases. 1047;;;; Obsolescence declarations for variables, and aliases.
1047 1048
@@ -2064,7 +2065,7 @@ floating point support."
2064 (setq read (cons t read))) 2065 (setq read (cons t read)))
2065 (push read unread-command-events) 2066 (push read unread-command-events)
2066 nil)))))) 2067 nil))))))
2067(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp)) 2068(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
2068 2069
2069;;; Atomic change groups. 2070;;; Atomic change groups.
2070 2071
@@ -2592,7 +2593,7 @@ discouraged."
2592 (start-process name buffer shell-file-name shell-command-switch 2593 (start-process name buffer shell-file-name shell-command-switch
2593 (mapconcat 'identity args " "))) 2594 (mapconcat 'identity args " ")))
2594(set-advertised-calling-convention 'start-process-shell-command 2595(set-advertised-calling-convention 'start-process-shell-command
2595 '(name buffer command)) 2596 '(name buffer command) "23.1")
2596 2597
2597(defun start-file-process-shell-command (name buffer &rest args) 2598(defun start-file-process-shell-command (name buffer &rest args)
2598 "Start a program in a subprocess. Return the process object for it. 2599 "Start a program in a subprocess. Return the process object for it.
@@ -2603,7 +2604,7 @@ Similar to `start-process-shell-command', but calls `start-file-process'."
2603 (if (file-remote-p default-directory) "-c" shell-command-switch) 2604 (if (file-remote-p default-directory) "-c" shell-command-switch)
2604 (mapconcat 'identity args " "))) 2605 (mapconcat 'identity args " ")))
2605(set-advertised-calling-convention 'start-file-process-shell-command 2606(set-advertised-calling-convention 'start-file-process-shell-command
2606 '(name buffer command)) 2607 '(name buffer command) "23.1")
2607 2608
2608(defun call-process-shell-command (command &optional infile buffer display 2609(defun call-process-shell-command (command &optional infile buffer display
2609 &rest args) 2610 &rest args)
@@ -3358,6 +3359,52 @@ clone should be incorporated in the clone."
3358 (overlay-put ol2 'evaporate t) 3359 (overlay-put ol2 'evaporate t)
3359 (overlay-put ol2 'text-clones dups))) 3360 (overlay-put ol2 'text-clones dups)))
3360 3361
3362;;;; Misc functions moved over from the C side.
3363
3364(defun y-or-n-p (prompt)
3365 "Ask user a \"y or n\" question. Return t if answer is \"y\".
3366The argument PROMPT is the string to display to ask the question.
3367It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
3368No confirmation of the answer is requested; a single character is enough.
3369Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
3370the bindings in `query-replace-map'; see the documentation of that variable
3371for more information. In this case, the useful bindings are `act', `skip',
3372`recenter', and `quit'.\)
3373
3374Under a windowing system a dialog box will be used if `last-nonmenu-event'
3375is nil and `use-dialog-box' is non-nil."
3376 ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
3377 ;; where all the keys were unbound (i.e. it somehow got triggered
3378 ;; within read-key, apparently). I had to kill it.
3379 (let ((answer 'none)
3380 (xprompt prompt))
3381 (if (and (display-popup-menus-p)
3382 (listp last-nonmenu-event)
3383 use-dialog-box)
3384 (setq answer
3385 (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
3386 (while
3387 (let* ((key
3388 (let ((cursor-in-echo-area t))
3389 (when minibuffer-auto-raise
3390 (raise-frame (window-frame (minibuffer-window))))
3391 (read-key (propertize xprompt 'face 'minibuffer-prompt)))))
3392 (setq answer (lookup-key query-replace-map (vector key) t))
3393 (cond
3394 ((memq answer '(skip act)) nil)
3395 ((eq answer 'recenter) (recenter) t)
3396 ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
3397 (t t)))
3398 (ding)
3399 (discard-input)
3400 (setq xprompt
3401 (if (eq answer 'recenter) prompt
3402 (concat "Please answer y or n. " prompt)))))
3403 (let ((ret (eq answer 'act)))
3404 (unless noninteractive
3405 (message "%s %s" prompt (if ret "y" "n")))
3406 ret)))
3407
3361;;;; Mail user agents. 3408;;;; Mail user agents.
3362 3409
3363;; Here we include just enough for other packages to be able 3410;; Here we include just enough for other packages to be able
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 70b12fcfac9..0662acf2c50 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3027,12 +3027,14 @@ if that value is non-nil.
3027 ;; brace-delimited ones 3027 ;; brace-delimited ones
3028 ) 3028 )
3029 nil 3029 nil
3030 (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)
3031 (font-lock-extra-managed-props . (category)) 3030 (font-lock-extra-managed-props . (category))
3032 (font-lock-mark-block-function 3031 (font-lock-mark-block-function
3033 . (lambda () 3032 . (lambda ()
3034 (set-mark (bibtex-end-of-entry)) 3033 (set-mark (bibtex-end-of-entry))
3035 (bibtex-beginning-of-entry))))) 3034 (bibtex-beginning-of-entry)))))
3035 (set (make-local-variable 'syntax-propertize-function)
3036 (syntax-propertize-via-font-lock
3037 bibtex-font-lock-syntactic-keywords))
3036 (setq imenu-generic-expression 3038 (setq imenu-generic-expression
3037 (list (list nil bibtex-entry-head bibtex-key-in-head)) 3039 (list (list nil bibtex-entry-head bibtex-key-in-head))
3038 imenu-case-fold-search t) 3040 imenu-case-fold-search t)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0e853cc3ccd..ad2838adaa9 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1116,26 +1116,24 @@ The variable `ispell-library-directory' defines the library location."
1116 1116
1117 (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist)) 1117 (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
1118 (dict-list (cons "default" nil)) 1118 (dict-list (cons "default" nil))
1119 name load-dict) 1119 name dict-bname)
1120 (dolist (dict dicts) 1120 (dolist (dict dicts)
1121 (setq name (car dict) 1121 (setq name (car dict)
1122 load-dict (car (cdr (member "-d" (nth 5 dict))))) 1122 dict-bname (or (car (cdr (member "-d" (nth 5 dict))))
1123 name))
1123 ;; Include if the dictionary is in the library, or dir not defined. 1124 ;; Include if the dictionary is in the library, or dir not defined.
1124 (if (and 1125 (if (and
1125 name 1126 name
1126 ;; include all dictionaries if lib directory not known.
1127 ;; For Aspell, we already know which dictionaries exist. 1127 ;; For Aspell, we already know which dictionaries exist.
1128 (or ispell-really-aspell 1128 (or ispell-really-aspell
1129 ;; Include all dictionaries if lib directory not known.
1130 ;; Same for Hunspell, where ispell-library-directory is nil.
1129 (not ispell-library-directory) 1131 (not ispell-library-directory)
1130 (file-exists-p (concat ispell-library-directory 1132 (file-exists-p (concat ispell-library-directory
1131 "/" name ".hash")) 1133 "/" dict-bname ".hash"))
1132 (file-exists-p (concat ispell-library-directory "/" name ".has")) 1134 (file-exists-p (concat ispell-library-directory
1133 (and load-dict 1135 "/" dict-bname ".has"))))
1134 (or (file-exists-p (concat ispell-library-directory 1136 (push name dict-list)))
1135 "/" load-dict ".hash"))
1136 (file-exists-p (concat ispell-library-directory
1137 "/" load-dict ".has"))))))
1138 (setq dict-list (cons name dict-list))))
1139 dict-list)) 1137 dict-list))
1140 1138
1141;;; define commands in menu in opposite order you want them to appear. 1139;;; define commands in menu in opposite order you want them to appear.
@@ -2676,24 +2674,27 @@ Keeps argument list for future ispell invocations for no async support."
2676 ispell-filter-continue nil 2674 ispell-filter-continue nil
2677 ispell-process-directory default-directory) 2675 ispell-process-directory default-directory)
2678 2676
2679 ;; Kill ispell process when killing its associated buffer if using Ispell
2680 ;; per-directory personal dictionaries.
2681 (unless (equal ispell-process-directory (expand-file-name "~/")) 2677 (unless (equal ispell-process-directory (expand-file-name "~/"))
2682 (with-current-buffer 2678 ;; At this point, `ispell-process-directory' will be "~/" unless using
2683 (if (and (window-minibuffer-p) 2679 ;; Ispell with directory-specific dicts and not in XEmacs minibuffer.
2684 (fboundp 'minibuffer-selected-window)) ;; E.g. XEmacs. 2680 ;; If not, kill ispell process when killing buffer. It may be in a
2685 ;; When spellchecking minibuffer contents, assign ispell 2681 ;; removable device that would otherwise become un-mountable.
2686 ;; process to parent buffer if known (not known for XEmacs). 2682 (with-current-buffer
2687 ;; Use (buffer-name) otherwise. 2683 (if (and (window-minibuffer-p) ;; In minibuffer
2684 (fboundp 'minibuffer-selected-window)) ;; Not XEmacs.
2685 ;; In this case kill ispell only when parent buffer is killed
2686 ;; to avoid over and over ispell kill.
2688 (window-buffer (minibuffer-selected-window)) 2687 (window-buffer (minibuffer-selected-window))
2689 (current-buffer)) 2688 (current-buffer))
2690 (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) 2689 ;; 'local does not automatically make hook buffer-local in XEmacs.
2691 nil 'local))) 2690 (if (featurep 'xemacs)
2691 (make-local-hook 'kill-buffer-hook))
2692 (add-hook 'kill-buffer-hook
2693 (lambda () (ispell-kill-ispell t)) nil 'local)))
2692 2694
2693 (if ispell-async-processp 2695 (if ispell-async-processp
2694 (set-process-filter ispell-process 'ispell-filter)) 2696 (set-process-filter ispell-process 'ispell-filter))
2695 ;; protect against bogus binding of `enable-multibyte-characters' in 2697 ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'.
2696 ;; XEmacs.
2697 (if (and (or (featurep 'xemacs) 2698 (if (and (or (featurep 'xemacs)
2698 (and (boundp 'enable-multibyte-characters) 2699 (and (boundp 'enable-multibyte-characters)
2699 enable-multibyte-characters)) 2700 enable-multibyte-characters))
@@ -2729,7 +2730,9 @@ Keeps argument list for future ispell invocations for no async support."
2729 (if extended-char-mode ; ~ extended character mode 2730 (if extended-char-mode ; ~ extended character mode
2730 (ispell-send-string (concat extended-char-mode "\n")))) 2731 (ispell-send-string (concat extended-char-mode "\n"))))
2731 (if ispell-async-processp 2732 (if ispell-async-processp
2732 (set-process-query-on-exit-flag ispell-process nil))))) 2733 (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs
2734 (set-process-query-on-exit-flag ispell-process nil)
2735 (process-kill-without-query ispell-process))))))
2733 2736
2734;;;###autoload 2737;;;###autoload
2735(defun ispell-kill-ispell (&optional no-error) 2738(defun ispell-kill-ispell (&optional no-error)
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index b4b0a281ca6..2a2e725e92e 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -599,7 +599,6 @@ on the menu bar.
599(defvar font-lock-mode) 599(defvar font-lock-mode)
600(defvar font-lock-keywords) 600(defvar font-lock-keywords)
601(defvar font-lock-fontify-region-function) 601(defvar font-lock-fontify-region-function)
602(defvar font-lock-syntactic-keywords)
603 602
604;;; ========================================================================= 603;;; =========================================================================
605;;; 604;;;
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 87ffecd5d5a..bc1af67d587 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -293,11 +293,12 @@ Any terminating `>' or `/' is not matched.")
293(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 293(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
294 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") 294 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
295 295
296(defvar sgml-font-lock-syntactic-keywords 296(defconst sgml-syntax-propertize-function
297 (syntax-propertize-rules
297 ;; Use the `b' style of comments to avoid interference with the -- ... -- 298 ;; Use the `b' style of comments to avoid interference with the -- ... --
298 ;; comments recognized when `sgml-specials' includes ?-. 299 ;; comments recognized when `sgml-specials' includes ?-.
299 ;; FIXME: beware of <!--> blabla <!--> !! 300 ;; FIXME: beware of <!--> blabla <!--> !!
300 '(("\\(<\\)!--" (1 "< b")) 301 ("\\(<\\)!--" (1 "< b"))
301 ("--[ \t\n]*\\(>\\)" (1 "> b")) 302 ("--[ \t\n]*\\(>\\)" (1 "> b"))
302 ;; Double quotes outside of tags should not introduce strings. 303 ;; Double quotes outside of tags should not introduce strings.
303 ;; Be careful to call `syntax-ppss' on a position before the one we're 304 ;; Be careful to call `syntax-ppss' on a position before the one we're
@@ -477,9 +478,9 @@ Do \\[describe-key] on the following bindings to discover what they do.
477 '((sgml-font-lock-keywords 478 '((sgml-font-lock-keywords
478 sgml-font-lock-keywords-1 479 sgml-font-lock-keywords-1
479 sgml-font-lock-keywords-2) 480 sgml-font-lock-keywords-2)
480 nil t nil nil 481 nil t))
481 (font-lock-syntactic-keywords 482 (set (make-local-variable 'syntax-propertize-function)
482 . sgml-font-lock-syntactic-keywords))) 483 sgml-syntax-propertize-function)
483 (set (make-local-variable 'facemenu-add-face-function) 484 (set (make-local-variable 'facemenu-add-face-function)
484 'sgml-mode-facemenu-add-face-function) 485 'sgml-mode-facemenu-add-face-function)
485 (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess)) 486 (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index da0c5396f2c..81a3816c1e8 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -488,7 +488,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
488 ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) 488 ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
489 (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) 489 (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
490 (list 490 (list
491 ;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be 491 ;; tex-font-lock-syntactic-keywords causes the \ of \end{verbatim} to be
492 ;; highlighted as tex-verbatim face. Let's undo that. 492 ;; highlighted as tex-verbatim face. Let's undo that.
493 ;; This is ugly and brittle :-( --Stef 493 ;; This is ugly and brittle :-( --Stef
494 '("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t)) 494 '("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t))
@@ -655,6 +655,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
655 ;; line is re-font-locked on its own. 655 ;; line is re-font-locked on its own.
656 ;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim 656 ;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim
657 ;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef 657 ;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef
658 ;; FIXME: See gud.el for an example of a solution to a similar problem.
658 (eval . `(,(concat "^\\(\\\\\\)end *{" 659 (eval . `(,(concat "^\\(\\\\\\)end *{"
659 (regexp-opt tex-verbatim-environments t) 660 (regexp-opt tex-verbatim-environments t)
660 "}\\(.?\\)") (1 "|") (3 "<"))) 661 "}\\(.?\\)") (1 "|") (3 "<")))
@@ -1163,10 +1164,9 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
1163 (font-lock-syntactic-face-function 1164 (font-lock-syntactic-face-function
1164 . tex-font-lock-syntactic-face-function) 1165 . tex-font-lock-syntactic-face-function)
1165 (font-lock-unfontify-region-function 1166 (font-lock-unfontify-region-function
1166 . tex-font-lock-unfontify-region) 1167 . tex-font-lock-unfontify-region)))
1167 (font-lock-syntactic-keywords 1168 (set (make-local-variable 'syntax-propertize-function)
1168 . tex-font-lock-syntactic-keywords) 1169 (syntax-propertize-via-font-lock tex-font-lock-syntactic-keywords))
1169 (parse-sexp-lookup-properties . t)))
1170 ;; TABs in verbatim environments don't do what you think. 1170 ;; TABs in verbatim environments don't do what you think.
1171 (set (make-local-variable 'indent-tabs-mode) nil) 1171 (set (make-local-variable 'indent-tabs-mode) nil)
1172 ;; Other vars that should be buffer-local. 1172 ;; Other vars that should be buffer-local.
@@ -2850,12 +2850,12 @@ There might be text before point."
2850 (mapcar 2850 (mapcar
2851 (lambda (x) 2851 (lambda (x)
2852 (case (car-safe x) 2852 (case (car-safe x)
2853 (font-lock-syntactic-keywords
2854 (cons (car x) 'doctex-font-lock-syntactic-keywords))
2855 (font-lock-syntactic-face-function 2853 (font-lock-syntactic-face-function
2856 (cons (car x) 'doctex-font-lock-syntactic-face-function)) 2854 (cons (car x) 'doctex-font-lock-syntactic-face-function))
2857 (t x))) 2855 (t x)))
2858 (cdr font-lock-defaults))))) 2856 (cdr font-lock-defaults))))
2857 (set (make-local-variable 'syntax-propertize-function)
2858 (syntax-propertize-via-font-lock doctex-font-lock-syntactic-keywords)))
2859 2859
2860(run-hooks 'tex-mode-load-hook) 2860(run-hooks 'tex-mode-load-hook)
2861 2861
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 7c71acd044b..be23a439bf3 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -310,10 +310,11 @@ chapter."
310 ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) 310 ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
311 "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.") 311 "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.")
312 312
313(defvar texinfo-font-lock-syntactic-keywords 313(defconst texinfo-syntax-propertize-function
314 '(("\\(@\\)c\\(omment\\)?\\>" (1 "<")) 314 (syntax-propertize-rules
315 ("^\\(@\\)ignore\\>" (1 "< b")) 315 ("\\(@\\)c\\(omment\\)?\\>" (1 "<"))
316 ("^@end ignore\\(\n\\)" (1 "> b"))) 316 ("^\\(@\\)ignore\\>" (1 "< b"))
317 ("^@end ignore\\(\n\\)" (1 "> b")))
317 "Syntactic keywords to catch comment delimiters in `texinfo-mode'.") 318 "Syntactic keywords to catch comment delimiters in `texinfo-mode'.")
318 319
319(defconst texinfo-environments 320(defconst texinfo-environments
@@ -600,9 +601,9 @@ value of `texinfo-mode-hook'."
600 (setq imenu-case-fold-search nil) 601 (setq imenu-case-fold-search nil)
601 (make-local-variable 'font-lock-defaults) 602 (make-local-variable 'font-lock-defaults)
602 (setq font-lock-defaults 603 (setq font-lock-defaults
603 '(texinfo-font-lock-keywords nil nil nil backward-paragraph 604 '(texinfo-font-lock-keywords nil nil nil backward-paragraph))
604 (font-lock-syntactic-keywords 605 (set (make-local-variable 'syntax-propertize-function)
605 . texinfo-font-lock-syntactic-keywords))) 606 texinfo-syntax-propertize-function)
606 (set (make-local-variable 'parse-sexp-lookup-properties) t) 607 (set (make-local-variable 'parse-sexp-lookup-properties) t)
607 608
608 ;; Outline settings. 609 ;; Outline settings.
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index e3f76e72e37..7726f6cd081 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,20 @@
12010-09-14 Julien Danjou <julien@danjou.info>
2
3 * url-cache (url-store-in-cache): Make `buff' argument really optional.
4
52010-09-14 Glenn Morris <rgm@gnu.org>
6
7 * url-cookie.el (url-cookie-expired-p): Tweak previous change.
8
92010-09-14 shawn boles <shawn.boles@gmail.com> (tiny change)
10
11 * url-cookie.el (url-cookie-expired-p): Simplify and fix. (Bug#6957)
12
132010-09-11 Glenn Morris <rgm@gnu.org>
14
15 * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el:
16 * url-vars.el: Remove leading `*' from defcustom docs.
17
12010-07-27 Michael Albinus <michael.albinus@gmx.de> 182010-07-27 Michael Albinus <michael.albinus@gmx.de>
2 19
3 * url-http (url-http-parse-headers): Disable file name handlers at 20 * url-http (url-http-parse-headers): Disable file name handlers at
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 71841c9a0ca..3a6f00db306 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,7 +1,7 @@
1;;; url-cache.el --- Uniform Resource Locator retrieval tool 1;;; url-cache.el --- Uniform Resource Locator retrieval tool
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Keywords: comm, data, processes, hypermedia 6;; Keywords: comm, data, processes, hypermedia
7 7
@@ -28,7 +28,7 @@
28 28
29(defcustom url-cache-directory 29(defcustom url-cache-directory
30 (expand-file-name "cache" url-configuration-directory) 30 (expand-file-name "cache" url-configuration-directory)
31 "*The directory where cache files should be stored." 31 "The directory where cache files should be stored."
32 :type 'directory 32 :type 'directory
33 :group 'url-file) 33 :group 'url-file)
34 34
@@ -62,14 +62,11 @@ FILE can be created or overwritten."
62;;;###autoload 62;;;###autoload
63(defun url-store-in-cache (&optional buff) 63(defun url-store-in-cache (&optional buff)
64 "Store buffer BUFF in the cache." 64 "Store buffer BUFF in the cache."
65 (if (not (and buff (get-buffer buff))) 65 (with-current-buffer (get-buffer (or buff (current-buffer)))
66 nil 66 (let ((fname (url-cache-create-filename (url-view-url t))))
67 (save-current-buffer 67 (if (url-cache-prepare fname)
68 (and buff (set-buffer buff)) 68 (let ((coding-system-for-write 'binary))
69 (let* ((fname (url-cache-create-filename (url-view-url t)))) 69 (write-region (point-min) (point-max) fname nil 5))))))
70 (if (url-cache-prepare fname)
71 (let ((coding-system-for-write 'binary))
72 (write-region (point-min) (point-max) fname nil 5)))))))
73 70
74;;;###autoload 71;;;###autoload
75(defun url-is-cached (url) 72(defun url-is-cached (url)
@@ -165,7 +162,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
165 url-cache-directory)))))) 162 url-cache-directory))))))
166 163
167(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 164(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
168 "*What function to use to create a cached filename." 165 "What function to use to create a cached filename."
169 :type '(choice (const :tag "MD5 of filename (low collision rate)" 166 :type '(choice (const :tag "MD5 of filename (low collision rate)"
170 :value url-cache-create-filename-using-md5) 167 :value url-cache-create-filename-using-md5)
171 (const :tag "Human readable filenames (higher collision rate)" 168 (const :tag "Human readable filenames (higher collision rate)"
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 75a1b218830..2067f097224 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,7 +1,7 @@
1;;; url-cookie.el --- Netscape Cookie support 1;;; url-cookie.el --- Netscape Cookie support
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Keywords: comm, data, processes, hypermedia 6;; Keywords: comm, data, processes, hypermedia
7 7
@@ -24,7 +24,6 @@
24 24
25;;; Code: 25;;; Code:
26 26
27(require 'timezone)
28(require 'url-util) 27(require 'url-util)
29(require 'url-parse) 28(require 'url-parse)
30(eval-when-compile (require 'cl)) 29(eval-when-compile (require 'cl))
@@ -194,34 +193,9 @@ telling Microsoft that."
194 (setq url-cookie-storage (list (list domain tmp)))))))) 193 (setq url-cookie-storage (list (list domain tmp))))))))
195 194
196(defun url-cookie-expired-p (cookie) 195(defun url-cookie-expired-p (cookie)
197 (let* ( 196 "Return non-nil if COOKIE is expired."
198 (exp (url-cookie-expires cookie)) 197 (let ((exp (url-cookie-expires cookie)))
199 (cur-date (and exp (timezone-parse-date (current-time-string)))) 198 (and exp (> (float-time) (float-time (date-to-time exp))))))
200 (exp-date (and exp (timezone-parse-date exp)))
201 (cur-greg (and cur-date (timezone-absolute-from-gregorian
202 (string-to-number (aref cur-date 1))
203 (string-to-number (aref cur-date 2))
204 (string-to-number (aref cur-date 0)))))
205 (exp-greg (and exp (timezone-absolute-from-gregorian
206 (string-to-number (aref exp-date 1))
207 (string-to-number (aref exp-date 2))
208 (string-to-number (aref exp-date 0)))))
209 (diff-in-days (and exp (- cur-greg exp-greg)))
210 )
211 (cond
212 ((not exp) nil) ; No expiry == expires at browser quit
213 ((< diff-in-days 0) nil) ; Expires sometime after today
214 ((> diff-in-days 0) t) ; Expired before today
215 (t ; Expires sometime today, check times
216 (let* ((cur-time (timezone-parse-time (aref cur-date 3)))
217 (exp-time (timezone-parse-time (aref exp-date 3)))
218 (cur-norm (+ (* 360 (string-to-number (aref cur-time 2)))
219 (* 60 (string-to-number (aref cur-time 1)))
220 (* 1 (string-to-number (aref cur-time 0)))))
221 (exp-norm (+ (* 360 (string-to-number (aref exp-time 2)))
222 (* 60 (string-to-number (aref exp-time 1)))
223 (* 1 (string-to-number (aref exp-time 0))))))
224 (> (- cur-norm exp-norm) 1))))))
225 199
226(defun url-cookie-retrieve (host &optional localpart secure) 200(defun url-cookie-retrieve (host &optional localpart secure)
227 "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART." 201 "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART."
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 9915ccc6781..714d12f3f10 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -37,50 +37,50 @@
37 :group 'url) 37 :group 'url)
38 38
39(defcustom url-gateway-local-host-regexp nil 39(defcustom url-gateway-local-host-regexp nil
40 "*A regular expression specifying local hostnames/machines." 40 "A regular expression specifying local hostnames/machines."
41 :type '(choice (const nil) regexp) 41 :type '(choice (const nil) regexp)
42 :group 'url-gateway) 42 :group 'url-gateway)
43 43
44(defcustom url-gateway-prompt-pattern 44(defcustom url-gateway-prompt-pattern
45 "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" 45 "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
46 "*A regular expression matching a shell prompt." 46 "A regular expression matching a shell prompt."
47 :type 'regexp 47 :type 'regexp
48 :group 'url-gateway) 48 :group 'url-gateway)
49 49
50(defcustom url-gateway-rlogin-host nil 50(defcustom url-gateway-rlogin-host nil
51 "*What hostname to actually rlog into before doing a telnet." 51 "What hostname to actually rlog into before doing a telnet."
52 :type '(choice (const nil) string) 52 :type '(choice (const nil) string)
53 :group 'url-gateway) 53 :group 'url-gateway)
54 54
55(defcustom url-gateway-rlogin-user-name nil 55(defcustom url-gateway-rlogin-user-name nil
56 "*Username to log into the remote machine with when using rlogin." 56 "Username to log into the remote machine with when using rlogin."
57 :type '(choice (const nil) string) 57 :type '(choice (const nil) string)
58 :group 'url-gateway) 58 :group 'url-gateway)
59 59
60(defcustom url-gateway-rlogin-parameters '("telnet" "-8") 60(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
61 "*Parameters to `url-open-rlogin'. 61 "Parameters to `url-open-rlogin'.
62This list will be used as the parameter list given to rsh." 62This list will be used as the parameter list given to rsh."
63 :type '(repeat string) 63 :type '(repeat string)
64 :group 'url-gateway) 64 :group 'url-gateway)
65 65
66(defcustom url-gateway-telnet-host nil 66(defcustom url-gateway-telnet-host nil
67 "*What hostname to actually login to before doing a telnet." 67 "What hostname to actually login to before doing a telnet."
68 :type '(choice (const nil) string) 68 :type '(choice (const nil) string)
69 :group 'url-gateway) 69 :group 'url-gateway)
70 70
71(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") 71(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
72 "*Parameters to `url-open-telnet'. 72 "Parameters to `url-open-telnet'.
73This list will be executed as a command after logging in via telnet." 73This list will be executed as a command after logging in via telnet."
74 :type '(repeat string) 74 :type '(repeat string)
75 :group 'url-gateway) 75 :group 'url-gateway)
76 76
77(defcustom url-gateway-telnet-login-prompt "^\r*.?login:" 77(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
78 "*Prompt that tells us we should send our username when loggin in w/telnet." 78 "Prompt that tells us we should send our username when loggin in w/telnet."
79 :type 'regexp 79 :type 'regexp
80 :group 'url-gateway) 80 :group 'url-gateway)
81 81
82(defcustom url-gateway-telnet-password-prompt "^\r*.?password:" 82(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
83 "*Prompt that tells us we should send our password when loggin in w/telnet." 83 "Prompt that tells us we should send our password when loggin in w/telnet."
84 :type 'regexp 84 :type 'regexp
85 :group 'url-gateway) 85 :group 'url-gateway)
86 86
@@ -95,7 +95,7 @@ This list will be executed as a command after logging in via telnet."
95 :group 'url-gateway) 95 :group 'url-gateway)
96 96
97(defcustom url-gateway-broken-resolution nil 97(defcustom url-gateway-broken-resolution nil
98 "*Whether to use nslookup to resolve hostnames. 98 "Whether to use nslookup to resolve hostnames.
99This should be used when your version of Emacs cannot correctly use DNS, 99This should be used when your version of Emacs cannot correctly use DNS,
100but your machine can. This usually happens if you are running a statically 100but your machine can. This usually happens if you are running a statically
101linked Emacs under SunOS 4.x." 101linked Emacs under SunOS 4.x."
@@ -103,7 +103,7 @@ linked Emacs under SunOS 4.x."
103 :group 'url-gateway) 103 :group 'url-gateway)
104 104
105(defcustom url-gateway-nslookup-program "nslookup" 105(defcustom url-gateway-nslookup-program "nslookup"
106 "*If non-nil then a string naming nslookup program." 106 "If non-nil then a string naming nslookup program."
107 :type '(choice (const :tag "None" :value nil) string) 107 :type '(choice (const :tag "None" :value nil) string)
108 :group 'url-gateway) 108 :group 'url-gateway)
109 109
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 5b4f330ed2e..0cc891b32b7 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,7 +1,7 @@
1;;; url-history.el --- Global history tracking for URL package 1;;; url-history.el --- Global history tracking for URL package
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Keywords: comm, data, processes, hypermedia 6;; Keywords: comm, data, processes, hypermedia
7 7
@@ -35,7 +35,7 @@
35 :group 'url) 35 :group 'url)
36 36
37(defcustom url-history-track nil 37(defcustom url-history-track nil
38 "*Controls whether to keep a list of all the URLs being visited. 38 "Controls whether to keep a list of all the URLs being visited.
39If non-nil, the URL package will keep track of all the URLs visited. 39If non-nil, the URL package will keep track of all the URLs visited.
40If set to t, then the list is saved to disk at the end of each Emacs 40If set to t, then the list is saved to disk at the end of each Emacs
41session." 41session."
@@ -49,14 +49,14 @@ session."
49 :group 'url-history) 49 :group 'url-history)
50 50
51(defcustom url-history-file nil 51(defcustom url-history-file nil
52 "*The global history file for the URL package. 52 "The global history file for the URL package.
53This file contains a list of all the URLs you have visited. This file 53This file contains a list of all the URLs you have visited. This file
54is parsed at startup and used to provide URL completion." 54is parsed at startup and used to provide URL completion."
55 :type '(choice (const :tag "Default" :value nil) file) 55 :type '(choice (const :tag "Default" :value nil) file)
56 :group 'url-history) 56 :group 'url-history)
57 57
58(defcustom url-history-save-interval 3600 58(defcustom url-history-save-interval 3600
59 "*The number of seconds between automatic saves of the history list. 59 "The number of seconds between automatic saves of the history list.
60Default is 1 hour. Note that if you change this variable outside of 60Default is 1 hour. Note that if you change this variable outside of
61the `customize' interface after `url-do-setup' has been run, you need 61the `customize' interface after `url-do-setup' has been run, you need
62to run the `url-history-setup-save-timer' function manually." 62to run the `url-history-setup-save-timer' function manually."
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 1469cb9eb8b..715eecd211c 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,7 +1,7 @@
1;;; url-irc.el --- IRC URL interface 1;;; url-irc.el --- IRC URL interface
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Keywords: comm, data, processes 6;; Keywords: comm, data, processes
7 7
@@ -22,7 +22,8 @@
22 22
23;;; Commentary: 23;;; Commentary:
24 24
25;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt 25;; IRC URLs are defined in
26;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
26 27
27;;; Code: 28;;; Code:
28 29
@@ -32,7 +33,7 @@
32(defconst url-irc-default-port 6667 "Default port for IRC connections.") 33(defconst url-irc-default-port 6667 "Default port for IRC connections.")
33 34
34(defcustom url-irc-function 'url-irc-rcirc 35(defcustom url-irc-function 'url-irc-rcirc
35 "*Function to actually open an IRC connection. 36 "Function to actually open an IRC connection.
36The function should take the following arguments: 37The function should take the following arguments:
37 HOST - the hostname of the IRC server to contact 38 HOST - the hostname of the IRC server to contact
38 PORT - the port number of the IRC server to contact 39 PORT - the port number of the IRC server to contact
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index e92ccc76285..8beffe60a7f 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -43,7 +43,7 @@
43 43
44;;;###autoload 44;;;###autoload
45(defcustom url-debug nil 45(defcustom url-debug nil
46 "*What types of debug messages from the URL library to show. 46 "What types of debug messages from the URL library to show.
47Debug messages are logged to the *URL-DEBUG* buffer. 47Debug messages are logged to the *URL-DEBUG* buffer.
48 48
49If t, all messages will be logged. 49If t, all messages will be logged.
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 65622a06e02..74192478224 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,7 +1,7 @@
1;;; url-vars.el --- Variables for Uniform Resource Locator tool 1;;; url-vars.el --- Variables for Uniform Resource Locator tool
2 2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 3;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Keywords: comm, data, processes, hypermedia 6;; Keywords: comm, data, processes, hypermedia
7 7
@@ -68,7 +68,7 @@
68 )) 68 ))
69 69
70(defcustom url-honor-refresh-requests t 70(defcustom url-honor-refresh-requests t
71 "*Whether to do automatic page reloads. 71 "Whether to do automatic page reloads.
72These are done at the request of the document author or the server via 72These are done at the request of the document author or the server via
73the `Refresh' header in an HTTP response. If nil, no refresh 73the `Refresh' header in an HTTP response. If nil, no refresh
74requests will be honored. If t, all refresh requests will be honored. 74requests will be honored. If t, all refresh requests will be honored.
@@ -79,14 +79,14 @@ If non-nil and not t, the user will be asked for each refresh request."
79 :group 'url-hairy) 79 :group 'url-hairy)
80 80
81(defcustom url-automatic-caching nil 81(defcustom url-automatic-caching nil
82 "*If non-nil, all documents will be automatically cached to the local disk." 82 "If non-nil, all documents will be automatically cached to the local disk."
83 :type 'boolean 83 :type 'boolean
84 :group 'url-cache) 84 :group 'url-cache)
85 85
86;; Fixme: sanitize this. 86;; Fixme: sanitize this.
87(defcustom url-cache-expired 87(defcustom url-cache-expired
88 (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)) 88 (lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
89 "*A function determining if a cached item has expired. 89 "A function determining if a cached item has expired.
90It takes two times (numbers) as its arguments, and returns non-nil if 90It takes two times (numbers) as its arguments, and returns non-nil if
91the second time is 'too old' when compared to the first time." 91the second time is 'too old' when compared to the first time."
92 :type 'function 92 :type 'function
@@ -96,14 +96,14 @@ the second time is 'too old' when compared to the first time."
96 "Where to send bug reports.") 96 "Where to send bug reports.")
97 97
98(defcustom url-personal-mail-address nil 98(defcustom url-personal-mail-address nil
99 "*Your full email address. 99 "Your full email address.
100This is what is sent to HTTP servers as the FROM field in an HTTP 100This is what is sent to HTTP servers as the FROM field in an HTTP
101request." 101request."
102 :type '(choice (const :tag "Unspecified" nil) string) 102 :type '(choice (const :tag "Unspecified" nil) string)
103 :group 'url) 103 :group 'url)
104 104
105(defcustom url-directory-index-file "index.html" 105(defcustom url-directory-index-file "index.html"
106 "*The filename to look for when indexing a directory. 106 "The filename to look for when indexing a directory.
107If this file exists, and is readable, then it will be viewed instead of 107If this file exists, and is readable, then it will be viewed instead of
108using `dired' to view the directory." 108using `dired' to view the directory."
109 :type 'string 109 :type 'string
@@ -166,14 +166,14 @@ variable."
166 (".hqx" . "x-hqx") 166 (".hqx" . "x-hqx")
167 (".Z" . "x-compress") 167 (".Z" . "x-compress")
168 (".bz2" . "x-bzip2")) 168 (".bz2" . "x-bzip2"))
169 "*An alist of file extensions and appropriate content-transfer-encodings." 169 "An alist of file extensions and appropriate content-transfer-encodings."
170 :type '(repeat (cons :format "%v" 170 :type '(repeat (cons :format "%v"
171 (string :tag "Extension") 171 (string :tag "Extension")
172 (string :tag "Encoding"))) 172 (string :tag "Encoding")))
173 :group 'url-mime) 173 :group 'url-mime)
174 174
175(defcustom url-mail-command 'compose-mail 175(defcustom url-mail-command 'compose-mail
176 "*This function will be called whenever URL needs to send mail. 176 "This function will be called whenever URL needs to send mail.
177It should enter a mail-mode-like buffer in the current window. 177It should enter a mail-mode-like buffer in the current window.
178The commands `mail-to' and `mail-subject' should still work in this 178The commands `mail-to' and `mail-subject' should still work in this
179buffer, and it should use `mail-header-separator' if possible." 179buffer, and it should use `mail-header-separator' if possible."
@@ -181,7 +181,7 @@ buffer, and it should use `mail-header-separator' if possible."
181 :group 'url) 181 :group 'url)
182 182
183(defcustom url-proxy-services nil 183(defcustom url-proxy-services nil
184 "*An alist of schemes and proxy servers that gateway them. 184 "An alist of schemes and proxy servers that gateway them.
185Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up 185Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up
186from the ACCESS_proxy environment variables." 186from the ACCESS_proxy environment variables."
187 :type '(repeat (cons :format "%v" 187 :type '(repeat (cons :format "%v"
@@ -190,7 +190,7 @@ from the ACCESS_proxy environment variables."
190 :group 'url) 190 :group 'url)
191 191
192(defcustom url-standalone-mode nil 192(defcustom url-standalone-mode nil
193 "*Rely solely on the cache?" 193 "Rely solely on the cache?"
194 :type 'boolean 194 :type 'boolean
195 :group 'url-cache) 195 :group 'url-cache)
196 196
@@ -202,7 +202,7 @@ from the ACCESS_proxy environment variables."
202 202
203(defcustom url-bad-port-list 203(defcustom url-bad-port-list
204 '("25" "119" "19") 204 '("25" "119" "19")
205 "*List of ports to warn the user about connecting to. 205 "List of ports to warn the user about connecting to.
206Defaults to just the mail, chargen, and NNTP ports so you cannot be 206Defaults to just the mail, chargen, and NNTP ports so you cannot be
207tricked into sending fake mail or forging messages by a malicious HTML 207tricked into sending fake mail or forging messages by a malicious HTML
208document." 208document."
@@ -255,7 +255,7 @@ given priority 1 and the rest are given priority 0.5.")
255 255
256;; Fixme: set from the locale. 256;; Fixme: set from the locale.
257(defcustom url-mime-language-string nil 257(defcustom url-mime-language-string nil
258 "*String to send in the Accept-language: field in HTTP requests. 258 "String to send in the Accept-language: field in HTTP requests.
259 259
260Specifies the preferred language when servers can serve documents in 260Specifies the preferred language when servers can serve documents in
261several languages. Use RFC 1766 abbreviations, e.g.: `en' for 261several languages. Use RFC 1766 abbreviations, e.g.: `en' for
@@ -284,20 +284,20 @@ get the first available language (as opposed to the default)."
284 "What OS we are on.") 284 "What OS we are on.")
285 285
286(defcustom url-max-password-attempts 5 286(defcustom url-max-password-attempts 5
287 "*Maximum number of times a password will be prompted for. 287 "Maximum number of times a password will be prompted for.
288Applies when a protected document is denied by the server." 288Applies when a protected document is denied by the server."
289 :type 'integer 289 :type 'integer
290 :group 'url) 290 :group 'url)
291 291
292(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") 292(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
293 "*Where temporary files go." 293 "Where temporary files go."
294 :type 'directory 294 :type 'directory
295 :group 'url-file) 295 :group 'url-file)
296(make-obsolete-variable 'url-temporary-directory 296(make-obsolete-variable 'url-temporary-directory
297 'temporary-file-directory "23.1") 297 'temporary-file-directory "23.1")
298 298
299(defcustom url-show-status t 299(defcustom url-show-status t
300 "*Whether to show a running total of bytes transferred. 300 "Whether to show a running total of bytes transferred.
301Can cause a large hit if using a remote X display over a slow link, or 301Can cause a large hit if using a remote X display over a slow link, or
302a terminal with a slow modem." 302a terminal with a slow modem."
303 :type 'boolean 303 :type 'boolean
@@ -308,7 +308,7 @@ a terminal with a slow modem."
308http://www.example.com/") 308http://www.example.com/")
309 309
310(defcustom url-news-server nil 310(defcustom url-news-server nil
311 "*The default news server from which to get newsgroups/articles. 311 "The default news server from which to get newsgroups/articles.
312Applies if no server is specified in the URL. Defaults to the 312Applies if no server is specified in the URL. Defaults to the
313environment variable NNTPSERVER or \"news\" if NNTPSERVER is 313environment variable NNTPSERVER or \"news\" if NNTPSERVER is
314undefined." 314undefined."
@@ -320,13 +320,13 @@ undefined."
320 "A regular expression that will match an absolute URL.") 320 "A regular expression that will match an absolute URL.")
321 321
322(defcustom url-max-redirections 30 322(defcustom url-max-redirections 30
323 "*The maximum number of redirection requests to honor in a HTTP connection. 323 "The maximum number of redirection requests to honor in a HTTP connection.
324A negative number means to honor an unlimited number of redirection requests." 324A negative number means to honor an unlimited number of redirection requests."
325 :type 'integer 325 :type 'integer
326 :group 'url) 326 :group 'url)
327 327
328(defcustom url-confirmation-func 'y-or-n-p 328(defcustom url-confirmation-func 'y-or-n-p
329 "*What function to use for asking yes or no functions. 329 "What function to use for asking yes or no functions.
330Possible values are `yes-or-no-p' or `y-or-n-p', or any function that 330Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
331takes a single argument (the prompt), and returns t only if a positive 331takes a single argument (the prompt), and returns t only if a positive
332answer is given." 332answer is given."
@@ -336,7 +336,7 @@ answer is given."
336 :group 'url-hairy) 336 :group 'url-hairy)
337 337
338(defcustom url-gateway-method 'native 338(defcustom url-gateway-method 'native
339 "*The type of gateway support to use. 339 "The type of gateway support to use.
340Should be a symbol specifying how to get a connection from the local machine. 340Should be a symbol specifying how to get a connection from the local machine.
341 341
342Currently supported methods: 342Currently supported methods:
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c087a4d9e1f..689cd4d12bd 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -171,10 +171,12 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
171 (let ((process-environment 171 (let ((process-environment
172 ;; Avoid localization of messages so we 172 ;; Avoid localization of messages so we
173 ;; can parse the output. 173 ;; can parse the output.
174 (append (list "TERM=dumb" "LANGUAGE=C" "HGRCPATH=") 174 (append (list "TERM=dumb" "LANGUAGE=C")
175 process-environment))) 175 process-environment)))
176 (process-file 176 (process-file
177 "hg" nil t nil 177 "hg" nil t nil
178 "--config" "alias.status=status"
179 "--config" "defaults.status="
178 "status" "-A" (file-relative-name file))) 180 "status" "-A" (file-relative-name file)))
179 ;; Some problem happened. E.g. We can't find an `hg' 181 ;; Some problem happened. E.g. We can't find an `hg'
180 ;; executable. 182 ;; executable.
@@ -199,7 +201,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
199 ((status nil) 201 ((status nil)
200 (default-directory (file-name-directory file)) 202 (default-directory (file-name-directory file))
201 ;; Avoid localization of messages so we can parse the output. 203 ;; Avoid localization of messages so we can parse the output.
202 (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C" "HGRCPATH=") 204 (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C")
203 process-environment)) 205 process-environment))
204 (out 206 (out
205 (with-output-to-string 207 (with-output-to-string
@@ -211,6 +213,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
211 ;; Ignore all errors. 213 ;; Ignore all errors.
212 (process-file 214 (process-file
213 "hg" nil t nil 215 "hg" nil t nil
216 "--config" "alias.parents=parents"
217 "--config" "defaults.parents="
214 "parents" "--template" "{rev}" (file-relative-name file))) 218 "parents" "--template" "{rev}" (file-relative-name file)))
215 ;; Some problem happened. E.g. We can't find an `hg' 219 ;; Some problem happened. E.g. We can't find an `hg'
216 ;; executable. 220 ;; executable.
diff --git a/make-dist b/make-dist
index 95512c7f482..a113e00413b 100755
--- a/make-dist
+++ b/make-dist
@@ -398,10 +398,10 @@ echo "Making links to \`lisp' and its subdirectories"
398 mkdir -p ../${tempdir}/lisp/$file 398 mkdir -p ../${tempdir}/lisp/$file
399 ln $file/[a-zA-Z0-9]*.el ../${tempdir}/lisp/$file 399 ln $file/[a-zA-Z0-9]*.el ../${tempdir}/lisp/$file
400 ln $file/[a-zA-Z0-9]*.elc ../${tempdir}/lisp/$file 400 ln $file/[a-zA-Z0-9]*.elc ../${tempdir}/lisp/$file
401 ## calc/README.priv, nxml/TODO 401 ## calc/README.priv
402 for f in $file/[a-zA-Z]*.xpm $file/[a-zA-Z]*.[xp]bm \ 402 for f in $file/[a-zA-Z]*.xpm $file/[a-zA-Z]*.[xp]bm \
403 $file/README $file/ChangeLog $file/ChangeLog.*[0-9] \ 403 $file/README $file/ChangeLog $file/ChangeLog.*[0-9] \
404 $file/README.prev $file/TODO; do 404 $file/README.prev; do
405 if [ -f $f ]; then 405 if [ -f $f ]; then
406 ln $f ../${tempdir}/lisp/$file 406 ln $f ../${tempdir}/lisp/$file
407 fi 407 fi
diff --git a/src/ChangeLog b/src/ChangeLog
index 5a248bacc03..d62215e4eef 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -3,6 +3,69 @@
3 * ftfont.c (ftfont_check_otf): Fix the case of checking just 3 * ftfont.c (ftfont_check_otf): Fix the case of checking just
4 existence of GSUB or GPOS. 4 existence of GSUB or GPOS.
5 5
62010-09-14 Juanma Barranquero <lekktu@gmail.com>
7
8 * cmds.c (syms_of_cmds) <post-self-insert-hook>: Fix typos in docstring.
9
102010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
11
12 * xml.c (parse_buffer): Renamed to parse_string(), since that's
13 what it does.
14 (parse_string): Return nil when the document can't be parsed.
15
162010-09-14 Jan Djärv <jan.h.d@swipnet.se>
17
18 * xterm.c (get_current_vm_state): New function.
19 (do_ewmh_fullscreen): Call get_current_vm_state and compare with
20 want_fullscreen so set_wm_state calls are few (Bug#7013).
21 (x_handle_net_wm_state): Move code to get_current_vm_state and
22 call that function.
23
242010-09-14 Courtney Bane <emacs-bugs-7626@cbane.org> (tiny change)
25
26 * term.c (tty_set_terminal_modes): Don't initialize twice (bug#7002).
27
282010-09-14 Kenichi Handa <handa@m17n.org>
29
30 * coding.c (encode_coding_iso_2022): Don't optimize for ASCII if
31 we may use designation or locking-shift.
32
332010-09-14 Kenichi Handa <handa@m17n.org>
34
35 * coding.c (detect_coding_emacs_mule): Fix checking of multibyte
36 sequence when the source is multibyte.
37
382010-09-14 Andreas Schwab <schwab@linux-m68k.org>
39
40 * xml.c (Fxml_parse_string, Fxml_parse_string): Revert last change.
41 Don't make first argument optional. Doc fix.
42
432010-09-14 Leo <sdl.web@gmail.com> (tiny change)
44
45 * xml.c (Fxml_parse_string, Fhtml_parse_string): Fix up the
46 parameters for the doc string.
47
482010-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
49
50 * xml.c (Fhtml_parse_string, Fxml_parse_string): Mention BASE-URL.
51
522010-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
53
54 * fns.c (Fy_or_n_p): Move to lisp/subr.el.
55 (syms_of_fns): Don't defsubr Sy_or_n_p.
56 * lisp.h: Don't declare Fy_or_n_p.
57 * fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p.
58
592010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
60
61 * xml.c (Fxml_parse_buffer): New function to parse XML files.
62
632010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
64
65 * xml.c: New file.
66 (Fhtml_parse_buffer): New function to interface to the libxml2
67 html parsing function.
68
62010-09-05 Juanma Barranquero <lekktu@gmail.com> 692010-09-05 Juanma Barranquero <lekktu@gmail.com>
7 70
8 * biditype.h: Regenerate. 71 * biditype.h: Regenerate.
@@ -65,8 +128,8 @@
65 characters. 128 characters.
66 129
67 * term.c (encode_terminal_code): Fix the previous change. 130 * term.c (encode_terminal_code): Fix the previous change.
68 (produce_glyphs): Don't set it->char_to_display here. Don't 131 (produce_glyphs): Don't set it->char_to_display here.
69 handle unibyte-display-via-language-environment here. 132 Don't handle unibyte-display-via-language-environment here.
70 (produce_special_glyphs): Set temp_it.char_to_display before 133 (produce_special_glyphs): Set temp_it.char_to_display before
71 calling produce_glyphs. 134 calling produce_glyphs.
72 135
@@ -85,9 +148,9 @@
85 (produce_stretch_glyph): Set it2.char_to_display too before 148 (produce_stretch_glyph): Set it2.char_to_display too before
86 calling x_produce_glyphs. 149 calling x_produce_glyphs.
87 (x_produce_glyphs): Simplify by using the same code for ASCII and 150 (x_produce_glyphs): Simplify by using the same code for ASCII and
88 non-ASCII characters. Don't set it->char_to_display here. Don't 151 non-ASCII characters. Don't set it->char_to_display here.
89 handle unibyte-display-via-language-environment here. For a 152 Don't handle unibyte-display-via-language-environment here. For a
90 charater of no glyph, use font->space_width instead of FONT_WIDTH. 153 character of no glyph, use font->space_width instead of FONT_WIDTH.
91 154
922010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> 1552010-08-31 Stefan Monnier <monnier@iro.umontreal.ca>
93 156
@@ -109,7 +172,7 @@
1092010-08-29 Kenichi Handa <handa@m17n.org> 1722010-08-29 Kenichi Handa <handa@m17n.org>
110 173
111 * term.c (encode_terminal_code): Encode byte chars to the 174 * term.c (encode_terminal_code): Encode byte chars to the
112 correspnding bytes. 175 corresponding bytes.
113 176
1142010-08-29 Jan Djärv <jan.h.d@swipnet.se> 1772010-08-29 Jan Djärv <jan.h.d@swipnet.se>
115 178
@@ -20249,7 +20312,7 @@
20249 20312
20250 * search.c (search_buffer): Give up BM search on case-fold-search 20313 * search.c (search_buffer): Give up BM search on case-fold-search
20251 if one of a target character has a case-equivalence of different 20314 if one of a target character has a case-equivalence of different
20252 byte length even if that target charcter is an ASCII. 20315 byte length even if that target character is an ASCII.
20253 (simple_search): Fix calculation of byte length of matched text. 20316 (simple_search): Fix calculation of byte length of matched text.
20254 (boyer_moore): Fix handling of case-equivalent multibyte characters. 20317 (boyer_moore): Fix handling of case-equivalent multibyte characters.
20255 20318
diff --git a/src/ChangeLog.10 b/src/ChangeLog.10
index dd847f8a64e..14a0f012b06 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -6914,7 +6914,7 @@
6914 6914
6915 * search.c (search_buffer): Give up BM search on case-fold-search 6915 * search.c (search_buffer): Give up BM search on case-fold-search
6916 if one of a target character has a case-equivalence of different 6916 if one of a target character has a case-equivalence of different
6917 charset even if that target charcter is an ASCII. 6917 charset even if that target character is an ASCII.
6918 6918
6919 * casefiddle.c (casify_object): Fix for the case that case 6919 * casefiddle.c (casify_object): Fix for the case that case
6920 conversion change the byte length. 6920 conversion change the byte length.
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index 4dd3d0dd071..4dac2b262b7 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -13869,10 +13869,10 @@
138691998-08-31 Kenichi Handa <handa@etl.go.jp> 138691998-08-31 Kenichi Handa <handa@etl.go.jp>
13870 13870
13871 * charset.c (unibyte_char_to_multibyte): 13871 * charset.c (unibyte_char_to_multibyte):
13872 Vnonacii_translation_table will convert a 7-bit charcater. 13872 Vnonacii_translation_table will convert a 7-bit character.
13873 (multibyte_char_to_unibyte): Handle the case that 13873 (multibyte_char_to_unibyte): Handle the case that
13874 Vnonacii_translation_table converts a multibyte charcater to a 13874 Vnonacii_translation_table converts a multibyte character to a
13875 unibyte charcter of less than 128. 13875 unibyte character of less than 128.
13876 (init_charset_once): Initialize nonascii_insert_offset and 13876 (init_charset_once): Initialize nonascii_insert_offset and
13877 Vnonacii_translation_table. 13877 Vnonacii_translation_table.
13878 13878
diff --git a/src/Makefile.in b/src/Makefile.in
index 9ee5631ef70..d91b95d86e3 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -226,6 +226,8 @@ RSVG_CFLAGS= @RSVG_CFLAGS@
226IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@ 226IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@
227IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ 227IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
228 228
229LIBXML2_LIBS = @LIBXML2_LIBS@
230LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
229 231
230## widget.o if USE_X_TOOLKIT, otherwise empty. 232## widget.o if USE_X_TOOLKIT, otherwise empty.
231WIDGET_OBJ=@WIDGET_OBJ@ 233WIDGET_OBJ=@WIDGET_OBJ@
@@ -320,7 +322,8 @@ MKDEPDIR=@MKDEPDIR@
320## FIXME? MYCPPFLAGS only referenced in etc/DEBUG. 322## FIXME? MYCPPFLAGS only referenced in etc/DEBUG.
321ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \ 323ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \
322 ${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \ 324 ${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \
323 ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} \ 325 ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} \
326 ${LIBXML2_CFLAGS} ${DBUS_CFLAGS} \
324 ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ 327 ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \
325 ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ 328 ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \
326 ${C_WARNINGS_SWITCH} ${CFLAGS} 329 ${C_WARNINGS_SWITCH} ${CFLAGS}
@@ -349,7 +352,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
349 syntax.o $(UNEXEC_OBJ) bytecode.o \ 352 syntax.o $(UNEXEC_OBJ) bytecode.o \
350 process.o callproc.o \ 353 process.o callproc.o \
351 region-cache.o sound.o atimer.o \ 354 region-cache.o sound.o atimer.o \
352 doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ 355 doprnt.o strftime.o intervals.o textprop.o composite.o md5.o xml.o \
353 $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) 356 $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ)
354 357
355## Object files used on some machine or other. 358## Object files used on some machine or other.
@@ -595,7 +598,8 @@ SOME_MACHINE_LISP = ../lisp/mouse.elc \
595## duplicated symbols. If the standard libraries were compiled 598## duplicated symbols. If the standard libraries were compiled
596## with GCC, we might need LIB_GCC again after them. 599## with GCC, we might need LIB_GCC again after them.
597LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ 600LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
598 $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ 601 $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) \
602 ${LIBXML2_LIBS} $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
599 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ 603 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \
600 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ 604 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
601 $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) 605 $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
diff --git a/src/buffer.c b/src/buffer.c
index 39fabf581bb..84b60779b34 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2345,7 +2345,7 @@ current buffer is cleared. */)
2345 { 2345 {
2346 c = STRING_CHAR_AND_LENGTH (p, bytes); 2346 c = STRING_CHAR_AND_LENGTH (p, bytes);
2347 /* Delete all bytes for this 8-bit character but the 2347 /* Delete all bytes for this 8-bit character but the
2348 last one, and change the last one to the charcter 2348 last one, and change the last one to the character
2349 code. */ 2349 code. */
2350 bytes--; 2350 bytes--;
2351 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0); 2351 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
diff --git a/src/charset.c b/src/charset.c
index 036d7146db6..8051b11330e 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -427,7 +427,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
427 427
428 428
429/* Read a hexadecimal number (preceded by "0x") from the file FP while 429/* Read a hexadecimal number (preceded by "0x") from the file FP while
430 paying attention to comment charcter '#'. */ 430 paying attention to comment character '#'. */
431 431
432static INLINE unsigned 432static INLINE unsigned
433read_hex (FILE *fp, int *eof) 433read_hex (FILE *fp, int *eof)
diff --git a/src/cmds.c b/src/cmds.c
index f12e759b7a6..0e305e1fce4 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -524,7 +524,7 @@ syms_of_cmds (void)
524 524
525 DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook, 525 DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook,
526 doc: /* Hook run at the end of `self-insert-command'. 526 doc: /* Hook run at the end of `self-insert-command'.
527This run is run after inserting the charater. */); 527This is run after inserting the character. */);
528 Vpost_self_insert_hook = Qnil; 528 Vpost_self_insert_hook = Qnil;
529 529
530 defsubr (&Sforward_point); 530 defsubr (&Sforward_point);
diff --git a/src/coding.c b/src/coding.c
index 6012978b60a..d6285ed9245 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -2008,7 +2008,7 @@ detect_coding_emacs_mule (struct coding_system *coding,
2008 } 2008 }
2009 else 2009 else
2010 { 2010 {
2011 int more_bytes = emacs_mule_bytes[*src_base] - 1; 2011 int more_bytes = emacs_mule_bytes[c] - 1;
2012 2012
2013 while (more_bytes > 0) 2013 while (more_bytes > 0)
2014 { 2014 {
@@ -4490,7 +4490,10 @@ encode_coding_iso_2022 (struct coding_system *coding)
4490 charset_list = CODING_ATTR_CHARSET_LIST (attrs); 4490 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
4491 coding->safe_charsets = SDATA (CODING_ATTR_SAFE_CHARSETS (attrs)); 4491 coding->safe_charsets = SDATA (CODING_ATTR_SAFE_CHARSETS (attrs));
4492 4492
4493 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); 4493 ascii_compatible
4494 = (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
4495 && ! (CODING_ISO_FLAGS (coding) & (CODING_ISO_FLAG_DESIGNATION
4496 | CODING_ISO_FLAG_LOCKING_SHIFT)));
4494 4497
4495 while (charbuf < charbuf_end) 4498 while (charbuf < charbuf_end)
4496 { 4499 {
diff --git a/src/config.in b/src/config.in
index 604a737a8b0..199afbd78ba 100644
--- a/src/config.in
+++ b/src/config.in
@@ -813,6 +813,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
813/* Define to 1 if you have the SM library (-lSM). */ 813/* Define to 1 if you have the SM library (-lSM). */
814#undef HAVE_X_SM 814#undef HAVE_X_SM
815 815
816/* Define to 1 if you have the libxml2 library (-lxml2). */
817#undef HAVE_LIBXML2
818
816/* Define to 1 if you want to use the X window system. */ 819/* Define to 1 if you want to use the X window system. */
817#undef HAVE_X_WINDOWS 820#undef HAVE_X_WINDOWS
818 821
diff --git a/src/editfns.c b/src/editfns.c
index 1bd6682c3b6..add2f37109b 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3517,7 +3517,7 @@ usage: (format STRING &rest OBJECTS) */)
3517 int multibyte = 0; 3517 int multibyte = 0;
3518 /* When we make a multibyte string, we must pay attention to the 3518 /* When we make a multibyte string, we must pay attention to the
3519 byte combining problem, i.e., a byte may be combined with a 3519 byte combining problem, i.e., a byte may be combined with a
3520 multibyte charcter of the previous string. This flag tells if we 3520 multibyte character of the previous string. This flag tells if we
3521 must consider such a situation or not. */ 3521 must consider such a situation or not. */
3522 int maybe_combine_byte; 3522 int maybe_combine_byte;
3523 unsigned char *this_format; 3523 unsigned char *this_format;
diff --git a/src/emacs.c b/src/emacs.c
index 397d3d9ad27..33e0d60630b 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1544,6 +1544,10 @@ main (int argc, char **argv)
1544#endif 1544#endif
1545#endif /* HAVE_X_WINDOWS */ 1545#endif /* HAVE_X_WINDOWS */
1546 1546
1547#ifdef HAVE_LIBXML2
1548 syms_of_xml ();
1549#endif
1550
1547 syms_of_menu (); 1551 syms_of_menu ();
1548 1552
1549#ifdef HAVE_NTGUI 1553#ifdef HAVE_NTGUI
diff --git a/src/fileio.c b/src/fileio.c
index a04cd4e76f5..3d08e881e8f 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1842,7 +1842,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, const unsigned char *querystr
1842 tem = format2 ("File %s already exists; %s anyway? ", 1842 tem = format2 ("File %s already exists; %s anyway? ",
1843 absname, build_string (querystring)); 1843 absname, build_string (querystring));
1844 if (quick) 1844 if (quick)
1845 tem = Fy_or_n_p (tem); 1845 tem = call1 (intern ("y-or-n-p"), tem);
1846 else 1846 else
1847 tem = do_yes_or_no_p (tem); 1847 tem = do_yes_or_no_p (tem);
1848 UNGCPRO; 1848 UNGCPRO;
diff --git a/src/fns.c b/src/fns.c
index 12d13186ce7..19590a2140d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2444,146 +2444,6 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
2444 return sequence; 2444 return sequence;
2445} 2445}
2446 2446
2447/* Anything that calls this function must protect from GC! */
2448
2449DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
2450 doc: /* Ask user a "y or n" question. Return t if answer is "y".
2451Takes one argument, which is the string to display to ask the question.
2452It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
2453No confirmation of the answer is requested; a single character is enough.
2454Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
2455the bindings in `query-replace-map'; see the documentation of that variable
2456for more information. In this case, the useful bindings are `act', `skip',
2457`recenter', and `quit'.\)
2458
2459Under a windowing system a dialog box will be used if `last-nonmenu-event'
2460is nil and `use-dialog-box' is non-nil. */)
2461 (Lisp_Object prompt)
2462{
2463 register Lisp_Object obj, key, def, map;
2464 register int answer;
2465 Lisp_Object xprompt;
2466 Lisp_Object args[2];
2467 struct gcpro gcpro1, gcpro2;
2468 int count = SPECPDL_INDEX ();
2469
2470 specbind (Qcursor_in_echo_area, Qt);
2471
2472 map = Fsymbol_value (intern ("query-replace-map"));
2473
2474 CHECK_STRING (prompt);
2475 xprompt = prompt;
2476 GCPRO2 (prompt, xprompt);
2477
2478#ifdef HAVE_WINDOW_SYSTEM
2479 if (display_hourglass_p)
2480 cancel_hourglass ();
2481#endif
2482
2483 while (1)
2484 {
2485
2486#ifdef HAVE_MENUS
2487 if (FRAME_WINDOW_P (SELECTED_FRAME ())
2488 && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
2489 && use_dialog_box
2490 && have_menus_p ())
2491 {
2492 Lisp_Object pane, menu;
2493 redisplay_preserve_echo_area (3);
2494 pane = Fcons (Fcons (build_string ("Yes"), Qt),
2495 Fcons (Fcons (build_string ("No"), Qnil),
2496 Qnil));
2497 menu = Fcons (prompt, pane);
2498 obj = Fx_popup_dialog (Qt, menu, Qnil);
2499 answer = !NILP (obj);
2500 break;
2501 }
2502#endif /* HAVE_MENUS */
2503 cursor_in_echo_area = 1;
2504 choose_minibuf_frame ();
2505
2506 {
2507 Lisp_Object pargs[3];
2508
2509 /* Colorize prompt according to `minibuffer-prompt' face. */
2510 pargs[0] = build_string ("%s(y or n) ");
2511 pargs[1] = intern ("face");
2512 pargs[2] = intern ("minibuffer-prompt");
2513 args[0] = Fpropertize (3, pargs);
2514 args[1] = xprompt;
2515 Fmessage (2, args);
2516 }
2517
2518 if (minibuffer_auto_raise)
2519 {
2520 Lisp_Object mini_frame;
2521
2522 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
2523
2524 Fraise_frame (mini_frame);
2525 }
2526
2527 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
2528 obj = read_filtered_event (1, 0, 0, 0, Qnil);
2529 cursor_in_echo_area = 0;
2530 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2531 QUIT;
2532
2533 key = Fmake_vector (make_number (1), obj);
2534 def = Flookup_key (map, key, Qt);
2535
2536 if (EQ (def, intern ("skip")))
2537 {
2538 answer = 0;
2539 break;
2540 }
2541 else if (EQ (def, intern ("act")))
2542 {
2543 answer = 1;
2544 break;
2545 }
2546 else if (EQ (def, intern ("recenter")))
2547 {
2548 Frecenter (Qnil);
2549 xprompt = prompt;
2550 continue;
2551 }
2552 else if (EQ (def, intern ("quit")))
2553 Vquit_flag = Qt;
2554 /* We want to exit this command for exit-prefix,
2555 and this is the only way to do it. */
2556 else if (EQ (def, intern ("exit-prefix")))
2557 Vquit_flag = Qt;
2558
2559 QUIT;
2560
2561 /* If we don't clear this, then the next call to read_char will
2562 return quit_char again, and we'll enter an infinite loop. */
2563 Vquit_flag = Qnil;
2564
2565 Fding (Qnil);
2566 Fdiscard_input ();
2567 if (EQ (xprompt, prompt))
2568 {
2569 args[0] = build_string ("Please answer y or n. ");
2570 args[1] = prompt;
2571 xprompt = Fconcat (2, args);
2572 }
2573 }
2574 UNGCPRO;
2575
2576 if (! noninteractive)
2577 {
2578 cursor_in_echo_area = -1;
2579 message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n",
2580 xprompt, 0);
2581 }
2582
2583 unbind_to (count, Qnil);
2584 return answer ? Qt : Qnil;
2585}
2586
2587/* This is how C code calls `yes-or-no-p' and allows the user 2447/* This is how C code calls `yes-or-no-p' and allows the user
2588 to redefined it. 2448 to redefined it.
2589 2449
@@ -5058,7 +4918,6 @@ this variable. */);
5058 defsubr (&Smapcar); 4918 defsubr (&Smapcar);
5059 defsubr (&Smapc); 4919 defsubr (&Smapc);
5060 defsubr (&Smapconcat); 4920 defsubr (&Smapconcat);
5061 defsubr (&Sy_or_n_p);
5062 defsubr (&Syes_or_no_p); 4921 defsubr (&Syes_or_no_p);
5063 defsubr (&Sload_average); 4922 defsubr (&Sload_average);
5064 defsubr (&Sfeaturep); 4923 defsubr (&Sfeaturep);
diff --git a/src/lisp.h b/src/lisp.h
index 89514bf9ecb..781261d9779 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2516,7 +2516,6 @@ EXFUN (Ffillarray, 2);
2516EXFUN (Fnconc, MANY); 2516EXFUN (Fnconc, MANY);
2517EXFUN (Fmapcar, 2); 2517EXFUN (Fmapcar, 2);
2518EXFUN (Fmapconcat, 3); 2518EXFUN (Fmapconcat, 3);
2519EXFUN (Fy_or_n_p, 1);
2520extern Lisp_Object do_yes_or_no_p (Lisp_Object); 2519extern Lisp_Object do_yes_or_no_p (Lisp_Object);
2521EXFUN (Frequire, 3); 2520EXFUN (Frequire, 3);
2522EXFUN (Fprovide, 2); 2521EXFUN (Fprovide, 2);
@@ -3577,6 +3576,11 @@ extern char *x_get_keysym_name (int);
3577EXFUN (Fmsdos_downcase_filename, 1); 3576EXFUN (Fmsdos_downcase_filename, 1);
3578#endif 3577#endif
3579 3578
3579#ifdef HAVE_LIBXML2
3580/* Defined in xml.c */
3581extern void syms_of_xml (void);
3582#endif
3583
3580#ifdef HAVE_MENUS 3584#ifdef HAVE_MENUS
3581/* Defined in (x|w32)fns.c, nsfns.m... */ 3585/* Defined in (x|w32)fns.c, nsfns.m... */
3582extern int have_menus_p (void); 3586extern int have_menus_p (void);
diff --git a/src/term.c b/src/term.c
index f090cdd2792..2deca1014e8 100644
--- a/src/term.c
+++ b/src/term.c
@@ -247,7 +247,6 @@ tty_set_terminal_modes (struct terminal *terminal)
247 cmputc ('\n'); 247 cmputc ('\n');
248 } 248 }
249 249
250 OUTPUT_IF (tty, tty->TS_termcap_modes);
251 OUTPUT_IF (tty, visible_cursor ? tty->TS_cursor_visible : tty->TS_cursor_normal); 250 OUTPUT_IF (tty, visible_cursor ? tty->TS_cursor_visible : tty->TS_cursor_normal);
252 OUTPUT_IF (tty, tty->TS_keypad_mode); 251 OUTPUT_IF (tty, tty->TS_keypad_mode);
253 losecursor (tty); 252 losecursor (tty);
diff --git a/src/xml.c b/src/xml.c
new file mode 100644
index 00000000000..ddecabb5317
--- /dev/null
+++ b/src/xml.c
@@ -0,0 +1,141 @@
1/* Interface to libxml2.
2 Copyright (C) 2010 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software: you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19#include <config.h>
20
21#ifdef HAVE_LIBXML2
22
23#include <setjmp.h>
24#include <libxml/tree.h>
25#include <libxml/parser.h>
26#include <libxml/HTMLparser.h>
27
28#include "lisp.h"
29#include "buffer.h"
30
31Lisp_Object make_dom (xmlNode *node)
32{
33 if (node->type == XML_ELEMENT_NODE) {
34 Lisp_Object result = Fcons (intern (node->name), Qnil);
35 xmlNode *child;
36 xmlAttr *property;
37
38 /* First add the attributes. */
39 property = node->properties;
40 while (property != NULL) {
41 if (property->children &&
42 property->children->content) {
43 char *pname = xmalloc (strlen (property->name) + 2);
44 *pname = ':';
45 strcpy(pname + 1, property->name);
46 result = Fcons (Fcons (intern (pname),
47 build_string(property->children->content)),
48 result);
49 xfree (pname);
50 }
51 property = property->next;
52 }
53 /* Then add the children of the node. */
54 child = node->children;
55 while (child != NULL) {
56 result = Fcons (make_dom (child), result);
57 child = child->next;
58 }
59 return Fnreverse (result);
60 } else if (node->type == XML_TEXT_NODE) {
61 Lisp_Object content = Qnil;
62
63 if (node->content)
64 content = build_string (node->content);
65
66 return Fcons (intern (node->name), content);
67 } else
68 return Qnil;
69}
70
71static Lisp_Object
72parse_string (Lisp_Object string, Lisp_Object base_url, int htmlp)
73{
74 xmlDoc *doc;
75 xmlNode *node;
76 Lisp_Object result = Qnil;
77 int ibeg, iend;
78 char *burl = "";
79
80 LIBXML_TEST_VERSION;
81
82 CHECK_STRING (string);
83
84 if (! NILP (base_url)) {
85 CHECK_STRING (base_url);
86 burl = SDATA (base_url);
87 }
88
89 if (htmlp)
90 doc = htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8",
91 HTML_PARSE_RECOVER|HTML_PARSE_NONET|
92 HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR);
93 else
94 doc = xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8",
95 XML_PARSE_NONET|XML_PARSE_NOWARNING|
96 XML_PARSE_NOERROR);
97
98 if (doc != NULL) {
99 node = xmlDocGetRootElement (doc);
100 if (node != NULL)
101 result = make_dom (node);
102
103 xmlFreeDoc (doc);
104 xmlCleanupParser ();
105 }
106
107 return result;
108}
109
110DEFUN ("html-parse-string", Fhtml_parse_string, Shtml_parse_string,
111 1, 2, 0,
112 doc: /* Parse STRING as an HTML document and return the parse tree.
113If BASE-URL is non-nil, it will be used to expand relative URLs in
114the HTML document. */)
115 (Lisp_Object string, Lisp_Object base_url)
116{
117 return parse_string (string, base_url, 1);
118}
119
120DEFUN ("xml-parse-string", Fxml_parse_string, Sxml_parse_string,
121 1, 2, 0,
122 doc: /* Parse STRING as an XML document and return the parse tree.
123If BASE-URL is non-nil, it will be used to expand relative URLs in
124the XML document. */)
125 (Lisp_Object string, Lisp_Object base_url)
126{
127 return parse_string (string, base_url, 0);
128}
129
130
131/***********************************************************************
132 Initialization
133 ***********************************************************************/
134void
135syms_of_xml (void)
136{
137 defsubr (&Shtml_parse_string);
138 defsubr (&Sxml_parse_string);
139}
140
141#endif /* HAVE_LIBXML2 */
diff --git a/src/xterm.c b/src/xterm.c
index 2ebe8a80378..c1d1aada530 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -8285,19 +8285,89 @@ x_set_sticky (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
8285 "_NET_WM_STATE_STICKY", NULL); 8285 "_NET_WM_STATE_STICKY", NULL);
8286} 8286}
8287 8287
8288/* Return the current _NET_WM_STATE.
8289 SIZE_STATE is set to one of the FULLSCREEN_* values.
8290 STICKY is set to 1 if the sticky state is set, 0 if not. */
8291
8292static void
8293get_current_vm_state (struct frame *f,
8294 Window window,
8295 int *size_state,
8296 int *sticky)
8297{
8298 Atom actual_type;
8299 unsigned long actual_size, bytes_remaining;
8300 int i, rc, actual_format;
8301 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
8302 long max_len = 65536;
8303 Display *dpy = FRAME_X_DISPLAY (f);
8304 unsigned char *tmp_data = NULL;
8305 Atom target_type = XA_ATOM;
8306
8307 *sticky = 0;
8308 *size_state = FULLSCREEN_NONE;
8309
8310 BLOCK_INPUT;
8311 x_catch_errors (dpy);
8312 rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state,
8313 0, max_len, False, target_type,
8314 &actual_type, &actual_format, &actual_size,
8315 &bytes_remaining, &tmp_data);
8316
8317 if (rc != Success || actual_type != target_type || x_had_errors_p (dpy))
8318 {
8319 if (tmp_data) XFree (tmp_data);
8320 x_uncatch_errors ();
8321 UNBLOCK_INPUT;
8322 return;
8323 }
8324
8325 x_uncatch_errors ();
8326
8327 for (i = 0; i < actual_size; ++i)
8328 {
8329 Atom a = ((Atom*)tmp_data)[i];
8330 if (a == dpyinfo->Xatom_net_wm_state_maximized_horz)
8331 {
8332 if (*size_state == FULLSCREEN_HEIGHT)
8333 *size_state = FULLSCREEN_MAXIMIZED;
8334 else
8335 *size_state = FULLSCREEN_WIDTH;
8336 }
8337 else if (a == dpyinfo->Xatom_net_wm_state_maximized_vert)
8338 {
8339 if (*size_state == FULLSCREEN_WIDTH)
8340 *size_state = FULLSCREEN_MAXIMIZED;
8341 else
8342 *size_state = FULLSCREEN_HEIGHT;
8343 }
8344 else if (a == dpyinfo->Xatom_net_wm_state_fullscreen_atom)
8345 *size_state = FULLSCREEN_BOTH;
8346 else if (a == dpyinfo->Xatom_net_wm_state_sticky)
8347 *sticky = 1;
8348 }
8349
8350 if (tmp_data) XFree (tmp_data);
8351 UNBLOCK_INPUT;
8352}
8353
8288/* Do fullscreen as specified in extended window manager hints */ 8354/* Do fullscreen as specified in extended window manager hints */
8289 8355
8290static int 8356static int
8291do_ewmh_fullscreen (struct frame *f) 8357do_ewmh_fullscreen (struct frame *f)
8292{ 8358{
8293 int have_net_atom = wm_supports (f, "_NET_WM_STATE"); 8359 int have_net_atom = wm_supports (f, "_NET_WM_STATE");
8360 Lisp_Object lval = get_frame_param (f, Qfullscreen);
8361 int cur, dummy;
8362
8363 get_current_vm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy);
8294 8364
8295 /* Some window managers don't say they support _NET_WM_STATE, but they do say 8365 /* Some window managers don't say they support _NET_WM_STATE, but they do say
8296 they support _NET_WM_STATE_FULLSCREEN. Try that also. */ 8366 they support _NET_WM_STATE_FULLSCREEN. Try that also. */
8297 if (!have_net_atom) 8367 if (!have_net_atom)
8298 have_net_atom = wm_supports (f, "_NET_WM_STATE_FULLSCREEN"); 8368 have_net_atom = wm_supports (f, "_NET_WM_STATE_FULLSCREEN");
8299 8369
8300 if (have_net_atom) 8370 if (have_net_atom && cur != f->want_fullscreen)
8301 { 8371 {
8302 Lisp_Object frame; 8372 Lisp_Object frame;
8303 const char *fs = "_NET_WM_STATE_FULLSCREEN"; 8373 const char *fs = "_NET_WM_STATE_FULLSCREEN";
@@ -8306,26 +8376,41 @@ do_ewmh_fullscreen (struct frame *f)
8306 8376
8307 XSETFRAME (frame, f); 8377 XSETFRAME (frame, f);
8308 8378
8309 set_wm_state (frame, 0, fs, NULL); 8379 /* Keep number of calls to set_wm_state as low as possible.
8310 set_wm_state (frame, 0, fh, NULL); 8380 Some window managers, or possible Gtk+, hangs when too many
8311 set_wm_state (frame, 0, fw, NULL); 8381 are sent at once. */
8312
8313 /* If there are _NET_ atoms we assume we have extended window manager
8314 hints. */
8315 switch (f->want_fullscreen) 8382 switch (f->want_fullscreen)
8316 { 8383 {
8317 case FULLSCREEN_BOTH: 8384 case FULLSCREEN_BOTH:
8385 if (cur == FULLSCREEN_WIDTH || cur == FULLSCREEN_MAXIMIZED
8386 || cur == FULLSCREEN_HEIGHT)
8387 set_wm_state (frame, 0, fw, fh);
8318 set_wm_state (frame, 1, fs, NULL); 8388 set_wm_state (frame, 1, fs, NULL);
8319 break; 8389 break;
8320 case FULLSCREEN_WIDTH: 8390 case FULLSCREEN_WIDTH:
8321 set_wm_state (frame, 1, fw, NULL); 8391 if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_HEIGHT
8392 || cur == FULLSCREEN_MAXIMIZED)
8393 set_wm_state (frame, 0, fs, fh);
8394 if (cur != FULLSCREEN_MAXIMIZED)
8395 set_wm_state (frame, 1, fw, NULL);
8322 break; 8396 break;
8323 case FULLSCREEN_HEIGHT: 8397 case FULLSCREEN_HEIGHT:
8324 set_wm_state (frame, 1, fh, NULL); 8398 if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_WIDTH
8399 || cur == FULLSCREEN_MAXIMIZED)
8400 set_wm_state (frame, 0, fs, fw);
8401 if (cur != FULLSCREEN_MAXIMIZED)
8402 set_wm_state (frame, 1, fh, NULL);
8325 break; 8403 break;
8326 case FULLSCREEN_MAXIMIZED: 8404 case FULLSCREEN_MAXIMIZED:
8405 if (cur == FULLSCREEN_BOTH)
8406 set_wm_state (frame, 0, fs, NULL);
8327 set_wm_state (frame, 1, fw, fh); 8407 set_wm_state (frame, 1, fw, fh);
8328 break; 8408 break;
8409 case FULLSCREEN_NONE:
8410 if (cur == FULLSCREEN_BOTH)
8411 set_wm_state (frame, 0, fs, NULL);
8412 else
8413 set_wm_state (frame, 0, fw, fh);
8329 } 8414 }
8330 8415
8331 f->want_fullscreen = FULLSCREEN_NONE; 8416 f->want_fullscreen = FULLSCREEN_NONE;
@@ -8351,57 +8436,11 @@ XTfullscreen_hook (FRAME_PTR f)
8351static void 8436static void
8352x_handle_net_wm_state (struct frame *f, XPropertyEvent *event) 8437x_handle_net_wm_state (struct frame *f, XPropertyEvent *event)
8353{ 8438{
8354 Atom actual_type; 8439 int value = FULLSCREEN_NONE;
8355 unsigned long actual_size, bytes_remaining;
8356 int i, rc, actual_format, value = FULLSCREEN_NONE;
8357 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
8358 long max_len = 65536;
8359 Display *dpy = FRAME_X_DISPLAY (f);
8360 unsigned char *tmp_data = NULL;
8361 Atom target_type = XA_ATOM;
8362 Lisp_Object lval; 8440 Lisp_Object lval;
8363 int sticky = 0; 8441 int sticky = 0;
8364 8442
8365 BLOCK_INPUT; 8443 get_current_vm_state (f, event->window, &value, &sticky);
8366 x_catch_errors (dpy);
8367 rc = XGetWindowProperty (dpy, event->window,
8368 event->atom, 0, max_len, False, target_type,
8369 &actual_type, &actual_format, &actual_size,
8370 &bytes_remaining, &tmp_data);
8371
8372 if (rc != Success || actual_type != target_type || x_had_errors_p (dpy))
8373 {
8374 if (tmp_data) XFree (tmp_data);
8375 x_uncatch_errors ();
8376 UNBLOCK_INPUT;
8377 return;
8378 }
8379
8380 x_uncatch_errors ();
8381
8382 for (i = 0; i < actual_size; ++i)
8383 {
8384 Atom a = ((Atom*)tmp_data)[i];
8385 if (a == dpyinfo->Xatom_net_wm_state_maximized_horz)
8386 {
8387 if (value == FULLSCREEN_HEIGHT)
8388 value = FULLSCREEN_MAXIMIZED;
8389 else
8390 value = FULLSCREEN_WIDTH;
8391 }
8392 else if (a == dpyinfo->Xatom_net_wm_state_maximized_vert)
8393 {
8394 if (value == FULLSCREEN_WIDTH)
8395 value = FULLSCREEN_MAXIMIZED;
8396 else
8397 value = FULLSCREEN_HEIGHT;
8398 }
8399 else if (a == dpyinfo->Xatom_net_wm_state_fullscreen_atom)
8400 value = FULLSCREEN_BOTH;
8401 else if (a == dpyinfo->Xatom_net_wm_state_sticky)
8402 sticky = 1;
8403 }
8404
8405 lval = Qnil; 8444 lval = Qnil;
8406 switch (value) 8445 switch (value)
8407 { 8446 {
@@ -8421,9 +8460,6 @@ x_handle_net_wm_state (struct frame *f, XPropertyEvent *event)
8421 8460
8422 store_frame_param (f, Qfullscreen, lval); 8461 store_frame_param (f, Qfullscreen, lval);
8423 store_frame_param (f, Qsticky, sticky ? Qt : Qnil); 8462 store_frame_param (f, Qsticky, sticky ? Qt : Qnil);
8424
8425 if (tmp_data) XFree (tmp_data);
8426 UNBLOCK_INPUT;
8427} 8463}
8428 8464
8429/* Check if we need to resize the frame due to a fullscreen request. 8465/* Check if we need to resize the frame due to a fullscreen request.
diff --git a/test/ChangeLog b/test/ChangeLog
index cf709f01eec..12238560dc9 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,7 @@
12010-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * indent/octave.m: Remove some `fixindent' not needed any more.
4
12010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> 52010-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
2 6
3 * indent/octave.m: New file. 7 * indent/octave.m: New file.
diff --git a/test/indent/octave.m b/test/indent/octave.m
index 830af96ed8e..61db73b91e8 100644
--- a/test/indent/octave.m
+++ b/test/indent/octave.m
@@ -1415,7 +1415,7 @@ function create_pkgadddel (desc, packdir, nm, global_install)
1415 endfor # fixindent 1415 endfor # fixindent
1416 1416
1417 ## Search all C++ source files for PKG commands. 1417 ## Search all C++ source files for PKG commands.
1418 lst = dir (fullfile (packdir, "src", "*.cc")); # fixindent 1418 lst = dir (fullfile (packdir, "src", "*.cc"));
1419 for i = 1:length (lst) 1419 for i = 1:length (lst)
1420 nam = fullfile (packdir, "src", lst(i).name); 1420 nam = fullfile (packdir, "src", lst(i).name);
1421 fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); 1421 fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$']));
@@ -1451,10 +1451,10 @@ function create_pkgadddel (desc, packdir, nm, global_install)
1451 unlink (archpkg); 1451 unlink (archpkg);
1452 endif 1452 endif
1453 endif 1453 endif
1454 endif # fixindent 1454 endif
1455endfunction # fixindent 1455endfunction
1456 1456
1457function copy_files (desc, packdir, global_install) # fixindent 1457function copy_files (desc, packdir, global_install)
1458 ## Create the installation directory. 1458 ## Create the installation directory.
1459 if (! exist (desc.dir, "dir")) 1459 if (! exist (desc.dir, "dir"))
1460 [status, output] = mkdir (desc.dir); 1460 [status, output] = mkdir (desc.dir);