Mercurial > emacs
changeset 110377:6dcf9897d91a
merge trunk
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Thu, 16 Sep 2010 11:11:13 +0900 |
| parents | cc92458a9829 (current diff) 932697ced7aa (diff) |
| children | b339b23600a0 e1094870ea06 |
| files | README.imagemagick etc/emacs.bash etc/emacs.csh etc/ms-kermit lisp/net/tramp-fish.el lisp/nxml/TODO src/ChangeLog |
| diffstat | 133 files changed, 11564 insertions(+), 10970 deletions(-) [+] |
line wrap: on
line diff
--- a/.bzrignore Thu Sep 16 10:51:56 2010 +0900 +++ b/.bzrignore Thu Sep 16 11:11:13 2010 +0900 @@ -72,3 +72,4 @@ src/stamp-oldxmenu src/temacs test/indent/*.new ++*
--- a/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,16 @@ +2010-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in (HAVE_LIBXML2): Check that the libxml2 we found can + be used. This fixes a conf problem on Mac OS X. + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in: Check for libxml2. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * make-dist: No more TODO files under lisp/. + 2010-09-04 Eli Zaretskii <eliz@gnu.org> * config.bat: Produce lisp/gnus/_dir-locals.el from
--- a/README.imagemagick Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,151 +0,0 @@ -* README for the ImageMagick Emacs branch - -This is the imagemagick branch of Emacs. Imagemagick can now be used -to load many new image formats, and also do useful transforms like -scaling and rotation. - -This file will attempt to contain draft NEWS, Changelog and manual -entries for the new functionality. - -You might need to regenerate the configure scripts: -aclocal -automake -autoheader -autoconf -./configure --with-imagemagick - - -* TODO image-type-header-regexps priorities the jpeg loader over the -imagemagick one. This is not wrong, but how should a user go about -prefering the imagemagick loader? The user might like zooming etc in -jpegs. - -try (setq image-type-header-regexps nil) for a quick hack to prefer -imagemagick over the jpg loader. - -* TODO For some reason its unbearably slow to look at a page in a large - image bundle using the :index feature. The imagemagick "display" - command is also a bit slow, but nowhere near as slow as the emacs - code. It seems imagemagick tries to unpack every page when loading - the bundle. This feature is not the primary usecase for the - imagemagick patch though. - - ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load. - It is now way faster to use the :index feature, but its still not - very fast. - -** DONE optimize number of pages calculation for bundles as suggested by - imagemagick forum: "set the density to something low like 2 and use - MagickPingImage()" - -** TODO try to cache the num pages calculation. it can take a while to - calculate the number of pages, and if you need to do it for each - page view, page-flipping becomes uselessly slow. - -* TODO integrate with image-dired - -* TODO integrate with docview. - -* TODO integrate with image-mode -Some work has been done, M-x image-transform-fit-to-height will fit -the image to the height of the Emacs window for instance. - -* TODO look for optimizations for handling images with low depth -Currently the code seems to default to 24 bit RGB which is costly for -images with lower bit depth. - -* TODO complete documentation drafts below - -* DONE fix inconsistencys with spelling of imagemagick in the src -* DONE report number of images in image bundle types somehow -Works like for "gif" support. Thanks to Juri Linkov. -* DONE probably add pdf to inhibited types -* DONE inhibit types is defconst should probably be defcustom -* TODO decide what to do with some uncommitted imagemagick support - functions for image size etc. -* TODO Test with more systems -Tested on Fedora 12, Fedora 14 so far, and the libmagick that ships with it. -Ubuntu 8.04 was also tested, but it seems it ships a broken -ImageMagick. - -I also tried using an imagemagick compiled from their SVN, in -parallell with the one packaged by Fedora, it worked well. - -* DONE Also need some way to handle render methods that only work on newer ImageMagicks -Is handled by configure now - -* Some nits from Stefan Monnier -I just took a quick look at the code and I see the following nits to fix: - -** DONE obviously a merge will have to come with a good ChangeLog. -** DONE also the merge will need to come with documentation. Maybe not in the - Texinfo form yet, but at least in the etc/NEWS with enough info that - describes the `scale' and other such arguments that someone can start - using them. -** DONE the README talks about naming inconsistencies, I think these should be - fixed before a first commit (should be straightforward). - -** DONE the "let" in image.el should not be followed by a line break and the while - should be replaced by a dolist. - -** DONE the prototype of imagemagick_load_image has some odd indentation in ([[2010.06.14]]) - its args, not sure what happened. -** DONE a few lines in the C code break the 80columns limit. -** DONE please use ANSI style function declarations rather than K&R for new code. ([[2010.06.14]]) -** DONE you can get rid of the prototypes by reordering the code. ([[2010.06.14]]) -** DONE the docstrings in DEFUN should not be indented (they'll display ([[2010.06.14]]) - weirdly otherwise in C-h f). -** DONE Some "{" are at the end of a for/if rather than on their own line. ([[2010.06.14]]) -** DONE why use "*( imtypes + i)" rather than "imtypes[i]"? ([[2010.06.14]]) -** DONE some "," lack a space after them. ([[2010.06.14]]) -** DONE several "=" and "==" lack spaces around them. ([[2010.06.14]]) - - -* NEWS entry -** ImageMagick support -It is now possible to use the Imagemagick library to load many new -image formats in Emacs. - -To enable, use the following configure option: ---with-imagemagick - -The new function (imagemagick-types) returns a list of image file -extensions that your installation of imagemagick supports. - -The function (imagemagick-register-types) will enable the imagemagick -support for the extensions in imagemagick-types minus the types listed -in imagemagick-types-inhibit. - -imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by default. -This means imagemagick will be used also to load jpeg files, if you -have both jpeg and imagemagick libraries linked. Add 'JPG to -imagemagick-types-inhibit if you do not want this. - -imagemagick-render-type is a new variable which can be set to choose -between screen render methods. - -- 0 is a conservative metod which works with older ImageMagick - versions. It is a bit slow, but robust. - -- 1 utilizes a newer ImageMagick method - - -Images loaded with imagemagick will support a couple of new display -specification behaviours: - -- if the :width and :height keywords are specified, these values are -used for scaling the image. If only one of :width or :height is -specified, the other one will be calculated so as to preserve the -aspect ratio.If both :width and :height are specified, aspect ratio -will not be preserved. - -- :rotation specifies a rotation angle in degrees. - -- :index specifies which image inside an image bundle file format, such -as TIFF or DJVM, to view. - -The image-metadata function can be used to retrieve the total number -of images in an image bundle. This is simmilar to how GIF files work. - -* Manual entry -nothing yet, but the NEWS entry could be adapted.
--- a/admin/unidata/unidata-gen.el Thu Sep 16 10:51:56 2010 +0900 +++ b/admin/unidata/unidata-gen.el Thu Sep 16 11:11:13 2010 +0900 @@ -95,7 +95,7 @@ (with-temp-buffer ;; Insert a file of this format: ;; (CHAR NAME CATEGORY ...) - ;; where CHAR is a charater code, the following elements are strings + ;; where CHAR is a character code, the following elements are strings ;; representing character properties. (insert-file-contents unidata-text-file) (goto-char (point-min))
--- a/configure Thu Sep 16 10:51:56 2010 +0900 +++ b/configure Thu Sep 16 11:11:13 2010 +0900 @@ -660,6 +660,8 @@ LIBS_MAIL liblockfile ALLOCA +LIBXML2_LIBS +LIBXML2_CFLAGS LIBXSM LIBGPM LIBGIF @@ -807,6 +809,7 @@ with_gif with_png with_rsvg +with_xml2 with_imagemagick with_xft with_libotf @@ -1514,6 +1517,7 @@ --without-gif don't compile with GIF image support --without-png don't compile with PNG image support --without-rsvg don't compile with SVG image support + --without-xml2 don't compile with XML parsing support --with-imagemagick compile with ImageMagick image support --without-xft don't use XFT for anti aliased fonts --without-libotf don't use libotf for OpenType font support @@ -2732,6 +2736,14 @@ fi +# Check whether --with-xml2 was given. +if test "${with_xml2+set}" = set; then : + withval=$with_xml2; +else + with_xml2=yes +fi + + # Check whether --with-imagemagick was given. if test "${with_imagemagick+set}" = set; then : withval=$with_imagemagick; @@ -11070,6 +11082,160 @@ fi +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + HAVE_LIBXML2=no + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.2.0" >&5 +$as_echo_n "checking for libxml-2.0 > 2.2.0... " >&6; } + + if $PKG_CONFIG --exists "libxml-2.0 > 2.2.0" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5 +$as_echo_n "checking LIBXML2_CFLAGS... " >&6; } + LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5 +$as_echo "$LIBXML2_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5 +$as_echo_n "checking LIBXML2_LIBS... " >&6; } + LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5 +$as_echo "$LIBXML2_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + LIBXML2_CFLAGS="" + LIBXML2_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.2.0"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_LIBXML2=yes + else + HAVE_LIBXML2=no + fi + + if test "${HAVE_LIBXML2}" = "yes"; then + LIBS="$LIBXML2_LIBS $LIBS" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5 +$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; } +if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lxml2 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char htmlReadMemory (); +int +main () +{ +return htmlReadMemory (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_xml2_htmlReadMemory=yes +else + ac_cv_lib_xml2_htmlReadMemory=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5 +$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; } +if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then : + HAVE_LIBXML2=yes +else + HAVE_LIBXML2=no +fi + + if test "${HAVE_LIBXML2}" = "yes"; then + +$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h + + else + LIBXML2_LIBS="" + LIBXML2_CFLAGS="" + fi + fi +fi + + + # If netdb.h doesn't declare h_errno, we must declare it by hand. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 $as_echo_n "checking whether netdb declares h_errno... " >&6; }
--- a/configure.in Thu Sep 16 10:51:56 2010 +0900 +++ b/configure.in Thu Sep 16 11:11:13 2010 +0900 @@ -155,6 +155,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) @@ -2535,6 +2536,24 @@ fi AC_SUBST(LIBXSM) +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.2.0, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + if test "${HAVE_LIBXML2}" = "yes"; then + LIBS="$LIBXML2_LIBS $LIBS" + AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + if test "${HAVE_LIBXML2}" = "yes"; then + AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).]) + else + LIBXML2_LIBS="" + LIBXML2_CFLAGS="" + fi + fi +fi +AC_SUBST(LIBXML2_LIBS) +AC_SUBST(LIBXML2_CFLAGS) + # If netdb.h doesn't declare h_errno, we must declare it by hand. AC_CACHE_CHECK(whether netdb declares h_errno, emacs_cv_netdb_declares_h_errno,
--- a/doc/emacs/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,23 @@ +2010-09-14 Glenn Morris <rgm@gnu.org> + + * cal-xtra.texi (Fancy Diary Display): Emphasize that sort should be + the last hook item. + + * calendar.texi (Appointments): Also updated when a diary include file + is saved. + +2010-09-14 Glenn Morris <rgm@gnu.org> + + * trouble.texi (Bugs): Update the section intro. + (Known Problems): New section. + (Checklist): Misc updates. Prefer M-x report-emacs-bug. + (Sending Patches): Bug fixes are best as responses to existing bugs. + * emacs.texi (Known Problems): Add menu entry for new section. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * xresources.texi: Untabify. + 2010-09-06 Chong Yidong <cyd@stupidchicken.com> * dired.texi (Dired Enter): Minor doc fix (Bug#6982).
--- a/doc/emacs/cal-xtra.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/cal-xtra.texi Thu Sep 16 11:11:13 2010 +0900 @@ -613,7 +613,9 @@ @noindent For each day, this sorts diary entries that begin with a recognizable time of day according to their times. Diary entries without times come -first within each day. +first within each day. Note how the sort command is placed at the end +of the hook list, in case earlier members of the list change the order +of the diary entries, or add items. @vindex diary-include-string Your main diary file can include other files. This permits a group of
--- a/doc/emacs/calendar.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/calendar.texi Thu Sep 16 11:11:13 2010 +0900 @@ -1508,7 +1508,14 @@ time by re-enabling appointment notification. Both these actions also display the day's diary buffer, unless you set @code{appt-display-diary} to @code{nil}. The appointments list is -also updated whenever the diary file is saved. +also updated whenever the diary file (or a file it includes; see +@iftex +@inforef{Fancy Diary Display,, emacs-xtra}) +@end iftex +@ifnottex +@ref{Fancy Diary Display}) +@end ifnottex +is saved. @findex appt-add @findex appt-delete
--- a/doc/emacs/emacs.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/emacs.texi Thu Sep 16 11:11:13 2010 +0900 @@ -1137,6 +1137,7 @@ Reporting Bugs +* Known Problems:: How to read about known problems and bugs. * Bug Criteria:: Have you really found a bug? * Understanding Bug Reporting:: How to report a bug effectively. * Checklist:: Steps to follow for a good bug report.
--- a/doc/emacs/trouble.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/trouble.texi Thu Sep 16 11:11:13 2010 +0900 @@ -409,29 +409,76 @@ @section Reporting Bugs @cindex bugs - Sometimes you will encounter a bug in Emacs. Although we cannot -promise we can or will fix the bug, and we might not even agree that it -is a bug, we want to hear about problems you encounter. Often we agree -they are bugs and want to fix them. - - To make it possible for us to fix a bug, you must report it. In order -to do so effectively, you must know when and how to do it. - - Before reporting a bug, it is a good idea to see if it is already -known. You can find the list of known problems in the file -@file{etc/PROBLEMS} in the Emacs distribution; type @kbd{C-h C-p} to read -it. Some additional user-level problems can be found in @ref{Bugs and -problems, , Bugs and problems, efaq, GNU Emacs FAQ}. Looking up your -problem in these two documents might provide you with a solution or a -work-around, or give you additional information about related issues. + If you think you have found a bug in Emacs, please report it. We +cannot promise to fix it, or always to agree that it is a bug, but we +certainly want to hear about it. The same applies for new features +you would like to see added. The following sections will help you to +construct an effective bug report. @menu +* Known Problems:: How to read about known problems and bugs. * Criteria: Bug Criteria. Have you really found a bug? * Understanding Bug Reporting:: How to report a bug effectively. * Checklist:: Steps to follow for a good bug report. * Sending Patches:: How to send a patch for GNU Emacs. @end menu +@node Known Problems +@subsection Reading Existing Bug Reports and Known Problems + + Before reporting a bug, if at all possible please check to see if it +is already known about. Indeed, it may already have been fixed in a +later release of Emacs, or in the development version. Here is a list +of the main places you can read about known issues: + +@itemize +@item +The @file{etc/PROBLEMS} file in the Emacs distribution; type @kbd{C-h +C-p} to read it. This file contains a list of particularly well-known +issues that have been encountered in compiling, installing and running +Emacs. Often, there are suggestions for workarounds and solutions. + +@item +Some additional user-level problems can be found in @ref{Bugs and +problems, , Bugs and problems, efaq, GNU Emacs FAQ}. + +@item +The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup +@samp{gnu.emacs.bug}). This is where you will find most Emacs bug +reports. You can read the list archives at +@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. If you +like, you can also subscribe to the list. Be aware that the sole +purpose of this list is to provide the Emacs maintainers with +information about bugs and feature requests. Reports may contain +fairly large amounts of data; spectators should not complain about +this. + +@item +The bug tracker at @url{http://debbugs.gnu.org}. From early 2008, +reports from the @samp{bug-gnu-emacs} list have been sent here. The +tracker contains the same information as the mailing list, just in a +different format. You may prefer to browse and read reports using the +tracker. + +@item +The @samp{emacs-pretest-bug} mailing list. This list is no longer +used, and is mainly of historical interest. At one time, it was used +for bug reports in development (i.e., not yet released) versions of +Emacs. You can read the archives for 2003 to mid 2007 at +@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. From +late 2007 to mid 2008, the address was an alias for the +@samp{emacs-devel} mailing list. From mid 2008 onwards, it has been +an alias for @samp{bug-gnu-emacs}. + +@item +The @samp{emacs-devel} mailing list. Sometimes people report bugs to +this mailing list. This is not the main purpose of the list, however, +and it is much better to send bug reports to the bug list. You should +not feel obliged to read this list before reporting a bug. + +@end itemize + + @node Bug Criteria @subsection When Is There a Bug @@ -540,56 +587,81 @@ @subsection Checklist for Bug Reports @cindex reporting bugs - The best way to send a bug report is to mail it electronically to the -Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}. (If you want to -suggest a change as an improvement, use the same address.) + + Before reporting a bug, first try to see if the problem has already +been reported (@pxref{Known Problems}). - If you'd like to read the bug reports, you can find them on the -newsgroup @samp{gnu.emacs.bug}; keep in mind, however, that as a -spectator you should not criticize anything about what you see there. -The purpose of bug reports is to give information to the Emacs -maintainers. Spectators are welcome only as long as they do not -interfere with this. In particular, some bug reports contain fairly -large amounts of data; spectators should not complain about this. - - Please do not post bug reports using netnews; mail is more reliable -than netnews about reporting your correct address, which we may need -in order to ask you for more information. If your data is more than -500,000 bytes, please don't include it directly in the bug report; -instead, offer to send it on request, or make it available by ftp and -say where. +If you are able to, try the latest release of Emacs to see if the +problem has already been fixed. Even better is to try the latest +development version. We recognize that this is not easy for some +people, so do not feel that you absolutely must do this before making +a report. @findex report-emacs-bug - A convenient way to send a bug report for Emacs is to use the command -@kbd{M-x report-emacs-bug}. This sets up a mail buffer (@pxref{Sending -Mail}) and automatically inserts @emph{some} of the essential -information. However, it cannot supply all the necessary information; -you should still read and follow the guidelines below, so you can enter -the other crucial information by hand before you send the message. + The best way to write a bug report for Emacs is to use the command +@kbd{M-x report-emacs-bug}. This sets up a mail buffer +(@pxref{Sending Mail}) and automatically inserts @emph{some} of the +essential information. However, it cannot supply all the necessary +information; you should still read and follow the guidelines below, so +you can enter the other crucial information by hand before you send +the message. You may feel that some of the information inserted by +@kbd{M-x report-emacs-bug} is not relevant, but unless you are +absolutely sure it is best to leave it, so that the developers can +decide for themselves. + +When you have finished writing your report, type @kbd{C-c C-c} and it +will be sent to the Emacs maintainers at @email{bug-gnu-emacs@@gnu.org}. +(If you want to suggest an improvement or new feature, use the same +address.) If you cannot send mail from inside Emacs, you can copy the +text of your report to your normal mail client and send it to that +address. Or you can simply send an email to that address describing +the problem. + +Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and +stored in the tracker at @url{http://debbugs.gnu.org}. Please try to +include a valid reply email address, in case we need to ask you for +more information about your report. Submissions are moderated, so +there may be a delay before your report appears. + +You do not need to know how the @url{http://debbugs.gnu.org} bug +tracker works in order to report a bug, but if you want to, you can +read the tracker's online documentation to see the various features +you can use. + +All mail sent to the @samp{bug-gnu-emacs} mailing list is also +gatewayed to the @samp{bug.gnu.emacs} newsgroup. The reverse is also +true, but we ask you not to post bug reports via the newsgroup. It +can make it much harder to contact you if we need to ask for more +information, and it does not integrate well with the bug tracker. + +If your data is more than 500,000 bytes, please don't include it +directly in the bug report; instead, offer to send it on request, or +make it available by ftp and say where. To enable maintainers to investigate a bug, your report should include all these things: @itemize @bullet @item -The version number of Emacs. Without this, we won't know whether there -is any point in looking for the bug in the current version of GNU -Emacs. +The version number of Emacs. Without this, we won't know whether there is any +point in looking for the bug in the current version of GNU Emacs. -You can get the version number by typing @kbd{M-x emacs-version -@key{RET}}. If that command does not work, you probably have something -other than GNU Emacs, so you will have to report the bug somewhere -else. +@kbd{M-x report-emacs-bug} includes this information automatically, +but if you are not using that command for your report you can get the +version number by typing @kbd{M-x emacs-version @key{RET}}. If that +command does not work, you probably have something other than GNU +Emacs, so you will have to report the bug somewhere else. @item The type of machine you are using, and the operating system name and -version number. @kbd{M-x emacs-version @key{RET}} provides this -information too. Copy its output from the @samp{*Messages*} buffer, so -that you get it all and get it accurately. +version number (again, automatically included by @kbd{M-x +report-emacs-bug}). @kbd{M-x emacs-version @key{RET}} provides this +information too. Copy its output from the @samp{*Messages*} buffer, +so that you get it all and get it accurately. @item The operands given to the @code{configure} command when Emacs was -installed. +installed (automatically included by @kbd{M-x report-emacs-bug}). @item A complete list of any modifications you have made to the Emacs source. @@ -619,12 +691,15 @@ @item The precise commands we need to type to reproduce the bug. +If at all possible, give a full recipe for an Emacs started with the +@samp{-Q} option (@pxref{Initial Options}). This bypasses your +@file{.emacs} customizations. @findex open-dribble-file @cindex dribble file @cindex logging keystrokes -The easy way to record the input to Emacs precisely is to write a -dribble file. To start the file, execute the Lisp expression +One way to record the input to Emacs precisely is to write a dribble +file. To start the file, execute the Lisp expression @example (open-dribble-file "~/dribble") @@ -735,7 +810,7 @@ including your @file{.emacs} file, set any variables that may affect the functioning of Emacs. Also, see whether the problem happens in a freshly started Emacs without loading your @file{.emacs} file (start -Emacs with the @code{-q} switch to prevent loading the init file). If +Emacs with the @code{-Q} switch to prevent loading the init files). If the problem does @emph{not} occur then, you must report the precise contents of any programs that you must load into the Lisp world in order to cause the problem to occur. @@ -907,12 +982,10 @@ @itemize @bullet @item Send an explanation with your changes of what problem they fix or what -improvement they bring about. For a bug fix, just include a copy of the -bug report, and explain why the change fixes the bug. - -(Referring to a bug report is not as good as including it, because then -we will have to look it up, and we have probably already deleted it if -we've already fixed the bug.) +improvement they bring about. For a fix for an existing bug, it is +best to reply to the relevant discussion on the @samp{bug-gnu-emacs} +list, or item in the @url{http://debbugs.gnu.org} tracker. Explain +why your change fixes the bug. @item Always include a proper bug report for the problem you think you have
--- a/doc/emacs/xresources.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/emacs/xresources.texi Thu Sep 16 11:11:13 2010 +0900 @@ -480,7 +480,7 @@ For dialog boxes, use @samp{dialog*}: @example -Emacs.dialog*.faceName: Sans-12 +Emacs.dialog*.faceName: Sans-12 @end example @noindent
--- a/doc/lispref/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/lispref/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,11 @@ +2010-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.texi (Syntax Flags): Document new `c' flag. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * display.texi (ImageMagick Images): General cleanup. + 2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) * files.texi (Directory Names): Use \` rather than ^.
--- a/doc/lispref/display.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/lispref/display.texi Thu Sep 16 11:11:13 2010 +0900 @@ -4468,47 +4468,56 @@ @node ImageMagick Images @subsection ImageMagick Images -The Imagemagick library can be used to load many image formats in Emacs. - -The function (imagemagick-types) returns a list of image file -extensions that your installation of imagemagick supports. - -The function (imagemagick-register-types) will enable the imagemagick -support for the extensions in imagemagick-types minus the types listed -in imagemagick-types-inhibit. - -imagemagick-types-inhibit has the value '(C HTML HTM TXT PDF) by -default. There can be overlap between image loaders in your Emacs -installation. If you never want to use the ImageMagick loader to use -Jpeg files, for instance, add 'JPG to imagemagick-types-inhibit. Which -loader that will be used in practice depends on the priority of the -loaders. - -imagemagick-render-type is a new variable which can be set to choose -between screen render methods for the ImageMagick loader. - -- 0 is a conservative metod which works with older ImageMagick - versions. It is a bit slow, but robust. - -- 1 utilizes a newer ImageMagick method - - -Images loaded with imagemagick will support a couple of new display -specification behaviours: - -- if the :width and :height keywords are specified, these values are -used for scaling the image. If only one of :width or :height is -specified, the other one will be calculated so as to preserve the -aspect ratio.If both :width and :height are specified, aspect ratio -will not be preserved. - -- :rotation specifies a rotation angle in degrees. - -- :index specifies which image inside an image bundle file format, such -as TIFF or DJVM, to view. - -The image-metadata function can be used to retrieve the total number -of images in an image bundle. This is simmilar to how GIF files work. +@cindex ImageMagick images +@cindex images, support for more formats + + If you build Emacs with ImageMagick (@url{http://www.imagemagick.org}) +support, you can use the ImageMagick library to load many image formats. + +@findex imagemagick-types +The function @code{imagemagick-types} returns a list of image file +extensions that your installation of ImageMagick supports. To enable +support, you must call the function @code{imagemagick-register-types}. + +@vindex imagemagick-types-inhibit +The variable @code{imagemagick-types-inhibit} specifies a list of +image types that you do @emph{not} want ImageMagick to handle. There +may be overlap between image loaders in your Emacs installation, and +you may prefer to use a different one for a given image type (which +@c FIXME how is this priority determined? +loader will be used in practice depends on the priority of the loaders). +@c FIXME why are these uppercase when image-types is lower-case? +@c FIXME what are the possibe options? Are these actually file extensions? +For example, if you never want to use the ImageMagick loader to use +JPEG files, add @code{JPG} to this list. + +@vindex imagemagick-render-type +You can set the variable @code{imagemagick-render-type} to choose +between screen render methods for the ImageMagick loader. The options +are: @code{0}, a conservative method which works with older +@c FIXME details of this "newer method"? +@c Presumably it is faster but may be less "robust"? +ImageMagick versions (it is a bit slow, but robust); and @code{1}, +a newer ImageMagick method. + +Images loaded with ImageMagick support a few new display specifications: + +@table @code +@item :width, :height +The @code{:width} and @code{:height} keywords are used for scaling the +image. If only one of them is specified, the other one will be +calculated so as to preserve the aspect ratio. If both are specified, +aspect ratio may not be preserved. + +@item :rotation +Specifies a rotation angle in degrees. + +@item :index +Specifies which image to view inside an image bundle file format, such +as TIFF or DJVM. You can use the @code{image-metadata} function to +retrieve the total number of images in an image bundle (this is +similar to how GIF files work). +@end table @node Other Image Types
--- a/doc/lispref/syntax.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/lispref/syntax.texi Thu Sep 16 11:11:13 2010 +0900 @@ -292,19 +292,21 @@ @cindex syntax flags In addition to the classes, entries for characters in a syntax table -can specify flags. There are seven possible flags, represented by the -characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{n}, -and @samp{p}. +can specify flags. There are eight possible flags, represented by the +characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{c}, +@samp{n}, and @samp{p}. - All the flags except @samp{n} and @samp{p} are used to describe -multi-character comment delimiters. The digit flags indicate that a -character can @emph{also} be part of a comment sequence, in addition to -the syntactic properties associated with its character class. The flags -are independent of the class and each other for the sake of characters -such as @samp{*} in C mode, which is a punctuation character, @emph{and} -the second character of a start-of-comment sequence (@samp{/*}), -@emph{and} the first character of an end-of-comment sequence -(@samp{*/}). + All the flags except @samp{p} are used to describe comment +delimiters. The digit flags are used for comment delimiters made up +of 2 characters. They indicate that a character can @emph{also} be +part of a comment sequence, in addition to the syntactic properties +associated with its character class. The flags are independent of the +class and each other for the sake of characters such as @samp{*} in +C mode, which is a punctuation character, @emph{and} the second +character of a start-of-comment sequence (@samp{/*}), @emph{and} the +first character of an end-of-comment sequence (@samp{*/}). The flags +@samp{b}, @samp{c}, and @samp{n} are used to qualify the corresponding +comment delimiter. Here is a table of the possible flags for a character @var{c}, and what they mean: @@ -325,63 +327,62 @@ @samp{4} means @var{c} is the second character of such a sequence. @item -@c Emacs 19 feature @samp{b} means that @var{c} as a comment delimiter belongs to the -alternative ``b'' comment style. +alternative ``b'' comment style. For a two-character comment starter, +this flag is only significant on the second char, and for a 2-character +comment ender it is only significant on the first char. + +@item +@samp{c} means that @var{c} as a comment delimiter belongs to the +alternative ``c'' comment style. For a two-character comment +delimiter, @samp{c} on either character makes it of style ``c''. -Emacs supports two comment styles simultaneously in any one syntax -table. This is for the sake of C++. Each style of comment syntax has -its own comment-start sequence and its own comment-end sequence. Each -comment must stick to one style or the other; thus, if it starts with -the comment-start sequence of style ``b,'' it must also end with the -comment-end sequence of style ``b.'' +@item +@samp{n} on a comment delimiter character specifies +that this kind of comment can be nested. For a two-character +comment delimiter, @samp{n} on either character makes it +nestable. -The two comment-start sequences must begin with the same character; only -the second character may differ. Mark the second character of the -``b''-style comment-start sequence with the @samp{b} flag. +Emacs supports several comment styles simultaneously in any one syntax +table. A comment style is a set of flags @samp{b}, @samp{c}, and +@samp{n}, so there can be up to 8 different comment styles. +Each comment delimiter has a style and only matches comment delimiters +of the same style. Thus if a comment starts with the comment-start +sequence of style ``bn'', it will extend until the next matching +comment-end sequence of style ``bn''. -A comment-end sequence (one or two characters) applies to the ``b'' -style if its first character has the @samp{b} flag set; otherwise, it -applies to the ``a'' style. - -The appropriate comment syntax settings for C++ are as follows: +The appropriate comment syntax settings for C++ can be as follows: @table @asis @item @samp{/} -@samp{124b} +@samp{124} @item @samp{*} -@samp{23} +@samp{23b} @item newline -@samp{>b} +@samp{>} @end table This defines four comment-delimiting sequences: @table @asis @item @samp{/*} -This is a comment-start sequence for ``a'' style because the -second character, @samp{*}, does not have the @samp{b} flag. +This is a comment-start sequence for ``b'' style because the +second character, @samp{*}, has the @samp{b} flag. @item @samp{//} -This is a comment-start sequence for ``b'' style because the second -character, @samp{/}, does have the @samp{b} flag. +This is a comment-start sequence for ``a'' style because the second +character, @samp{/}, does not have the @samp{b} flag. @item @samp{*/} -This is a comment-end sequence for ``a'' style because the first -character, @samp{*}, does not have the @samp{b} flag. +This is a comment-end sequence for ``b'' style because the first +character, @samp{*}, does have the @samp{b} flag. @item newline -This is a comment-end sequence for ``b'' style, because the newline -character has the @samp{b} flag. +This is a comment-end sequence for ``a'' style, because the newline +character does not have the @samp{b} flag. @end table @item -@samp{n} on a comment delimiter character specifies -that this kind of comment can be nested. For a two-character -comment delimiter, @samp{n} on either character makes it -nestable. - -@item @c Emacs 19 feature @samp{p} identifies an additional ``prefix character'' for Lisp syntax. These characters are treated as whitespace when they appear between
--- a/doc/lispref/text.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/lispref/text.texi Thu Sep 16 11:11:13 2010 +0900 @@ -59,6 +59,7 @@ position stored in a register. * Base 64:: Conversion to or from base 64 encoding. * MD5 Checksum:: Compute the MD5 "message digest"/"checksum". +* Parsing HTML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes "atomically". * Change Hooks:: Supplying functions to be run when text is changed. @end menu @@ -4106,6 +4107,49 @@ coding instead. @end defun +@node Parsing HTML +@section Parsing HTML +@cindex parsing html +@cindex parsing xml + +Emacs provides an interface to the @code{libxml2} library via two +functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The +HTML function will parse ``real world'' HTML and try to return a +sensible parse tree, while the XML function is somewhat stricter about +syntax. + +They both take a two optional parameter. The first is a buffer, and +the second is a base URL to be used to expand relative URLs in the +document, if any. + +Here's an example demonstrating the structure of the parsed data you +get out. Given this HTML document: + +@example +<html><hEad></head><body width=101><div class=thing>Foo<div>Yes +@end example + +You get this parse tree: + +@example +(html + (head) + (body + (:width . "101") + (div + (:class . "thing") + (text . "Foo") + (div + (text . "Yes\n"))))) +@end example + +It's a simple tree structure, where the @code{car} for each node is +the name of the node, and the @code{cdr} is the value, or the list of +values. + +Attributes are coded the same way as child nodes, but with @samp{:} as +the first character. + @node Atomic Changes @section Atomic Change Groups @cindex atomic changes
--- a/doc/misc/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/misc/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,19 @@ +2010-09-13 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi (Inline methods): Remove "ssh1_old", "ssh2_old" and + "fish" methods. + (External methods): Remove "scp1_old" and "scp2_old" methods. + +2010-09-09 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi: Remove Japanese manual. Fix typo. + + * trampver.texi: Update release number. Remove japanesemanual. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * org.texi: Restore clobbered changes (copyright years, untabify). + 2010-09-04 Julien Danjou <julien@danjou.info> (tiny change) * gnus.texi (Adaptive Scoring): Fix typo.
--- a/doc/misc/org.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/misc/org.texi Thu Sep 16 11:11:13 2010 +0900 @@ -51,7 +51,8 @@ @copying This manual is for Org version @value{VERSION}. -Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation +Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -101,400 +102,400 @@ @end ifnottex @menu -* Introduction:: Getting started -* Document Structure:: A tree works like your brain -* Tables:: Pure magic for quick formatting -* Hyperlinks:: Notes in context -* TODO Items:: Every tree branch can be a TODO item -* Tags:: Tagging headlines and matching sets of tags -* Properties and Columns:: Storing information about an entry -* Dates and Times:: Making items useful for planning -* Capture - Refile - Archive:: The ins and outs for projects -* Agenda Views:: Collecting information into views -* Markup:: Prepare text for rich export -* Exporting:: Sharing and publishing of notes -* Publishing:: Create a web site of linked Org files -* Working With Source Code:: Export, evaluate, and tangle code blocks -* Miscellaneous:: All the rest which did not fit elsewhere -* Hacking:: How to hack your way around -* MobileOrg:: Viewing and capture on a mobile device -* History and Acknowledgments:: How Org came into being -* Main Index:: An index of Org's concepts and features -* Key Index:: Key bindings and where they are described -* Variable Index:: Variables mentioned in the manual +* Introduction:: Getting started +* Document Structure:: A tree works like your brain +* Tables:: Pure magic for quick formatting +* Hyperlinks:: Notes in context +* TODO Items:: Every tree branch can be a TODO item +* Tags:: Tagging headlines and matching sets of tags +* Properties and Columns:: Storing information about an entry +* Dates and Times:: Making items useful for planning +* Capture - Refile - Archive:: The ins and outs for projects +* Agenda Views:: Collecting information into views +* Markup:: Prepare text for rich export +* Exporting:: Sharing and publishing of notes +* Publishing:: Create a web site of linked Org files +* Working With Source Code:: Export, evaluate, and tangle code blocks +* Miscellaneous:: All the rest which did not fit elsewhere +* Hacking:: How to hack your way around +* MobileOrg:: Viewing and capture on a mobile device +* History and Acknowledgments:: How Org came into being +* Main Index:: An index of Org's concepts and features +* Key Index:: Key bindings and where they are described +* Variable Index:: Variables mentioned in the manual @detailmenu --- The Detailed Node Listing --- Introduction -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual Document structure -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org Tables -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables The spreadsheet -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc Hyperlinks -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough Internal links -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text TODO items -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists Extended use of TODO keywords -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others Progress logging -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? Tags -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags Properties and columns -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers Column view -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view Defining columns -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column Dates and times -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer Creating timestamps -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different Deadlines and scheduling -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again Capture - Refile - Archive -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects Capture -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types Capture templates -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context Archiving -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file Agenda views -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries The built-in agenda views -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review Presentation and sorting -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things Custom agenda views -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules Markup for rich export -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents Structural markup elements -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported Embedded La@TeX{} -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas Exporting -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format HTML export -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser La@TeX{} and PDF export -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation DocBook export -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters Publishing -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands Configuration -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages Sample configuration -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example Working with source code -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line Header arguments -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments Using header arguments * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values Specific header arguments -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* no-expand:: Turn off variable assignment and noweb expansion during tangling -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled +* file:: Specify a path for file output +* dir:: Specify the default directory for code block execution +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* no-expand:: Turn off variable assignment and noweb expansion during tangling +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable Miscellaneous -* Completion:: M-TAB knows what you need -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages Interaction with other packages -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts Hacking -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries Tables and lists in arbitrary syntax -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists MobileOrg -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end detailmenu @end menu @@ -504,11 +505,11 @@ @cindex introduction @menu -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual @end menu @node Summary, Installation, Introduction, Introduction @@ -805,17 +806,17 @@ edit the structure of the document. @menu -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org @end menu @node Outlines, Headlines, Document Structure, Document Structure @@ -1640,12 +1641,12 @@ @end ifnotinfo @menu -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables @end menu @node Built-in table editor, Column width and alignment, Tables, Tables @@ -2019,14 +2020,14 @@ formula, moving these references by arrow keys @menu -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc @end menu @node References, Formula syntax for Calc, The spreadsheet, The spreadsheet @@ -2730,14 +2731,14 @@ other files, Usenet articles, emails, and much more. @menu -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough @end menu @node Link format, Internal links, Hyperlinks, Hyperlinks @@ -2830,7 +2831,7 @@ earlier. @menu -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text @end menu @node Radio targets, , Internal links, Internal links @@ -3285,12 +3286,12 @@ methods to give you an overview of all the things that you have to do. @menu -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists @end menu @node TODO basics, TODO extensions, TODO Items, TODO Items @@ -3382,13 +3383,13 @@ TODO items in particular (@pxref{Tags}). @menu -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others @end menu @node Workflow states, TODO types, TODO extensions, TODO extensions @@ -3679,9 +3680,9 @@ work time}. @menu -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? @end menu @node Closing items, Tracking TODO state changes, Progress logging, Progress logging @@ -4143,9 +4144,9 @@ (@pxref{Faces for TODO keywords}). @menu -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags @end menu @node Tag inheritance, Setting tags, Tags, Tags @@ -4432,12 +4433,12 @@ (@pxref{Column view}). @menu -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers @end menu @node Property syntax, Special properties, Properties and Columns, Properties and Columns @@ -4673,9 +4674,9 @@ queries have collected selected items, possibly from a number of files. @menu -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view @end menu @node Defining columns, Using column view, Column view, Column view @@ -4687,8 +4688,8 @@ done by defining a column format line. @menu -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column @end menu @node Scope of column definitions, Column attributes, Defining columns, Defining columns @@ -4770,7 +4771,7 @@ @example :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.} - %10Time_Estimate@{:@} %CLOCKSUM + %10Time_Estimate@{:@} %CLOCKSUM :Owner_ALL: Tammy Mark Karl Lisa Don :Status_ALL: "In progress" "Not started yet" "Finished" "" :Approved_ALL: "[ ]" "[X]" @@ -4970,13 +4971,13 @@ is used in a much wider sense. @menu -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer @end menu @@ -5132,8 +5133,8 @@ @menu -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different @end menu @node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps @@ -5365,8 +5366,8 @@ sexp entry matches. @menu -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again @end menu @node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling @@ -5888,12 +5889,12 @@ trees to an archive file keeps the system compact and fast. @menu -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects @end menu @node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive @@ -5921,9 +5922,9 @@ does enhance it with templates and more. @menu -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types @end menu @node Setting up capture, Using capture, Capture, Capture @@ -6016,8 +6017,8 @@ @menu -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context @end menu @node Template elements, Template expansion, Capture templates, Capture templates @@ -6326,8 +6327,8 @@ @example (setq org-feed-alist '(("Slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" - "~/txt/org/feeds.org" "Slashdot Entries"))) + "http://rss.slashdot.org/Slashdot/slashdot" + "~/txt/org/feeds.org" "Slashdot Entries"))) @end example @noindent @@ -6440,8 +6441,8 @@ @end table @menu -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file @end menu @node Moving subtrees, Internal archiving, Archiving, Archiving @@ -6618,14 +6619,14 @@ @code{org-agenda-restore-windows-after-quit}. @menu -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries @end menu @node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views @@ -6767,12 +6768,12 @@ In this section we describe the built-in views. @menu -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review @end menu @node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views @@ -7237,9 +7238,9 @@ associated with the item. @menu -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things @end menu @node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting @@ -7628,12 +7629,12 @@ @group (defun org-my-auto-exclude-function (tag) (and (cond - ((string= tag "Net") - (/= 0 (call-process "/sbin/ping" nil nil nil - "-c1" "-q" "-t1" "mail.gnu.org"))) - ((or (string= tag "Errand") (string= tag "Call")) - (let ((hour (nth 2 (decode-time)))) - (or (< hour 8) (> hour 21))))) + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) (concat "-" tag))) (setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) @@ -7963,9 +7964,9 @@ dispatcher (@pxref{Agenda dispatcher}), just like the default commands. @menu -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules @end menu @node Storing searches, Block agenda, Custom agenda views, Custom agenda views @@ -8350,29 +8351,29 @@ summarizes the markup rules used in an Org-mode buffer. @menu -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents @end menu @node Structural markup elements, Images and tables, Markup, Markup @section Structural markup elements @menu -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported @end menu @node Document title, Headings and sections, Structural markup elements, Structural markup elements @@ -8801,11 +8802,11 @@ to do with it. @menu -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas @end menu @node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX @@ -9064,17 +9065,17 @@ enabled (default in Emacs 23). @menu -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format @end menu @node Selective export, Export options, Exporting, Exporting @@ -9327,14 +9328,14 @@ language, but with additional support for tables. @menu -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser @end menu @node HTML Export commands, Quoting HTML tags, HTML export, HTML export @@ -9681,12 +9682,12 @@ linked. @menu -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation @end menu @node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export @@ -10011,12 +10012,12 @@ Currently DocBook exporter only supports DocBook V5.0. @menu -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters @end menu @node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export @@ -10442,10 +10443,10 @@ Publishing has been contributed to Org by David O'Toole. @menu -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands @end menu @node Configuration, Uploading files, Publishing, Publishing @@ -10455,14 +10456,14 @@ and many other properties of a project. @menu -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages @end menu @node Project alist, Sources and destinations, Configuration, Configuration @@ -10836,8 +10837,8 @@ more complex, with a multi-component project. @menu -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example @end menu @node Simple example, Complex example, Sample configuration, Sample configuration @@ -10966,18 +10967,18 @@ The following sections describe Org-mode's code block handling facilities. @menu -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line @end menu @comment node-name, next, previous, up @@ -11271,8 +11272,8 @@ describes each header argument in detail. @menu -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments @end menu @node Using header arguments, Specific header arguments, Header arguments, Header arguments @@ -11282,7 +11283,7 @@ specific (and having higher priority) than the last. @menu * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values @@ -11419,25 +11420,25 @@ The following header arguments are defined: @menu -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default (possibly remote) +* file:: Specify a path for file output +* dir:: Specify the default (possibly remote) directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* no-expand:: Turn off variable assignment and noweb +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* no-expand:: Turn off variable assignment and noweb expansion during tangling * comments:: Toggle insertion of comments in tangled code files -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks @end menu @@ -12292,15 +12293,15 @@ @chapter Miscellaneous @menu -* Completion:: M-TAB knows what you need -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages @end menu @@ -12928,8 +12929,8 @@ with other code out there. @menu -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts @end menu @node Cooperation, Conflicts, Interaction, Interaction @@ -13077,9 +13078,9 @@ @lisp (add-hook 'org-mode-hook - (lambda () - (org-set-local 'yas/trigger-key [tab]) - (define-key yas/keymap [tab] 'yas/next-field-group))) + (lambda () + (org-set-local 'yas/trigger-key [tab]) + (define-key yas/keymap [tab] 'yas/next-field-group))) @end lisp @item @file{windmove.el} by Hovav Shacham @@ -13121,16 +13122,16 @@ Org. @menu -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries @end menu @node Hooks, Add-on packages, Hacking, Hacking @@ -13322,10 +13323,10 @@ @menu -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists @end menu @node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax @@ -14098,9 +14099,9 @@ (@pxref{Setting tags}) only for those set in these variables. @menu -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end menu @node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg
--- a/doc/misc/trampver.texi Thu Sep 16 10:51:56 2010 +0900 +++ b/doc/misc/trampver.texi Thu Sep 16 11:11:13 2010 +0900 @@ -9,7 +9,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.1.19 +@set trampver 2.2.0-pre @c Other flags from configuration @set instprefix /usr/local @@ -56,7 +56,6 @@ @set emacsothername XEmacs @set emacsotherdir xemacs @set emacsotherfilename tramp-xemacs.html -@set japanesemanual tramp_ja-emacs.html @end ifset @c XEmacs counterparts. @@ -73,7 +72,6 @@ @set emacsothername GNU Emacs @set emacsotherdir emacs @set emacsotherfilename tramp-emacs.html -@set japanesemanual tramp_ja-xemacs.html @end ifset @ignore
--- a/etc/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/etc/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,16 @@ +2010-09-13 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: Some Tramp methods are discontinued. + +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs.bash, emacs.csh, ms-kermit: Remove obsolete files (use + emacsclient -a instead of the first two). + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * NEWS: Mention the new libxml2 functions. + 2010-08-25 Kenichi Handa <handa@m17n.org> * HELLO: Change designation sequences for Arabic text.
--- a/etc/NEWS Thu Sep 16 10:51:56 2010 +0900 +++ b/etc/NEWS Thu Sep 16 11:11:13 2010 +0900 @@ -113,21 +113,17 @@ top, left, right or bottom. The Options => Show/Hide menu has entries for this. -** ImageMagick support +** ImageMagick support. It is now possible to use the Imagemagick library to load many new -image formats in Emacs. - -To enable, use the following configure option: ---with-imagemagick +image formats in Emacs. To enable this, use the configure option +`--with-imagemagick'. -The new function (imagemagick-types) returns a list of image file -extensions that your installation of imagemagick supports. +The new function `imagemagick-types' returns a list of image file +extensions that your installation of ImageMagick supports. The +function `imagemagick-register-types' enables ImageMagick support for +these imaeg types, minus those listed in `imagemagick-types-inhibit'. -The function (imagemagick-register-types) will enable the imagemagick -support for the extensions in imagemagick-types minus the types listed -in imagemagick-types-inhibit. - -See the Emacs Manual for more information. +See the Emacs Lisp Reference Manual for more information. ** The colors for selected text (the region face) are taken from the GTK theme when Emacs is built with GTK. @@ -321,10 +317,24 @@ variables `sql-product', `sql-user', `sql-server', `sql-database' and `sql-port' can now be safely used as local variables. +*** `sql-dialect' is a synonym for `sql-product'. + *** Added ability to login with a port on MySQL. The custom variable `sql-port' can be specified for connection to MySQL servers. +*** Dynamic selection of product in an SQL interactive session. +If you use `sql-product-interactive' to start an SQL interactive +session it uses the current value of `sql-product'. Preceding the +invocation with C-u will force it to ask for the product before +creating the session. + +*** Renaming a SQL interactive buffer when it is created. +Prefixing the SQL interactive commands (`sql-sqlite', `sql-postgres', +`sql-mysql', etc.) with C-u will force a new interactive session to be +started and will prompt for the new name. This will reduce the need +for `sql-rename-buffer' is most common use cases. + *** Command continuation prompts in SQL interactive mode are suppressed. Multiple line commands in SQL interactive mode, generate command continuation prompts which needlessly confuse the output. These @@ -424,6 +434,11 @@ *** It is possible now, to access alternative buses than the default system or session bus. +** Tramp + +*** The following access methods are discontinued: "ssh1_old", +"ssh2_old", "scp1_old", "scp2_old" and "fish". + * New Modes and Packages in Emacs 24.1 @@ -470,8 +485,19 @@ * Lisp changes in Emacs 24.1 +** New variable syntax-propertize-function to set syntax-table properties. +Replaces font-lock-syntactic-keywords which are now obsolete. +This allows syntax-table properties to be set independently from font-lock: +just call syntax-propertize to make sure the text is propertized. +Together with this new variable come a new hook +syntax-propertize-extend-region-functions, as well as two helper functions: +syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords +as-is; and syntax-propertize-rules which provides a new way to specify +syntactic rules. + ** New hook post-self-insert-hook run at the end of self-insert-command. ++++ ** Syntax tables support a new "comment style c" additionally to style b. ** frame-local variables cannot be let-bound any more. ** prog-mode is a new major-mode meant to be the parent of programming mode. @@ -497,6 +523,14 @@ *** `image-extension-data' is renamed to `image-metadata'. +** XML and HTML parsing + +*** If Emacs is compiled with libxml2 support (which is the default), +two new Emacs Lisp-level functions are defined: `html-parse-string' +(which will parse "real world" HTML) and `xml-parse-string' (which +parses XML). Both return an Emacs Lisp parse tree. See the Emacs +Lisp Reference Manual for details. + ** Isearch *** New hook `isearch-update-post-hook' that runs in `isearch-update'.
--- a/etc/NEWS.23 Thu Sep 16 10:51:56 2010 +0900 +++ b/etc/NEWS.23 Thu Sep 16 11:11:13 2010 +0900 @@ -40,6 +40,8 @@ * Lisp changes in Emacs 23.3 +** The use of unintern without an obarray arg is declared obsolete. + ** New function byte-to-string, like char-to-string but for bytes.
--- a/etc/TODO Thu Sep 16 10:51:56 2010 +0900 +++ b/etc/TODO Thu Sep 16 11:11:13 2010 +0900 @@ -625,6 +625,508 @@ the window associated with that modeline. http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html +* Things to be done for specific packages or features + +** ImageMagick support + +*** image-type-header-regexps priorities the jpeg loader over the +ImageMagick one. This is not wrong, but how should a user go about +prefering the ImageMagick loader? The user might like zooming etc in jpegs. + +Try (setq image-type-header-regexps nil) for a quick hack to prefer +ImageMagick over the jpg loader. + +*** For some reason its unbearably slow to look at a page in a large +image bundle using the :index feature. The ImageMagick "display" +command is also a bit slow, but nowhere near as slow as the Emacs +code. It seems ImageMagick tries to unpack every page when loading the +bundle. This feature is not the primary usecase in Emacs though. + +ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load. It +is now much faster to use the :index feature, but still not very fast. + +*** Try to cache the num pages calculation. It can take a while to +calculate the number of pages, and if you need to do it for each page +view, page-flipping becomes uselessly slow. + +*** Integrate with image-dired. + +*** Integrate with docview. + +*** Integrate with image-mode. +Some work has been done, e.g. M-x image-transform-fit-to-height will +fit the image to the height of the Emacs window. + +*** Look for optimizations for handling images with low depth. +Currently the code seems to default to 24 bit RGB which is costly for +images with lower bit depth. + +*** Decide what to do with some uncommitted imagemagick support +functions for image size etc. + +*** Test with more systems. +Tested on Fedora 12, 14, and the libmagick that ships with it. +I also tried using an ImageMagick compiled from their SVN, in +parallel with the one packaged by Fedora, it worked well. +Ubuntu 8.04 was tested, but it seems it ships a broken ImageMagick. + +** nxml mode + +*** High priority + +**** Command to insert an element template, including all required +attributes and child elements. When there's a choice of elements +possible, we could insert a comment, and put an overlay on that +comment that makes it behave like a button with a pop-up menu to +select the appropriate choice. + +**** Command to tag a region. With a schema should complete using legal +tags, but should work without a schema as well. + +**** Provide a way to conveniently rename an element. With a schema should +complete using legal tags, but should work without a schema as well. + +*** Outlining + +**** Implement C-c C-o C-q. + +**** Install pre/post command hook for moving out of invisible section. + +**** Put a modify hook on invisible sections that expands them. + +**** Integrate dumb folding somehow. + +**** An element should be able to be its own heading. + +**** Optimize to avoid complete buffer scan on each command. + +**** Make it work with HTML-style headings (i.e. level indicated by +name of heading element rather than depth of section nesting). + +**** Recognize root element as a section provided it has a title, even +if it doesn't match section-element-name-regex. + +**** Support for incremental search automatically making hidden text visible. + +**** Allow title to be an attribute. + +**** Command that says to recognize the tag at point as a section/heading. + +**** Explore better ways to determine when an element is a section +or a heading. + +**** rng-next-error needs to either ignore invisible portion or reveal it +(maybe use isearch oriented text properties). + +**** Errors within hidden section should be highlighted by underlining the +ellipsis. + +**** Make indirect buffers work. + +**** How should nxml-refresh outline recover from non well-formed tags? + +**** Hide tags in title elements? + +**** Use overlays instead of text properties for holding outline state? +Necessary for indirect buffers to work? + +**** Allow an outline to go in the speedbar. + +**** Split up outlining manual section into subsections. + +**** More detail in the manual about each outlining command. + +**** More menu entries for hiding/showing? + +**** Indication of many lines have been hidden? + +*** Locating schemas + +**** Should rng-validate-mode give the user an opportunity to specify a +schema if there is currently none? Or should it at least give a hint +to the user how to specify a non-vacuous schema? + +**** Support for adding new schemas to schema-locating files. +Add documentElement and namespace elements. + +**** C-c C-w should be able to report current type id. + +**** Implement doctypePublicId. + +**** Implement typeIdBase. + +**** Implement typeIdProcessingInstruction. + +**** Support xml:base. + +**** Implement group. + +**** Find preferred prefix from schema-locating files. Get rid of +rng-preferred-prefix-alist. + +**** Inserting document element with vacuous schema should complete using +document elements declared in schema locating files, and set schema +appropriately. + +**** Add a ruleType attribute to the <include> element? + +**** Allow processing instruction in prolog to contain the compact syntax +schema directly. + +**** Use RDDL to locate a schema based on the namespace URI. + +**** Should not prompt to add redundant association to schema locating file. + +**** Command to reload current schema. + +*** Schema-sensitive features + +**** Should filter dynamic markup possibilities using schema validity, by +adding hook to nxml-mode. + +**** Dynamic markup word should (at least optionally) be able to look in +other buffers that are using nxml-mode. + +**** Should clicking on Invalid move to next error if already on an error? + +**** Take advantage of a:documentation. Needs change to schema format. + +**** Provide feasible validation (as in Jing) toggle. + +**** Save the validation state as a property on the error overlay to enable +more detailed diagnosis. + +**** Provide an Error Summary buffer showing all the validation errors. + +**** Pop-up menu. What is useful? Tag a region (should be greyed out if +the region is not balanced). Suggestions based on error messages. + +**** Have configurable list of namespace URIs so that we can provide +namespace URI completion on extension elements or with schema-less documents. + +**** Allow validation to handle XInclude. + +**** ID/IDREF support. + +*** Completion + +**** Make it work with icomplete. Only use a function to complete when +some of the possible names have undeclared namespaces. + +**** How should C-return in mixed text work? + +**** When there's a vacuous schema, C-return after < will insert the end-tag. +Is this a bug or a feature? + +**** After completing start-tag, ensure we don't get unhelpful message +from validation + +**** Syntax table for completion. + +**** Should complete start-tag name with a space if namespace attributes +are required. + +**** When completing start-tag name with no prefix and it doesn't match +should try to infer namespace from local name. + +**** Should completion pay attention to characters after point? If so, how? + +**** When completing start-tag name, add required atts if only one required +attribute. + +**** When completing attribute name, add attribute value if only one value +is possible. + +**** After attribute-value completion, insert space after close delimiter +if more attributes are required. + +**** Complete on enumerated data values in elements. + +**** When in context that allows only elements, should get tag +completion without having to type < first. + +**** When immediately after start-tag name, and name is valid and not +prefix of any other name, should C-return complete on attribute names? + +**** When completing attributes, more consistent to ignore all attributes +after point. + +**** Inserting attribute value completions needs to be sensitive to what +delimiter is used so that it quotes the correct character. + +**** Complete on encoding-names in XML decl. + +**** Complete namespace declarations by searching for all namespaces +mentioned in the schema. + +*** Well-formed XML support + +**** Deal better with Mule-UCS + +**** Deal with UTF-8 BOM when reading. + +**** Complete entity names. + +**** Provide some support for entity names for MathML. + +**** Command to repeat the last tag. + +**** Support for changing between character references and characters. +Need to check that context is one in which character references are +allowed. xmltok prolog parsing will need to distinguish parameter +literals from other kinds of literal. + +**** Provide a comment command to bind to M-; that works better than the +normal one. + +**** Make indenting in a multi-line comment work. + +**** Structure view. Separate buffer displaying element tree. +Be able to navigate from structure view to document and vice-versa. + +**** Flash matching >. + +**** Smart selection command that selects increasingly large syntactically +coherent chunks of XML. If point is in an attribute value, first +select complete value; then if command is repeated, select value plus +delimiters, then select attribute name as well, then complete +start-tag, then complete element, then enclosing element, etc. + +**** ispell integration. + +**** Block-level items in mixed content should be indented, e.g: + <para>This is list: + <ul> + <li>item</li> + +**** Provide option to indent like this: + <para>This is a paragraph + occupying multiple lines.</para> + +**** Option to add make a / that closes a start-tag electrically insert a +space for the XHTML guys. + +**** C-M-q should work. + +*** Datatypes + +**** Figure out workaround for CJK characters with regexps. + +**** Does category C contain Cn? + +**** Do ENTITY datatype properly. + +*** XML Parsing Library + +**** Parameter entity parsing option, nil (never), t (always), +unless-standalone (unless standalone="yes" in XML declaration). + +**** When a file is currently being edited, there should be an option to +use its buffer instead of the on-disk copy. + +*** Handling all XML features + +**** Provide better support for editing external general parsed entities. +Perhaps provide a way to force ignoring undefined entities; maybe turn +this on automatically with <?xml encoding=""?> (with no version +pseudo-att). + +**** Handle internal general entity declarations containing elements. + +**** Handle external general entity declarations. + +**** Handle default attribute declarations in internal subset. + +**** Handle parameter entities (including DTD). + +*** RELAX NG + +**** Do complete schema checking, at least optionally. + +**** Detect include/external loops during schema parse. + +**** Coding system detection for schemas. Should use utf-8/utf-16 per the +spec. But also need to allow encodings other than UTF-8/16 to support +CJK charsets that Emacs cannot represent in Unicode. + +*** Catching XML errors + +**** Check public identifiers. + +**** Check default attribute values. + +*** Performance + +**** Explore whether overlay-recenter can cure overlays performance problems. + +**** Cache schemas. Need to have list of files and mtimes. + +**** Make it possible to reduce rng-validate-chunk-size significantly, +perhaps to 500 bytes, without bad performance impact: don't do +redisplay on every chunk; pass continue functions on other uses of +rng-do-some-validation. + +**** Cache after first tag. + +**** Introduce a new name class that is a choice between names (so that +we can use member) + +**** intern-choice should simplify after patterns with same 1st/2nd args + +**** Large numbers of overlays slow things down dramatically. Represent +errors using text properties. This implies we cannot incrementally +keep track of the number of errors, in order to determine validity. +Instead, when validation completes, scan for any characters with an +error text property; this seems to be fast enough even with large +buffers. Problem with error at end of buffer, where there's no +character; need special variable for this. Need to merge face from +font-lock with the error face: use :inherit attribute with list of two +faces. How do we avoid making rng-valid depend on nxml-mode? + +*** Error recovery + +**** Don't stop at newline in looking for close of start-tag. + +**** Use indentation to guide recovery from mismatched end-tags + +**** Don't keep parsing when currently not well-formed but previously +well-formed + +**** Try to recover from a bad start-tag by popping an open element if +there was a mismatched end-tag unaccounted for. + +**** Try to recover from a bad start-tag open on the hypothesis that there +was an error in the namespace URI. + +**** Better recovery from ill-formed XML declarations. + +*** Useability improvements + +**** Should print a "Parsing..." message during long movements. + +**** Provide better position for reference to undefined pattern error. + +**** Put Well-formed in the mode-line when validating against any-content. + +**** Trim marking of illegal data for leading and trailing whitespace. + +**** Show Invalid status as soon as we are sure it's invalid, rather than +waiting for everything to be completely up to date. + +**** When narrowed, Valid or Invalid status should probably consider only +validity of narrowed region. + +*** Bug fixes + +**** Need to give an error for a document like: <foo/><![CDATA[ ]]> + +**** Make nxml-forward-balanced-item work better for the prolog. + +**** Make filling and indenting comments work in the prolog. + +**** Should delete RNC Input buffers. + +**** Figure out what regex use for NCName and use it consistently, + +**** Should have not-well-formed tokens in ref. + +**** Require version in XML declaration? Probably not because prevents +use for external parsed entities. At least forbid standalone without version. + +**** Reject schema that compiles to rng-not-allowed-ipattern. + +**** Move point backwards on schema parse error so that it's on the right token. + +*** Internal + +**** Use rng-quote-string consistently. + +**** Use parsing library for XML to texinfo conversion. + +**** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of +xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to +nxml-t-token-start. + +**** Can we set fill-prefix to nil and rely on indenting? + +**** xmltok should make available replacement text of entities containing +elements + +**** In rng-valid, instead of using modification-hooks and +insert-behind-hooks on dependent overlays, use same technique as nxml-mode. + +**** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on +Mule-UCS); overlays/text properties vs extents; absence of +fontification-functions hook. + +*** Fontification + +**** Allow face to depend on element qname, attribute qname, attribute +value. Use list with pairs of (R . F), where R specifies regexps and +F specifies faces. How can this list be made to depend on the document type? + +*** Other + +**** Support RELAX NG XML syntax (use XML parsing library). + +**** Support W3C XML Schema (use XML parsing library). + +**** Command to infer schema from current document (like trang). + +*** Schemas + +**** XSLT schema should take advantage of RELAX NG to express cooccurrence +constraints on attributes (e.g. xsl:template). + +*** Documentation + +**** Move material from README to manual. + +**** Document encodings. + +*** Notes + +**** How can we allow an error to be displayed on a different token from +where it is detected? In particular, for a missing closing ">" we +will need to display it at the beginning of the following token. At the +moment, when we parse the following token the error overlay will get cleared. + +**** How should rng-goto-next-error deal with narrowing? + +**** Perhaps should merge errors having same start position even if they +have different ends. + +**** How to handle surrogates? One possibility is to be compatible with +utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible +with this. + +**** Should we distinguish well-formedness errors from invalidity errors? +(I think not: we may want to recover from a bad start-tag by implying +an end-tag.) + +**** Seems to be a bug with Emacs, where a mouse movement that causes +help-echo text to appear counts as pending input but does not cause +idle timer to be restarted. + +**** Use XML to represent this file. + +**** I had a TODO which said simply "split-string". What did I mean? + +**** Investigate performance on large files all on one line. + +*** Issues for Emacs versions >= 22 + +**** Take advantage of UTF-8 CJK support. + +**** Supply a next-error-function. + +**** Investigate this NEWS item "Emacs now tries to set up buffer coding +systems for HTML/XML files automatically." + +**** Take advantage of the pointer text property. + +**** Leverage char-displayable-p. + * Internal changes ** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction
--- a/etc/emacs.bash Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -### emacs.bash --- contact/resume an existing Emacs, or start a new one - -## Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -## Free Software Foundation, Inc. - -## Author: Noah Friedman - -## This file is part of GNU Emacs. - -## GNU Emacs is free software: you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 3 of the License, or -## (at your option) any later version. - -## GNU Emacs is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. - -## You should have received a copy of the GNU General Public License -## along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a bash command named `edit' which contacts/resumes an -## existing emacs or starts a new one if none exists. - -## One way or another, any arguments are passed to emacs to specify files -## (provided you have loaded `resume.el'). - -## This function assumes the emacs program is named `emacs' and is somewhere -## in your load path. If either of these is not true, the most portable -## (and convenient) thing to do is to make an alias called emacs which -## refers to the real program, e.g. -## -## alias emacs=/usr/local/bin/gemacs - -function edit () -{ - local windowsys="${WINDOW_PARENT+sun}" - - windowsys="${windowsys:-${DISPLAY+x}}" - - if [ -n "${windowsys:+set}" ]; then - # Do not just test if these files are sockets. On some systems - # ordinary files or fifos are used instead. Just see if they exist. - if [ -e "${HOME}/.emacs_server" -o -e "/tmp/emacs${UID}/server" ]; then - emacsclient "$@" - return $? - else - echo "edit: starting emacs in background..." 1>&2 - fi - - case "${windowsys}" in - x ) (emacs "$@" &) ;; - sun ) echo "unsupported window system"; return 1 ;; - esac - else - if jobs %emacs 2> /dev/null ; then - echo "$(pwd)" "$@" >| ${HOME}/.emacs_args && fg %emacs - else - emacs "$@" - fi - fi -} - - -# arch-tag: 1e1b74b9-bf2c-4b23-870f-9eebff7515cb -### emacs.bash ends here
--- a/etc/emacs.csh Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -### emacs.csh - -## Add legal notice if non-trivial amounts of code are added. - -## Author: Michael DeCorte - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a csh command named `edit' which resumes an -## existing Emacs or starts a new one if none exists. -## One way or another, any arguments are passed to Emacs to specify files -## (provided you have loaded `resume.el'). - -## These are the possible values of $whichjob -## 1 = new ordinary emacs (the -nw is so that it doesn't try to do X) -## 2 = resume emacs -## 3 = new emacs under X (-i is so that you get a reasonable icon) -## 4 = resume emacs under X -set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS" - -alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\ - "emacsclient \!* &") ; \ - jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \ - @ isjob = ! $status; \ - @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \ - test -S ~/.emacs_server && emacsclient \!* \ - || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]' - -# arch-tag: 433d58df-15b9-446f-ad37-f0393e3a23d4
--- a/etc/ms-kermit Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -;;; The code here is forced by the interface, and is not subject to -;;; copyright, constituting the only possible expression of the algorithm -;;; in this format. - -;;; This file is designed for an 8-bit connection. -;;; Use the file ms-7bkermit if you have a 7-bit connection. - -;; Meta key mappings for EMACS -;; By Robert Earl (rearl@watnxt3.ucr.edu) -;; May 13, 1990 -;; -;; WARNING: -;; requires an 8-bit path to host. many dialups and lans won't pass the -;; eighth bit by default and may require a special command to turn this -;; off. `screen' is known to mask the eighth bit of input as well. - -set term controls 8-bit -set translation key off - -;; control keys -set key \3449 \128 ;; m-c-@ -set key \3358 \129 ;; m-c-a -set key \3376 \130 ;; m-c-b -set key \3374 \131 ;; m-c-c -set key \3360 \132 ;; m-c-d -set key \3346 \133 ;; m-c-e -set key \3361 \134 ;; m-c-f -set key \3362 \135 ;; m-c-g -set key \3342 \136 ;; m-bs -set key \3363 \136 ;; m-c-h (sends same code as above) -set key \2469 \137 ;; m-tab -set key \3351 \137 ;; m-c-i (same as above) -set key \3364 \138 ;; m-c-j -set key \3365 \139 ;; m-c-k -set key \3366 \140 ;; m-c-l -;set key \3378 \141 ;; m-c-m -set key \2332 \141 ;; m-ret (sends same code as above) -set key \3377 \142 ;; m-c-n -set key \3352 \143 ;; m-c-o -set key \3353 \144 ;; m-c-p -set key \3344 \145 ;; m-c-q -set key \3347 \146 ;; m-c-r -set key \3359 \147 ;; m-c-s -set key \3348 \148 ;; m-c-t -set key \3350 \149 ;; m-c-u -set key \3375 \150 ;; m-c-v -set key \3345 \151 ;; m-c-w -set key \3373 \152 ;; m-c-x -set key \3349 \153 ;; m-c-y -set key \3372 \154 ;; m-c-z - -;; misc keys -;set key \3354 \155 ;; m-c-[ -set key \2305 \155 ;; m-esc (sends same as above) -set key \3371 \156 ;; m-c-\ -set key \3355 \157 ;; m-c-] -set key \3453 \158 ;; m-c-^ -set key \3458 \159 ;; m-c-_ - -;; \160 is conspicuously missing here-- -;; alt-spc doesn't generate a distinct scan code... -;; neither do shift-spc and ctrl-spc. -;; no idea why. - -set key \2936 \161 ;; m-! -set key \2856 \162 ;; m-" -set key \2938 \163 ;; m-# -set key \2939 \164 ;; m-$ -set key \2940 \165 ;; m-% -set key \2942 \166 ;; m-& -set key \2344 \167 ;; m-' -set key \2944 \168 ;; m-( -set key \2945 \169 ;; m-) -set key \2943 \170 ;; m-* -set key \2947 \171 ;; m-+ -set key \2355 \172 ;; m-, -set key \2434 \173 ;; m-- -set key \2356 \174 ;; m-. -set key \2357 \175 ;; m-/ - -;; number keys -set key \2433 \176 ;; m-0 -set key \2424 \177 ;; m-1 -set key \2425 \178 -set key \2426 \179 -set key \2427 \180 -set key \2428 \181 -set key \2429 \182 -set key \2430 \183 -set key \2431 \184 -set key \2432 \185 ;; m-9 - -set key \2855 \186 ;; m-: -set key \2343 \187 ;; m-; -set key \2867 \188 ;; m-< -set key \2435 \189 ;; m-= -set key \2868 \190 ;; m-> -set key \2869 \191 ;; m-? -set key \2937 \192 ;; m-@ - -;; shifted A-Z -set key \2846 \193 ;; m-A -set key \2864 \194 -set key \2862 \195 -set key \2848 \196 -set key \2834 \197 -set key \2849 \198 -set key \2850 \199 -set key \2851 \200 -set key \2839 \201 -set key \2852 \202 -set key \2853 \203 -set key \2854 \204 -set key \2866 \205 -set key \2865 \206 -set key \2840 \207 -set key \2841 \208 -set key \2832 \209 -set key \2835 \210 -set key \2847 \211 -set key \2836 \212 -set key \2838 \213 -set key \2863 \214 -set key \2833 \215 -set key \2861 \216 -set key \2837 \217 -set key \2860 \218 ;; m-Z - -set key \2330 \219 ;; m-[ -set key \2347 \220 ;; m-\ -set key \2331 \221 ;; m-] -set key \2941 \222 ;; m-^ -set key \2946 \223 ;; m-_ -set key \2345 \224 ;; m-` - -;; lowercase a-z -set key \2334 \225 ;; m-a -set key \2352 \226 -set key \2350 \227 -set key \2336 \228 -set key \2322 \229 -set key \2337 \230 -set key \2338 \231 -set key \2339 \232 -set key \2327 \233 -set key \2340 \234 -set key \2341 \235 -set key \2342 \236 -set key \2354 \237 -set key \2353 \238 -set key \2328 \239 -set key \2329 \240 -set key \2320 \241 -set key \2323 \242 -set key \2335 \243 -set key \2324 \244 -set key \2326 \245 -set key \2351 \246 -set key \2321 \247 -set key \2349 \248 -set key \2325 \249 -set key \2348 \250 ;; m-z - -;; more shifted misc. keys -set key \2842 \251 ;; m-{ -set key \2859 \252 ;; m-| -set key \2843 \253 ;; m-} -set key \2857 \254 ;; m-~ -set key \2318 \255 ;; m-del - - -;;; arch-tag: 93cefb0a-2b07-4d09-ae78-4d807b15645d
--- a/lisp/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,663 @@ +2010-09-15 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-compat.el (tramp-compat-with-temp-message) + (tramp-compat-font-lock-add-keywords, tramp-compat-process-get) + (tramp-compat-process-put): New defuns. + + * net/tramp.el (top): + * net/tramp-gvfs.el (top): + * net/tramp-cache.el (top): Use `tramp-compat-font-lock-add-keywords'. + + * net/tramp.el (tramp-progress-reporter-update): Use + `tramp-compat-funcall. + + * net/tramp.el (tramp-process-actions): + * net/tramp-gvfs.el (tramp-handle-vc-registered): + * net/tramp-sh.el (tramp-gvfs-handler-askquestion) + (tramp-get-remote-stat, tramp-get-remote-readlink): Use + `tramp-compat-with-temp-message'. + + * net/tramp-sh.el (top): Require 'cl. + (tramp-handle-start-file-process): Use `tramp-compat-process-get'. + (tramp-open-connection-setup-interactive-shell): Use + `tramp-compat-process-put'. + +2010-09-15 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-forward-<>-arglist-recur): Correct the + indentation. + (c-forward-<>-arglist-recur): Fix an infinite recursion. + +2010-09-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-warning-types): New type + `lexical' for warnings related to lexical scoping. + (byte-compile-file-form-defvar, byte-compile-defvar): Warn about + global vars which don't have a prefix and could hence affect lexical + scoping in unrelated files. + +2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el: Revert back to version + cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes + seem problematic. + +2010-09-14 Juanma Barranquero <lekktu@gmail.com> + + * obsolete/old-whitespace.el (whitespace-unload-function): + Explicitly pass `obarray' to `unintern' to avoid a warning. + +2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/byte-run.el (set-advertised-calling-convention): + Add `when' argument. Update callers. + + * subr.el (unintern): Declare the obarray arg mandatory. + +2010-09-14 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-list-entries-hook, diary-sort-entries): + Doc fixes. + + * calendar/diary-lib.el (diary-included-files): New variable. + (diary-list-entries): Maybe initialize diary-included-files. + (diary-include-other-diary-files): Append to diary-included-files. + * calendar/appt.el (appt-update-list): Also check the members of + diary-included-files. (Bug#6999) + (appt-check): Doc fix. + +2010-09-14 David Reitter <david.reitter@gmail.com> + + * simple.el (line-move-visual): Do not truncate goal column to + integer size. (Bug#7020) + +2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * repeat.el (repeat): Allow repeating when the last event is a click. + Suggested by Drew Adams (bug#6256). + +2010-09-14 Sascha Wilde <wilde@sha-bang.de> + + * vc/vc-hg.el (vc-hg-state,vc-hg-working-revision): + Replace setting HGRCPATH to "" by some less invasive --config options. + +2010-09-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock-beginning-of-syntax-function): + Mark as obsolete. + +2010-09-14 Glenn Morris <rgm@gnu.org> + + * menu-bar.el (menu-bar-options-save): Fix handling of menu-bar + and tool-bar modes. (Bug#6211) + (menu-bar-mode): Move setting of standard-value after the + minor-mode definition, otherwise it seems to have no effect. + +2010-09-14 Masatake YAMATO <yamato@redhat.com> + + * progmodes/antlr-mode.el (antlr-font-lock-additional-keywords): + Fix typo. (Bug#6976) + +2010-09-14 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el: Allow cleaning up blanks without blank + visualization (Bug#6651). Adjust help window for + whitespace-toggle-options (Bug#6479). Allow to use fill-column + instead of whitespace-line-column (from EmacsWiki). New version 13.1. + (whitespace-style): Add new value 'face. Adjust docstring. + (whitespace-space, whitespace-hspace, whitespace-tab): + Adjust foreground property face. + (whitespace-line-column): Adjust docstring and type declaration. + (whitespace-style-value-list, whitespace-toggle-option-alist) + (whitespace-help-text): Adjust const initialization. + (whitespace-toggle-options, global-whitespace-toggle-options): + Adjust docstring. + (whitespace-display-window, whitespace-interactive-char) + (whitespace-style-face-p, whitespace-color-on): Adjust code. + (whitespace-help-scroll): New fun. + +2010-09-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * calendar/time-date.el (format-seconds): Comment fix. + +2010-09-13 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.7. + (sql-buffer-live-p): Improve detection. + (sql-find-sqli-buffer, sql-set-sqli-buffer-generally) + (sql-set-sqli-buffer): Use it. + (sql-product-interactive): Run `sql-set-sqli-hook'. + (sql-rename-buffer): Code cleanup. + (sql-redirect, sql-redirect-value): New functions. More to come. + +2010-09-13 Juanma Barranquero <lekktu@gmail.com> + + Port tramp-related Makefile changes of revnos 101381, 101422 to Windows. + * makefile.w32-in (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el. + (TRAMP_SRC): New macro. + ($(lisp)/net/tramp-loaddefs.el): New target. + +2010-09-13 Michael Albinus <michael.albinus@gmx.de> + + Major code cleanup. Split tramp.el into tramp.el and tramp-sh.el. + + * Makefile.in (TRAMP_SRC): Remove tramp-fish.el. Add tramp-sh.el. + + * net/tramp.el (top): Don't show loading message. Require just + 'tramp-compat, everything else is required there. + Use `ignore-errors' where appropriate. + (tramp-inline-compress-start-size, tramp-copy-size-limit) + (tramp-terminal-type, tramp-end-of-output) + (tramp-initial-end-of-output, tramp-completion-function-alist-rsh) + (tramp-completion-function-alist-ssh) + (tramp-completion-function-alist-telnet) + (tramp-completion-function-alist-su) + (tramp-completion-function-alist-putty, tramp-remote-path) + (tramp-remote-process-environment, tramp-sh-extra-args) + (tramp-actions-before-shell, tramp-uudecode) + (tramp-perl-file-truename, tramp-perl-file-name-all-completions) + (tramp-perl-file-attributes) + (tramp-perl-directory-files-and-attributes) + (tramp-perl-encode-with-module, tramp-perl-decode-with-module) + (tramp-perl-encode, tramp-perl-decode) + (tramp-vc-registered-read-file-names, tramp-file-mode-type-map) + (tramp-file-name-handler-alist, tramp-make-tramp-temp-file) + (tramp-handle-make-symbolic-link, tramp-handle-load) + (tramp-handle-file-name-as-directory) + (tramp-handle-file-name-directory) + (tramp-handle-file-name-nondirectory, tramp-handle-file-truename) + (tramp-handle-file-exists-p, tramp-handle-file-attributes) + (tramp-do-file-attributes-with-ls) + (tramp-do-file-attributes-with-perl) + (tramp-do-file-attributes-with-stat) + (tramp-handle-set-visited-file-modtime) + (tramp-handle-verify-visited-file-modtime) + (tramp-handle-set-file-modes, tramp-handle-set-file-times) + (tramp-set-file-uid-gid, tramp-remote-selinux-p) + (tramp-handle-file-selinux-context) + (tramp-handle-set-file-selinux-context) + (tramp-handle-file-executable-p, tramp-handle-file-readable-p) + (tramp-handle-file-newer-than-file-p, tramp-handle-file-modes) + (tramp-handle-file-directory-p, tramp-handle-file-regular-p) + (tramp-handle-file-symlink-p, tramp-handle-file-writable-p) + (tramp-handle-file-ownership-preserved-p) + (tramp-handle-directory-file-name, tramp-handle-directory-files) + (tramp-handle-directory-files-and-attributes) + (tramp-do-directory-files-and-attributes-with-perl) + (tramp-do-directory-files-and-attributes-with-stat) + (tramp-handle-file-name-all-completions) + (tramp-handle-file-name-completion, tramp-handle-add-name-to-file) + (tramp-handle-copy-file, tramp-handle-copy-directory) + (tramp-handle-rename-file, tramp-do-copy-or-rename-file) + (tramp-do-copy-or-rename-file-via-buffer) + (tramp-do-copy-or-rename-file-directly) + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-handle-make-directory, tramp-handle-delete-directory) + (tramp-handle-delete-file) + (tramp-handle-dired-recursive-delete-directory) + (tramp-handle-dired-compress-file, tramp-handle-dired-uncache) + (tramp-handle-insert-directory) + (tramp-handle-unhandled-file-name-directory) + (tramp-handle-expand-file-name) + (tramp-handle-substitute-in-file-name) + (tramp-handle-executable-find, tramp-process-sentinel) + (tramp-handle-start-file-process, tramp-handle-process-file) + (tramp-handle-call-process-region, tramp-handle-shell-command) + (tramp-handle-file-local-copy, tramp-handle-file-remote-p) + (tramp-handle-insert-file-contents) + (tramp-handle-insert-file-contents-literally) + (tramp-handle-find-backup-file-name) + (tramp-handle-make-auto-save-file-name, tramp-handle-write-region) + (tramp-vc-registered-file-names, tramp-handle-vc-registered) + (tramp-sh-file-name-handler, tramp-vc-file-name-handler) + (tramp-maybe-send-script, tramp-set-auto-save, tramp-run-test) + (tramp-run-test2, tramp-find-executable, tramp-set-remote-path) + (tramp-find-file-exists-command, tramp-open-shell) + (tramp-find-shell, tramp-barf-if-no-shell-prompt) + (tramp-open-connection-setup-interactive-shell) + (tramp-local-coding-commands, tramp-remote-coding-commands) + (tramp-find-inline-encoding, tramp-call-local-coding-command) + (tramp-inline-compress-commands, tramp-find-inline-compress) + (tramp-compute-multi-hops, tramp-maybe-open-connection) + (tramp-send-command , tramp-wait-for-output) + (tramp-send-command-and-check, tramp-barf-unless-okay) + (tramp-send-command-and-read, tramp-mode-string-to-int) + (tramp-convert-file-attributes, tramp-check-cached-permissions) + (tramp-file-mode-from-int, tramp-file-mode-permissions) + (tramp-shell-case-fold, tramp-make-copy-program-file-name) + (tramp-method-out-of-band-p, tramp-local-host-p) + (tramp-get-remote-path, tramp-get-remote-tmpdir) + (tramp-get-ls-command, tramp-get-ls-command-with-dired) + (tramp-get-test-command, tramp-get-test-nt-command) + (tramp-get-file-exists-command, tramp-get-remote-ln) + (tramp-get-remote-perl, tramp-get-remote-stat) + (tramp-get-remote-readlink, tramp-get-remote-trash) + (tramp-get-remote-id, tramp-get-remote-uid, tramp-get-remote-gid) + (tramp-get-local-uid, tramp-get-local-gid) + (tramp-get-inline-compress, tramp-get-inline-coding): Move to + tramp-sh.el. + (tramp-methods, tramp-default-method-alist) + (tramp-default-user-alist, tramp-foreign-file-name-handler-alist): + Move initialization to tramp-sh.el. + (tramp-temp-name-prefix): Make it a defconst. + (tramp-dissect-file-name): Don't check anymore for multi-hop + methods. + (tramp-debug-outline-regexp): Add a docstring. + (tramp-debug-outline-level): Renamed from `tramp-outline-level'. + (tramp-get-debug-buffer): Use it. + + * net/tramp-cache.el (top): Set tramp-autoload cookie for + initialization forms. + (tramp-set-connection-property): Don't protect `tramp-message' + call, it isn't necessary any longer. + (tramp-dump-connection-properties): Use `ignore-errors'. + + * net/tramp-compat.el (top): Require 'advice, 'format-spec, + 'password-cache and 'auth-source. + + * net/tramp-gvfs.el (top): + * net/tramp-smb.el (top): Require 'tramp-sh. + + * net/tramp-gw.el (tramp-gw-open-network-stream): Use `ignore-errors'. + + * net/tramp-sh.el: New file, derived from tramp.el. + (top): Initialize `tramp-methods', `tramp-default-method-alist', + `tramp-default-user-alist', `tramp-foreign-file-name-handler-alist'. + Remove "scp1_old", "scp2_old", "ssh1_old", "ssh2_old". Use + `ignore-errors' where appropriate. + (tramp-sh-file-name-handler-alist): Renamed from + `tramp-file-name-handler-alist'. + (tramp-send-command-and-check): Return t or nil. Remove all + `zerop' checks, where called. + (tramp-handle-set-file-modes) + (tramp-do-copy-or-rename-file-directly) + (tramp-handle-delete-directory, tramp-handle-delete-file) + (tramp-maybe-send-script, ): Use `tramp-barf-unless-okay'. + (tramp-sh-file-name-handler, tramp-send-command-and-check) + (tramp-get-remote-ln): Set tramp-autoload cookie. + + * net/tramp-fish.el: Remove file. + +2010-09-13 Daiki Ueno <ueno@unixuser.org> + + * epa-file.el (epa-file-insert-file-contents): If visiting, bind + buffer-file-name to avoid file-locking. (Bug#7026) + +2010-09-13 Julien Danjou <julien@danjou.info> + + * notifications.el (notifications-notify): Add support for + image-path and sound-name. + (notifications-specification-version): Add this variable. + +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key. + +2010-09-12 Leo <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-server-commands, rcirc-client-commands) + (rcirc-completion-start): New variables. + (rcirc-nick-completions): Rename to rcirc-completions. + (rcirc-nick-completion-start-offset): Delete. + (rcirc-completion-at-point): New function for constructing + completion data for both nicks and irc commands. Add to + completion-at-point-functions in rcirc mode. + (rcirc-complete): Rename from rcirc-nick-complete; use + rcirc-completion-at-point. + (defun-rcirc-command): Update rcirc-client-commands. + +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files + atomically, to avoid parallel build errors. (Bug#4196) + +2010-09-11 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.6 + (sql-dialect): Synonym for "sql-product". + (sql-find-sqli-buffer, sql-set-sqli-buffer-generally) + (sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode): + Set "sql-buffer" to buffer name not buffer object so multiple sql + interactive buffers work properly. Reverts misguided changes in + earlier work. + (sql-comint): Make sure different buffer name is used if "*SQL*" + buffer is for a different product. + (sql-make-alternate-buffer-name): Fix bug with "sql-database" + login param. + (sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql) + (sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase) + (sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer): + Accept new buffer name or prompt for one. + (sql-port): Default to zero. + (sql-comint-mysql): Handle "sql-port" as a numeric. + (sql-port-history): Delete unused variable. + (sql-get-login): Default "sql-port" to a number. + (sql-product-alist): Correct Postgres prompt and terminator + regexp. + (sql-sqlite-program): Dynamically detect presence of "sqlite" or + "sqlite3" executables. + (sql-sqlite-login-params): Add "*.sqlite[23]?" database name + pattern. + (sql-buffer-live-p): New function. + (sql-mode-menu, sql-send-string): Use it. + (sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK + syntax pattern. + (sql-mode-postgres-font-lock-keywords): Support Postgres V9. + (sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands. + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/netrc.el (netrc-credentials): New conveniency function. + +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun + to replace texinfo-font-lock-syntactic-keywords. + (texinfo-mode): Use it. + + * textmodes/tex-mode.el (tex-common-initialization, doctex-mode): + Use syntax-propertize-function. + + * textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to + replace sgml-font-lock-syntactic-keywords. + (sgml-mode): Use it. + + * textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare + since we don't use it. + + * textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function. + + * progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function + if available. + (vhdl-fontify-buffer): Adjust. + + * progmodes/tcl.el (tcl-syntax-propertize-function): New var to + replace tcl-font-lock-syntactic-keywords. + (tcl-mode): Use it. + + * progmodes/simula.el (simula-syntax-propertize-function): New var to + replace simula-font-lock-syntactic-keywords. + (simula-mode): Use it. + + * progmodes/sh-script.el (sh-st-symbol): Remove. + (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg. + (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove. + (sh-font-lock-quoted-subshell): Assume we've already matched $(. + (sh-font-lock-paren): Set syntax-multiline. + (sh-font-lock-syntactic-keywords): Remove. + (sh-syntax-propertize-function): New function to replace it. + (sh-mode): Use it. + + * progmodes/ruby-mode.el (ruby-here-doc-beg-re): + Define while compiling. + (ruby-here-doc-end-re, ruby-here-doc-beg-match) + (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax) + (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p) + (ruby-here-doc-find-end, ruby-here-doc-beg-syntax) + (ruby-here-doc-end-syntax): Only define when + syntax-propertize is not available. + (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc): + New functions. + (ruby-in-ppss-context-p): Update to new syntax of heredocs. + (electric-indent-chars): Silence bytecompiler. + (ruby-mode): Use prog-mode, syntax-propertize-function, and + electric-indent-chars. + + * progmodes/python.el (python-syntax-propertize-function): New var to + replace python-font-lock-syntactic-keywords. + (python-mode): Use it. + (python-quote-syntax): Simplify and adjust to new use. + + * progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to + replace perl-font-lock-syntactic-keywords. + (perl-syntax-propertize-special-constructs): New fun to replace + perl-font-lock-special-syntactic-constructs. + (perl-font-lock-syntactic-face-function): New fun. + (perl-mode): Use it. + + * progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function + to replace octave-font-lock-close-quotes. + (octave-syntax-propertize-function): New function to replace + octave-font-lock-syntactic-keywords. + (octave-mode): Use it. + + * progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var; + replaces mixal-font-lock-syntactic-keywords. + (mixal-mode): Use it. + + * progmodes/make-mode.el (makefile-syntax-propertize-function): + New var; replaces makefile-font-lock-syntactic-keywords. + (makefile-mode): Use it. + (makefile-imake-mode): Adjust. + + * progmodes/js.el (js--regexp-literal): Define while compiling. + (js-syntax-propertize-function): New var; replaces + js-font-lock-syntactic-keywords. + (js-mode): Use it. + + * progmodes/gud.el (gdb-script-syntax-propertize-function): New var; + replaces gdb-script-font-lock-syntactic-keywords. + (gdb-script-mode): Use it. + + * progmodes/fortran.el (fortran-mode): Use syntax-propertize-function. + (fortran--font-lock-syntactic-keywords): New var. + (fortran-line-length): Update syntax-propertize-function and + fortran--font-lock-syntactic-keywords. + + * progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function. + + * progmodes/cfengine.el (cfengine-mode): + Use syntax-propertize-function. + (cfengine-font-lock-syntactic-keywords): Remove. + + * progmodes/autoconf.el (autoconf-mode): + Use syntax-propertize-function. + (autoconf-font-lock-syntactic-keywords): Remove. + + * progmodes/ada-mode.el (ada-set-syntax-table-properties) + (ada-after-change-function, ada-initialize-syntax-table-properties) + (ada-handle-syntax-table-properties): Only define when + syntax-propertize is not available. + (ada-mode): Use syntax-propertize-function. + + * font-lock.el (font-lock-syntactic-keywords): Make obsolete. + (font-lock-fontify-syntactic-keywords-region): Move handling of + font-lock-syntactically-fontified to... + (font-lock-default-fontify-region): ...here. + Let syntax-propertize-function take precedence. + (font-lock-fontify-syntactically-region): Cal syntax-propertize. + + * emacs-lisp/syntax.el (syntax-propertize-function) + (syntax-propertize-chunk-size, syntax-propertize--done) + (syntax-propertize-extend-region-functions): New vars. + (syntax-propertize-wholelines, syntax-propertize-multiline) + (syntax-propertize--shift-groups, syntax-propertize-via-font-lock) + (syntax-propertize): New functions. + (syntax-propertize-rules): New macro. + (syntax-ppss-flush-cache): Set syntax-propertize--done. + (syntax-ppss): Call syntax-propertize. + + * emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups. + +2010-09-10 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process): Improve comments. + XEmacs compatibility changes regarding (add-hook) 'local option + and (set-process-query-on-exit-flag). + +2010-09-09 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cache.el (tramp-parse-connection-properties): + Set tramp-autoload cookie. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * image.el (imagemagick-types-inhibit): Add :type, :version, :group. + (imagemagick-register-types): Doc fix. + +2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp. + + * progmodes/js.el (require): Require is already "eval-and-compile". + (js--re-search-forward): Avoid `eval'. Preserve the error data. + (js--re-search-backward): Use js--re-search-forward. + + * progmodes/fortran.el (fortran-line-length): Don't recompute + syntactic keywords redundantly a second time. + + * progmodes/ada-mode.el: Replace "(set '" with setq. + (ada-mode): Simplify. + (ada-create-case-exception, ada-adjust-case-interactive) + (ada-adjust-case-region, ada-format-paramlist, ada-indent-current) + (ada-search-ignore-string-comment, ada-move-to-start) + (ada-move-to-end): Use with-syntax-table. + + * font-lock.el (save-buffer-state): Remove `varlist' arg. + (font-lock-unfontify-region, font-lock-default-fontify-region): + Update usage correspondingly. + (font-lock-fontify-syntactic-keywords-region): + Set parse-sexp-lookup-properties buffer-locally here. + (font-lock-fontify-syntactically-region): Remove unused `ppss' arg. + + * simple.el (blink-matching-open): Don't burp if we can't find a match. + +2010-09-08 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-report-ops): + Error if not compiled with -DBYTE_CODE_METER. + + * emacs-lisp/bytecomp.el (byte-recompile-directory): + Ignore dir-locals-file. + +2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Not a const. + (compilation-error-regexp-alist-alist): Rule out ": " in file names + for the `gnu' messages. + (compilation-set-skip-threshold): New command. + (compilation-start): Use \' rather than $. + (compilation-forget-errors): Use clrhash. + +2010-09-08 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-valid-dictionary-list): + Simplify logic. + +2010-09-08 Michael Albinus <michael.albinus@gmx.de> + + Migrate to Tramp 2.2. Rearrange load dependencies. + (Bug#1529, Bug#5448, Bug#5705) + + * Makefile.in (TRAMP_DIR, TRAMP_SRC): New variables. + ($(TRAMP_DIR)/tramp-loaddefs.el): New target. + (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el. + + * net/tramp.el (top): Remove all other tramp-* loads except + tramp-compat.el. Remove all changes to tramp-unload-hook for + other tramp-* packages. Rearrange defun order. Change calls of + `tramp-compat-call-process', `tramp-compat-decimal-to-octal', + `tramp-compat-octal-to-decimal' to new function names. + (tramp-terminal-type, tramp-initial-end-of-output) + (tramp-methods, tramp-foreign-file-name-handler-alist) + (tramp-tramp-file-p, tramp-completion-mode-p) + (tramp-send-command-and-check, tramp-get-remote-path) + (tramp-get-remote-tmpdir, tramp-get-remote-ln) + (tramp-shell-quote-argument): Set tramp-autoload cookie. + (with-file-property, with-connection-property): Move to + tramp-cache.el. + (tramp-local-call-process, tramp-decimal-to-octal) + (tramp-octal-to-decimal): Move to tramp-compat.el. + (tramp-handle-shell-command): Do not require 'shell. + (tramp-compute-multi-hops): No special handling for tramp-gw-* + symbols. + (tramp-unload-tramp): Do not call `tramp-unload-file-name-handlers'. + + * net/tramp-cache.el (top): Require 'tramp. Add to + `tramp-unload-hook'. + (tramp-cache-data, tramp-get-file-property) + (tramp-set-file-property, tramp-flush-file-property) + (tramp-flush-directory-property, tramp-get-connection-property) + (tramp-set-connection-property, tramp-flush-connection-property) + (tramp-cache-print, tramp-list-connections): Set tramp-autoload + cookie. + (with-file-property, with-connection-property): New defuns, moved + from tramp.el. + (tramp-flush-file-function): Use `with-parsed-tramp-file-name' + macro. + + * net/tramp-cmds.el (top): Add to `tramp-unload-hook'. + (tramp-version): Set tramp-autoload cookie. + + * net/tramp-compat.el (top): Require 'tramp-loaddefs. Remove all + changes to tramp-unload-hook for other tramp-* packages. Add to + `tramp-unload-hook'. + (tramp-compat-decimal-to-octal, tramp-compat-octal-to-decimal) + (tramp-compat-call-process): New defuns, moved from tramp.el. + + * net/tramp-fish.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change call of + `tramp-compat-decimal-to-octal' to new function name. + (tramp-fish-method): Make it a defconst. + (tramp-fish-file-name-p): Make it a defsubst. + (tramp-fish-method, tramp-fish-file-name-handler) + (tramp-fish-file-name-p): Set tramp-autoload cookie. + + * net/tramp-ftp.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. + (tramp-ftp-method): Make it a defconst. + (tramp-ftp-file-name-p): Make it a defsubst. + (tramp-ftp-method, tramp-ftp-file-name-handler) + (tramp-ftp-file-name-p): Set tramp-autoload cookie. + + * net/tramp-gvfs.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. Change checks, whether package can be + loaded. + (tramp-gvfs-file-name-p): Make it a defsubst. + (tramp-gvfs-methods, tramp-gvfs-file-name-handler) + (tramp-gvfs-file-name-p): Set tramp-autoload cookie. + (tramp-gvfs-handle-file-directory-p): New defun. + (tramp-gvfs-file-name-handler-alist): Use it. + + * net/tramp-gw.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. + (tramp-gw-tunnel-method, tramp-gw-default-tunnel-port) + (tramp-gw-socks-method, tramp-gw-default-socks-port): Make it a + defconst. + (tramp-gw-tunnel-method, tramp-gw-socks-method) + (tramp-gw-open-connection): Set tramp-autoload cookie. + + * net/tramp-imap.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change checks, whether package can be + loaded. + (tramp-imap-file-name-p): Make it a defsubst. + (tramp-imap-method, tramp-imaps-method) + (tramp-imap-file-name-handler) + (tramp-imap-file-name-p): Set tramp-autoload cookie. + + * net/tramp-smb.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change checks, whether package can be + loaded. Change call of `tramp-compat-decimal-to-octal' to new + function name. + (tramp-smb-tunnel-method): Make it a defconst. + (tramp-smb-file-name-p): Make it a defsubst. + (tramp-smb-method, tramp-smb-file-name-handler) + (tramp-smb-file-name-p): Set tramp-autoload cookie. + + * net/tramp-uu.el (top) Add to `tramp-unload-hook'. + (tramp-uuencode-region): Set tramp-autoload cookie. + + * net/trampver.el (top) Add to `tramp-unload-hook'. + (tramp-version, tramp-bug-report-address): Set tramp-autoload + cookie. Update release number. + 2010-09-07 AgustÃn MartÃn <agustin.martin@hispalinux.es> * textmodes/ispell.el (ispell-start-process): Make sure original @@ -22,7 +682,7 @@ 2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> - * net/imap.el (imap-message-map): Removed optional buffer parameter, + * net/imap.el (imap-message-map): Remove optional buffer parameter, since no callers use it. (imap-message-get): Ditto. (imap-message-put): Ditto. @@ -33,11 +693,11 @@ 2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> - * net/imap.el (imap-fetch-safe): Removed function, and altered all + * net/imap.el (imap-fetch-safe): Remove function, and alter all callers to use `imap-fetch' instead. According to the comments, this should be safe, since all other IMAP clients use the 1:* syntax. - (imap-enable-exchange-bug-workaround): Removed. - (imap-debug): Removed -- doesn't seem very useful. + (imap-enable-exchange-bug-workaround): Remove. + (imap-debug): Remove -- doesn't seem very useful. 2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
--- a/lisp/Makefile.in Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/Makefile.in Thu Sep 16 11:11:13 2010 +0900 @@ -56,7 +56,8 @@ LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ $(lisp)/calendar/diary-loaddefs.el \ $(lisp)/calendar/hol-loaddefs.el \ - $(lisp)/mh-e/mh-loaddefs.el + $(lisp)/mh-e/mh-loaddefs.el \ + $(lisp)/net/tramp-loaddefs.el # Elisp files auto-generated. AUTOGENEL = loaddefs.el \ @@ -329,6 +330,24 @@ --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(MH_E_DIR) +# Update TRAMP internal autoloads. Maybe we could move trmp*.el into +# an own subdirectory. OTOH, it does not hurt to keep them in +# lisp/net. +TRAMP_DIR = $(lisp)/net +TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \ + $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \ + $(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \ + $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \ + $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \ + $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el + +$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) + $(emacs) -l autoload \ + --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ + --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq make-backup-files nil)" \ + -f batch-update-autoloads $(TRAMP_DIR) + CAL_DIR = $(lisp)/calendar ## Those files that may contain internal calendar autoload cookies. ## Avoids circular dependency warning for *-loaddefs.el.
--- a/lisp/ansi-color.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/ansi-color.el Thu Sep 16 11:11:13 2010 +0900 @@ -244,9 +244,9 @@ (when (boundp 'font-lock-syntactic-keywords) (remove-text-properties beg end '(syntax-table nil))) ;; instead of just using (remove-text-properties beg end '(face - ;; nil)), we find regions with a non-nil face test-property, skip + ;; nil)), we find regions with a non-nil face text-property, skip ;; positions with the ansi-color property set, and remove the - ;; remaining face test-properties. + ;; remaining face text-properties. (while (setq beg (text-property-not-all beg end 'face nil)) (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) (when (get-text-property beg 'face)
--- a/lisp/calendar/appt.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/calendar/appt.el Thu Sep 16 11:11:13 2010 +0900 @@ -48,8 +48,9 @@ ;; package is activated. Additionally, the appointments list is ;; recreated automatically at 12:01am for those who do not logout ;; every day or are programming late. It is also updated when the -;; `diary-file' is saved. Calling `appt-check' with an argument (or -;; re-enabling the package) forces a re-initialization at any time. +;; `diary-file' (or a file it includes) is saved. Calling +;; `appt-check' with an argument (or re-enabling the package) forces a +;; re-initialization at any time. ;; ;; In order to add or delete items from today's list, without ;; changing the diary file, use `appt-add' and `appt-delete'. @@ -262,7 +263,7 @@ "Check for an appointment and update any reminder display. If optional argument FORCE is non-nil, reparse the diary file for appointments. Otherwise the diary file is only parsed once per day, -and when saved. +or when it (or a file it includes) is saved. Note: the time must be the first thing in the line in the diary for a warning to be issued. The format of the time can be either @@ -346,6 +347,8 @@ (if d-buff ; diary buffer exists (with-current-buffer d-buff diary-selective-display)))) + ;; FIXME why not using diary-list-entries with + ;; non-nil LIST-ONLY? (diary) ;; If the diary buffer existed before this command, ;; restore its display state. Otherwise, kill it. @@ -643,8 +646,10 @@ (defun appt-update-list () "If the current buffer is visiting the diary, update appointments. -This function is intended for use with `write-file-functions'." - (and (string-equal buffer-file-name (expand-file-name diary-file)) +This function also acts on any file listed in `diary-included-files'. +It is intended for use with `write-file-functions'." + (and (member buffer-file-name (append diary-included-files + (list (expand-file-name diary-file)))) appt-timer (let ((appt-display-diary nil)) (appt-check t)))
--- a/lisp/calendar/diary-lib.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/calendar/diary-lib.el Thu Sep 16 11:11:13 2010 +0900 @@ -187,11 +187,12 @@ (setq diary-display-function 'diary-fancy-display) (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files) - (add-hook 'diary-list-entries-hook 'diary-sort-entries) + (add-hook 'diary-list-entries-hook 'diary-sort-entries t) in your `.emacs' file to cause the fancy diary buffer to be displayed with diary entries from various included files, each day's entries sorted into -lexicographic order." +lexicographic order. Note how the sort function is placed last, +so that it can sort the entries included from other files." :type 'hook :options '(diary-include-other-diary-files diary-sort-entries) :group 'diary) @@ -699,6 +700,10 @@ (1+ (calendar-absolute-from-gregorian gdate)))))) (goto-char (point-min))) +(defvar diary-including) ; dynamically bound in diary-include-other-diary-files +(defvar diary-included-files nil + "List of any diary files included in the last call to `diary-list-entries'.") + ;; FIXME non-greg and list hooks run same number of times? (defun diary-list-entries (date number &optional list-only) "Create and display a buffer containing the relevant lines in `diary-file'. @@ -743,6 +748,8 @@ (date-string (calendar-date-string date)) (diary-buffer (find-buffer-visiting diary-file)) diary-entries-list file-glob-attrs) + (or (bound-and-true-p diary-including) + (setq diary-included-files nil)) (message "Preparing diary...") (save-current-buffer (if (not diary-buffer) @@ -828,11 +835,15 @@ (let ((diary-file (match-string-no-properties 1)) (diary-list-entries-hook 'diary-include-other-diary-files) (diary-display-function 'ignore) + (diary-including t) diary-hook diary-list-include-blanks) (if (file-exists-p diary-file) (if (file-readable-p diary-file) (unwind-protect - (setq diary-entries-list + (setq diary-included-files + (append diary-included-files + (list (expand-file-name diary-file))) + diary-entries-list (append diary-entries-list (diary-list-entries original-date number))) (with-current-buffer (find-buffer-visiting diary-file) @@ -1574,7 +1585,10 @@ (string-lessp ts1 ts2))))))) (defun diary-sort-entries () - "Sort the list of diary entries by time of day." + "Sort the list of diary entries by time of day. +If you add this function to `diary-list-entries-hook', it should +be the last item in the hook, in case earlier items add diary +entries, or change the order." (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare))) (define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1")
--- a/lisp/calendar/time-date.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/calendar/time-date.el Thu Sep 16 11:11:13 2010 +0900 @@ -317,10 +317,10 @@ (setq start (match-end 0) spec (match-string 1 string)) (unless (string-equal spec "%") - ;; `assoc-string' is not available in Emacs 21. So when compiling - ;; Gnus (`time-date.el' is part of Gnus) with Emacs 21, we get a - ;; warning here. But `format-seconds' is not used anywhere in Gnus so - ;; it's not a real problem. --rsteib + ;; `assoc-string' is not available in XEmacs or Emacs 21. So when + ;; compiling Gnus (`time-date.el' is part of Gnus) with XEmacs or + ;; Emacs 21, we get a warning here. But `format-seconds' is not + ;; used anywhere in Gnus so it's not a real problem. --rsteib (or (setq match (assoc-string spec units t)) (error "Bad format specifier: `%s'" spec)) (if (assoc-string spec usedunits t)
--- a/lisp/emacs-lisp/byte-run.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/emacs-lisp/byte-run.el Thu Sep 16 11:11:13 2010 +0900 @@ -108,10 +108,11 @@ (defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key)) -(defun set-advertised-calling-convention (function signature) +(defun set-advertised-calling-convention (function signature when) "Set the advertised SIGNATURE of FUNCTION. This will allow the byte-compiler to warn the programmer when she uses -an obsolete calling convention." +an obsolete calling convention. WHEN specifies since when the calling +convention was modified." (puthash (indirect-function function) signature advertised-signature-table)) @@ -132,7 +133,7 @@ obsolete-name) (set-advertised-calling-convention ;; New code should always provide the `when' argument. - 'make-obsolete '(obsolete-name current-name when)) + 'make-obsolete '(obsolete-name current-name when) "23.1") (defmacro define-obsolete-function-alias (obsolete-name current-name &optional when docstring) @@ -153,7 +154,7 @@ (set-advertised-calling-convention ;; New code should always provide the `when' argument. 'define-obsolete-function-alias - '(obsolete-name current-name when &optional docstring)) + '(obsolete-name current-name when &optional docstring) "23.1") (defun make-obsolete-variable (obsolete-name current-name &optional when) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. @@ -175,7 +176,7 @@ obsolete-name) (set-advertised-calling-convention ;; New code should always provide the `when' argument. - 'make-obsolete-variable '(obsolete-name current-name when)) + 'make-obsolete-variable '(obsolete-name current-name when) "23.1") (defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) @@ -210,7 +211,7 @@ (set-advertised-calling-convention ;; New code should always provide the `when' argument. 'define-obsolete-variable-alias - '(obsolete-name current-name when &optional docstring)) + '(obsolete-name current-name when &optional docstring) "23.1") ;; FIXME This is only defined in this file because the variable- and ;; function- versions are too. Unlike those two, this one is not used
--- a/lisp/emacs-lisp/bytecomp.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/emacs-lisp/bytecomp.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,8 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -264,7 +265,7 @@ (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved obsolete noruntime cl-functions interactive-only - make-local mapcar constants suspicious) + make-local mapcar constants suspicious lexical) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for all). @@ -1548,6 +1549,9 @@ (if (and (string-match emacs-lisp-file-regexp bytecomp-source) (file-readable-p bytecomp-source) (not (auto-save-file-name-p bytecomp-source)) + (not (string-equal dir-locals-file + (file-name-nondirectory + bytecomp-source))) (setq bytecomp-dest (byte-compile-dest-file bytecomp-source)) (if (file-exists-p bytecomp-dest) @@ -1694,17 +1698,25 @@ (insert "\n") ; aaah, unix. (if (file-writable-p target-file) ;; We must disable any code conversion here. - (let ((coding-system-for-write 'no-conversion)) + (let ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile (make-temp-name target-file))) (if (memq system-type '(ms-dos 'windows-nt)) (setq buffer-file-type t)) - (when (file-exists-p target-file) - ;; Remove the target before writing it, so that any - ;; hard-links continue to point to the old file (this makes - ;; it possible for installed files to share disk space with - ;; the build tree, without causing problems when emacs-lisp - ;; files in the build tree are recompiled). - (delete-file target-file)) - (write-region (point-min) (point-max) target-file)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t) + (message "Wrote %s" target-file)) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file" @@ -2141,6 +2153,11 @@ ;; Since there is no doc string, we can compile this as a normal form, ;; and not do a file-boundary. (byte-compile-keep-pending form) + (when (and (symbolp (nth 1 form)) + (not (string-match "[-*:$]" (symbol-name (nth 1 form)))) + (byte-compile-warning-enabled-p 'lexical)) + (byte-compile-warn "Global/dynamic var `%s' lacks a prefix" + (nth 1 form))) (push (nth 1 form) byte-compile-bound-variables) (if (eq (car form) 'defconst) (push (nth 1 form) byte-compile-const-variables)) @@ -3792,6 +3809,11 @@ (defun byte-compile-defvar (form) ;; This is not used for file-level defvar/consts with doc strings. + (when (and (symbolp (nth 1 form)) + (not (string-match "[-*:$]" (symbol-name (nth 1 form)))) + (byte-compile-warning-enabled-p 'lexical)) + (byte-compile-warn "Global/dynamic var `%s' lacks a prefix" + (nth 1 form))) (let ((fun (nth 0 form)) (var (nth 1 form)) (value (nth 2 form)) @@ -4240,6 +4262,8 @@ (defvar byte-code-meter) (defun byte-compile-report-ops () + (or (boundp 'byte-metering-on) + (error "You must build Emacs with -DBYTE_CODE_METER to use this")) (with-output-to-temp-buffer "*Meter*" (set-buffer "*Meter*") (let ((i 0) n op off)
--- a/lisp/emacs-lisp/regexp-opt.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/emacs-lisp/regexp-opt.el Thu Sep 16 11:11:13 2010 +0900 @@ -120,7 +120,7 @@ (string-match regexp "") ;; Count the number of open parentheses in REGEXP. (let ((count 0) start last) - (while (string-match "\\\\(\\(\\?:\\)?" regexp start) + (while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start) (setq start (match-end 0)) ; Start of next search. (when (and (not (match-beginning 1)) (subregexp-context-p regexp (match-beginning 0) last))
--- a/lisp/emacs-lisp/syntax.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/emacs-lisp/syntax.el Thu Sep 16 11:11:13 2010 +0900 @@ -34,7 +34,6 @@ ;; - do something about the case where the syntax-table is changed. ;; This typically happens with tex-mode and its `$' operator. -;; - move font-lock-syntactic-keywords in here. Then again, maybe not. ;; - new functions `syntax-state', ... to replace uses of parse-partial-state ;; with something higher-level (similar to syntax-ppss-context). ;; - interaction with mmm-mode. @@ -47,6 +46,249 @@ (defvar font-lock-beginning-of-syntax-function) +;;; Applying syntax-table properties where needed. + +(defvar syntax-propertize-function nil + ;; Rather than a -functions hook, this is a -function because it's easier + ;; to do a single scan than several scans: with multiple scans, one cannot + ;; assume that the text before point has been propertized, so syntax-ppss + ;; gives unreliable results (and stores them in its cache to boot, so we'd + ;; have to flush that cache between each function, and we couldn't use + ;; syntax-ppss-flush-cache since that would not only flush the cache but also + ;; reset syntax-propertize--done which should not be done in this case). + "Mode-specific function to apply the syntax-table properties. +Called with 2 arguments: START and END.") + +(defvar syntax-propertize-chunk-size 500) + +(defvar syntax-propertize-extend-region-functions + '(syntax-propertize-wholelines) + "Special hook run just before proceeding to propertize a region. +This is used to allow major modes to help `syntax-propertize' find safe buffer +positions as beginning and end of the propertized region. Its most common use +is to solve the problem of /identification/ of multiline elements by providing +a function that tries to find such elements and move the boundaries such that +they do not fall in the middle of one. +Each function is called with two arguments (START and END) and it should return +either a cons (NEW-START . NEW-END) or nil if no adjustment should be made. +These functions are run in turn repeatedly until they all return nil. +Put first the functions more likely to cause a change and cheaper to compute.") +;; Mark it as a special hook which doesn't use any global setting +;; (i.e. doesn't obey the element t in the buffer-local value). +(make-variable-buffer-local 'syntax-propertize-extend-region-functions) + +(defun syntax-propertize-wholelines (start end) + (goto-char start) + (cons (line-beginning-position) + (progn (goto-char end) + (if (bolp) (point) (line-beginning-position 2))))) + +(defun syntax-propertize-multiline (beg end) + "Let `syntax-propertize' pay attention to the syntax-multiline property." + (when (and (> beg (point-min)) + (get-text-property (1- beg) 'syntax-multiline)) + (setq beg (or (previous-single-property-change beg 'syntax-multiline) + (point-min)))) + ;; + (when (get-text-property end 'font-lock-multiline) + (setq end (or (text-property-any end (point-max) + 'syntax-multiline nil) + (point-max)))) + (cons beg end)) + +(defvar syntax-propertize--done -1 + "Position upto which syntax-table properties have been set.") +(make-variable-buffer-local 'syntax-propertize--done) + +(defun syntax-propertize--shift-groups (re n) + (replace-regexp-in-string + "\\\\(\\?\\([0-9]+\\):" + (lambda (s) + (replace-match + (number-to-string (+ n (string-to-number (match-string 1 s)))) + t t s 1)) + re t t)) + +(defmacro syntax-propertize-rules (&rest rules) + "Make a function that applies RULES for use in `syntax-propertize-function'. +The function will scan the buffer, applying the rules where they match. +The buffer is scanned a single time, like \"lex\" would, rather than once +per rule. + +Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP +is an expression (evaluated at time of macro-expansion) that returns a regexp, +and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to +apply the property SYNTAX to the chars matched by the subgroup NUMBER +of the regular expression, if NUMBER did match. +SYNTAX is an expression that returns a value to apply as `syntax-table' +property. Some expressions are handled specially: +- if SYNTAX is a string, then it is converted with `string-to-syntax'; +- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP + will be applied to the buffer before running EXPS and if EXP is a string it + is also converted with `string-to-syntax'. +The SYNTAX expression is responsible to save the `match-data' if needed +for subsequent HIGHLIGHTs. +Also SYNTAX is free to move point, in which case RULES may not be applied to +some parts of the text or may be applied several times to other parts. + +Note: back-references in REGEXPs do not work." + (declare (debug (&rest (form &rest + (numberp + [&or stringp + ("prog1" [&or stringp def-form] def-body) + def-form]))))) + (let* ((offset 0) + (branches '()) + ;; We'd like to use a real DFA-based lexer, usually, but since Emacs + ;; doesn't have one yet, we fallback on building one large regexp + ;; and use groups to determine which branch of the regexp matched. + (re + (mapconcat + (lambda (rule) + (let ((re (eval (car rule)))) + (when (and (assq 0 rule) (cdr rules)) + ;; If there's more than 1 rule, and the rule want to apply + ;; highlight to match 0, create an extra group to be able to + ;; tell when *this* match 0 has succeeded. + (incf offset) + (setq re (concat "\\(" re "\\)"))) + (setq re (syntax-propertize--shift-groups re offset)) + (let ((code '()) + (condition + (cond + ((assq 0 rule) (if (zerop offset) t + `(match-beginning ,offset))) + ((null (cddr rule)) + `(match-beginning ,(+ offset (car (cadr rule))))) + (t + `(or ,@(mapcar + (lambda (case) + `(match-beginning ,(+ offset (car case)))) + (cdr rule)))))) + (nocode t) + (offset offset)) + ;; If some of the subgroup rules include Elisp code, then we + ;; need to set the match-data so it's consistent with what the + ;; code expects. If not, then we can simply use shifted + ;; offset in our own code. + (unless (zerop offset) + (dolist (case (cdr rule)) + (unless (stringp (cadr case)) + (setq nocode nil))) + (unless nocode + (push `(let ((md (match-data 'ints))) + ;; Keep match 0 as is, but shift everything else. + (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md)) + (set-match-data md)) + code) + (setq offset 0))) + ;; Now construct the code for each subgroup rules. + (dolist (case (cdr rule)) + (assert (null (cddr case))) + (let* ((gn (+ offset (car case))) + (action (nth 1 case)) + (thiscode + (cond + ((stringp action) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax action)))) + ((eq (car-safe action) 'ignore) + (cdr action)) + ((eq (car-safe action) 'prog1) + (if (stringp (nth 1 action)) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax (nth 1 action))) + ,@(nthcdr 2 action)) + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,(nth 1 action))) + (if syntax + (put-text-property + mb me 'syntax-table syntax)) + ,@(nthcdr 2 action))))) + (t + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,action)) + (if syntax + (put-text-property + mb me 'syntax-table syntax)))))))) + + (if (or (not (cddr rule)) (zerop gn)) + (setq code (nconc (nreverse thiscode) code)) + (push `(if (match-beginning ,gn) + ;; Try and generate clean code with no + ;; extraneous progn. + ,(if (null (cdr thiscode)) + (car thiscode) + `(progn ,@thiscode))) + code)))) + (push (cons condition (nreverse code)) + branches)) + (incf offset (regexp-opt-depth re)) + re)) + rules + "\\|"))) + `(lambda (start end) + (goto-char start) + (while (and (< (point) end) + (re-search-forward ,re end t)) + (cond ,@(nreverse branches)))))) + +(defun syntax-propertize-via-font-lock (keywords) + "Propertize for syntax in START..END using font-lock syntax. +KEYWORDS obeys the format used in `font-lock-syntactic-keywords'. +The return value is a function suitable for `syntax-propertize-function'." + (lexical-let ((keywords keywords)) + (lambda (start end) + (with-no-warnings + (let ((font-lock-syntactic-keywords keywords)) + (font-lock-fontify-syntactic-keywords-region start end) + ;; In case it was eval'd/compiled. + (setq keywords font-lock-syntactic-keywords)))))) + +(defun syntax-propertize (pos) + "Ensure that syntax-table properties are set upto POS." + (when (and syntax-propertize-function + (< syntax-propertize--done pos)) + ;; (message "Needs to syntax-propertize from %s to %s" + ;; syntax-propertize--done pos) + (set (make-local-variable 'parse-sexp-lookup-properties) t) + (save-excursion + (with-silent-modifications + (let* ((start (max syntax-propertize--done (point-min))) + (end (max pos + (min (point-max) + (+ start syntax-propertize-chunk-size)))) + (funs syntax-propertize-extend-region-functions)) + (while funs + (let ((new (funcall (pop funs) start end))) + (if (or (null new) + (and (>= (car new) start) (<= (cdr new) end))) + nil + (setq start (car new)) + (setq end (cdr new)) + ;; If there's been a change, we should go through the + ;; list again since this new position may + ;; warrant a different answer from one of the funs we've + ;; already seen. + (unless (eq funs + (cdr syntax-propertize-extend-region-functions)) + (setq funs syntax-propertize-extend-region-functions))))) + ;; Move the limit before calling the function, so the function + ;; can use syntax-ppss. + (setq syntax-propertize--done end) + ;; (message "syntax-propertizing from %s to %s" start end) + (remove-text-properties start end + '(syntax-table nil syntax-multiline nil)) + (funcall syntax-propertize-function start end)))))) + +;;; Incrementally compute and memoize parser state. + (defsubst syntax-ppss-depth (ppss) (nth 0 ppss)) @@ -92,6 +334,8 @@ (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) (defun syntax-ppss-flush-cache (beg &rest ignored) "Flush the cache of `syntax-ppss' starting at position BEG." + ;; Set syntax-propertize to refontify anything past beg. + (setq syntax-propertize--done (min beg syntax-propertize--done)) ;; Flush invalid cache entries. (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) (setq syntax-ppss-cache (cdr syntax-ppss-cache))) @@ -128,6 +372,7 @@ Point is at POS when this function returns." ;; Default values. (unless pos (setq pos (point))) + (syntax-propertize pos) ;; (let ((old-ppss (cdr syntax-ppss-last)) (old-pos (car syntax-ppss-last))
--- a/lisp/epa-file.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/epa-file.el Thu Sep 16 11:11:13 2010 +0900 @@ -158,12 +158,17 @@ (if (or beg end) (setq string (substring string (or beg 0) end))) (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (epa-file-decode-and-insert string file visit beg end replace) - (setq length (- (point-max) (point-min)))) - (if replace - (delete-region (point) (point-max))) + ;; If visiting, bind off buffer-file-name so that + ;; file-locking will not ask whether we should + ;; really edit the buffer. + (let ((buffer-file-name + (if visit nil buffer-file-name))) + (save-restriction + (narrow-to-region (point) (point)) + (epa-file-decode-and-insert string file visit beg end replace) + (setq length (- (point-max) (point-min)))) + (if replace + (delete-region (point) (point-max)))) (if visit (set-visited-file-modtime)))) (if (and local-copy
--- a/lisp/font-lock.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/font-lock.el Thu Sep 16 11:11:13 2010 +0900 @@ -544,6 +544,8 @@ contexts will not be affected. This is normally set via `font-lock-defaults'.") +(make-obsolete-variable 'font-lock-syntactic-keywords + 'syntax-propertize-function "24.1") (defvar font-lock-syntax-table nil "Non-nil means use this syntax table for fontifying. @@ -562,6 +564,8 @@ we recommend setting `syntax-begin-function' instead. This is normally set via `font-lock-defaults'.") +(make-obsolete-variable 'font-lock-beginning-of-syntax-function + 'syntax-begin-function "23.3") (defvar font-lock-mark-block-function nil "*Non-nil means use this function to mark a block of text. @@ -612,11 +616,10 @@ ;; ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) + (defmacro save-buffer-state (&rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." - (declare (indent 1) (debug let)) - `(let* ,(append varlist - `((inhibit-point-motion-hooks t))) + (declare (indent 0) (debug t)) + `(let ((inhibit-point-motion-hooks t)) (with-silent-modifications ,@body))) ;; @@ -1020,7 +1023,7 @@ (funcall font-lock-fontify-region-function beg end loudly)) (defun font-lock-unfontify-region (beg end) - (save-buffer-state nil + (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) (defun font-lock-default-fontify-buffer () @@ -1113,8 +1116,6 @@ (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state - ((parse-sexp-lookup-properties - (or parse-sexp-lookup-properties font-lock-syntactic-keywords))) ;; Use the fontification syntax table, if any. (with-syntax-table (or font-lock-syntax-table (syntax-table)) (save-restriction @@ -1136,8 +1137,14 @@ (setq beg font-lock-beg end font-lock-end)) ;; Now do the fontification. (font-lock-unfontify-region beg end) - (when font-lock-syntactic-keywords - (font-lock-fontify-syntactic-keywords-region beg end)) + (when (and font-lock-syntactic-keywords + (null syntax-propertize-function)) + ;; Ensure the beginning of the file is properly syntactic-fontified. + (let ((start beg)) + (when (< font-lock-syntactically-fontified start) + (setq start (max font-lock-syntactically-fontified (point-min))) + (setq font-lock-syntactically-fontified end)) + (font-lock-fontify-syntactic-keywords-region start end))) (unless font-lock-keywords-only (font-lock-fontify-syntactically-region beg end loudly)) (font-lock-fontify-keywords-region beg end loudly))))) @@ -1436,11 +1443,10 @@ (defun font-lock-fontify-syntactic-keywords-region (start end) "Fontify according to `font-lock-syntactic-keywords' between START and END. START should be at the beginning of a line." - ;; Ensure the beginning of the file is properly syntactic-fontified. - (when (and font-lock-syntactically-fontified - (< font-lock-syntactically-fontified start)) - (setq start (max font-lock-syntactically-fontified (point-min))) - (setq font-lock-syntactically-fontified end)) + (unless parse-sexp-lookup-properties + ;; We wouldn't go through so much trouble if we didn't intend to use those + ;; properties, would we? + (set (make-local-variable 'parse-sexp-lookup-properties) t)) ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords. (when (symbolp font-lock-syntactic-keywords) (setq font-lock-syntactic-keywords (font-lock-eval-keywords @@ -1483,19 +1489,18 @@ (defvar font-lock-comment-end-skip nil "If non-nil, Font Lock mode uses this instead of `comment-end'.") -(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss) +(defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." + (syntax-propertize end) ; Apply any needed syntax-table properties. (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote (replace-regexp-in-string "^ *" "" comment-end)))) - state face beg) + ;; Find the `start' state. + (state (syntax-ppss start)) + face beg) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) - (goto-char start) - ;; - ;; Find the `start' state. - (setq state (or ppss (syntax-ppss start))) ;; ;; Find each interesting place between here and `end'. (while
--- a/lisp/gnus/.dir-locals.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/.dir-locals.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,1 +1,4 @@ ((emacs-lisp-mode . ((show-trailing-whitespace . t)))) +;; Local Variables: +;; no-byte-compile: t +;; End:
--- a/lisp/gnus/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,91 @@ +2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-schedule-image-fetching) + (gnus-html-prefetch-images): Check for curl before using it. + + * mm-decode.el (mm-text-html-renderer): Don't have gnus-article-html + depend on curl, which isn't essential. + + * imap.el: Revert back to version + cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes + seem problematic. + +2010-09-14 Juanma Barranquero <lekktu@gmail.com> + + * gnus-registry.el (gnus-registry-install-shortcuts): + Explicitly pass `obarray' to `unintern' to avoid a warning. + +2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-read-active-for-groups): Reverted the previous + change. + + * nnrss.el (nnrss-request-list): Removed this function and related + functions, including the moreover stuff. + +2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnrss.el (nnrss-retrieve-groups): New function. + +2010-09-14 Juanma Barranquero <lekktu@gmail.com> + + * .dir-locals.el: Add no-byte-compile cookie. + +2010-09-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-read-active-for-groups): Run gnus-activate-group + for back end that doesn't support request-scan. + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set, + then do request scans from the backends. + + * gnus-sum.el (gnus-summary-update-hook): Change default to nil, to + avoid running a hook per line, since this takes a lot of time, + profiling shows. + (gnus-summary-prepare-threads): Call `gnus-summary-highlight-line' + directly if gnus-visual-p is true. + +2010-09-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-read-active-for-groups): Check only subscribed + groups; replace mapcar with dolist which is a bit faster; pass groups + info to gnus-read-active-file-1. + (gnus-read-active-file-1): Scan only specified groups if the new + optional arg `infos' is given. + +2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail-source.el (mail-source-fetch-pop): Use pop3-movemail again. + + * pop3.el (pop3-movemail): Removed. + (pop3-streaming-movemail): Renamed to pop3-movemail. + + * gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and + don't restrict end-tag searches to the end of the line. + +2010-09-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-get-unread-articles): Set the number of unread + articles of every unchecked group to t, which means unknown since the + server has never been opened. + +2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-show-alt-text): New command. + (gnus-html-browse-image): Ditto. + (gnus-html-wash-tags): Add the data to allow showing the ALT text and + to browse the image directly. + (gnus-html-wash-tags): Search for images first, so that <a><img> works + better. + + * gnus-async.el (gnus-async-article-callback): Call + `gnus-html-prefetch-images' unconditionally. + + * gnus-html.el (gnus-html-schedule-image-fetching): Decode entities + before feeding URLs to curl. + 2010-09-07 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and
--- a/lisp/gnus/gnus-async.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/gnus-async.el Thu Sep 16 11:11:13 2010 +0900 @@ -237,13 +237,13 @@ (setq gnus-async-current-prefetch-article nil) (when arg (gnus-async-set-buffer) - (when gnus-async-post-fetch-function - (save-excursion - (save-restriction - (narrow-to-region mark (point-max)) - ;; Prefetch images for the groups that want that. - (when (fboundp 'gnus-html-prefetch-images) - (gnus-html-prefetch-images summary)) + (save-excursion + (save-restriction + (narrow-to-region mark (point-max)) + ;; Prefetch images for the groups that want that. + (when (fboundp 'gnus-html-prefetch-images) + (gnus-html-prefetch-images summary)) + (when gnus-async-post-fetch-function (funcall gnus-async-post-fetch-function summary)))) (gnus-async-with-semaphore (setq
--- a/lisp/gnus/gnus-html.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/gnus-html.el Thu Sep 16 11:11:13 2010 +0900 @@ -72,6 +72,15 @@ (define-key map "i" 'gnus-html-insert-image) map)) +(defvar gnus-html-displayed-image-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'gnus-html-show-alt-text) + (define-key map "i" 'gnus-html-browse-image) + (define-key map "\r" 'gnus-html-browse-url) + (define-key map "u" 'gnus-article-copy-string) + (define-key map [tab] 'widget-forward) + map)) + ;;;###autoload (defun gnus-article-html (&optional handle) (let ((article-buffer (current-buffer))) @@ -111,15 +120,104 @@ (defvar gnus-article-mouse-face) -(defun gnus-html-wash-tags () +(defun gnus-html-pre-wash () + (goto-char (point-min)) + (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward "<a name[^\n>]+>" nil t) + (replace-match "" t t))) + +(defun gnus-html-wash-images () (let (tag parameters string start end images url) (goto-char (point-min)) - (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t) - (replace-match "" t t)) + ;; Search for all the images first. + (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t) + (setq parameters (match-string 1) + start (match-beginning 0)) + (delete-region start (point)) + (when (search-forward "</img_alt>" (line-end-position) t) + (delete-region (match-beginning 0) (match-end 0))) + (setq end (point)) + (when (string-match "src=\"\\([^\"]+\\)" parameters) + (setq url (match-string 1 parameters)) + (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) + (if (string-match "^cid:\\(.*\\)" url) + ;; URLs with cid: have their content stashed in other + ;; parts of the MIME structure, so just insert them + ;; immediately. + (let ((handle (mm-get-content-id + (setq url (match-string 1 url)))) + image) + (when handle + (mm-with-part handle + (setq image (gnus-create-image (buffer-string) + nil t)))) + (when image + (let ((string (buffer-substring start end))) + (delete-region start end) + (gnus-put-image image (gnus-string-or string "*") 'cid) + (gnus-add-image 'cid image)))) + ;; Normal, external URL. + (if (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (progn + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + (let ((overlay (gnus-make-overlay start end)) + (spec (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end)))) + (gnus-overlay-put overlay 'local-map gnus-html-image-map) + (gnus-overlay-put overlay 'gnus-image spec) + (gnus-put-text-property + start end + 'gnus-image spec))) + (let ((file (gnus-html-image-id url)) + width height alt-text) + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (setq height (string-to-number (match-string 1 parameters)))) + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (setq width (string-to-number (match-string 1 parameters)))) + (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (setq alt-text (match-string 2 parameters))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (let ((string (buffer-substring start end))) + ;; Delete the IMG text. + (delete-region start end) + (gnus-html-put-image file (point) string url alt-text)) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (push (list url + (set-marker (make-marker) start) + (point-marker)) + images)))))))) + (when images + (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) + +(defun gnus-html-wash-tags () + (let (tag parameters string start end images url) + (gnus-html-pre-wash) + (gnus-html-wash-images) + (goto-char (point-min)) - (while (re-search-forward "<a name[^\n>]+>" nil t) - (replace-match "" t t)) - (goto-char (point-min)) + ;; Then do the other tags. (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) (setq tag (match-string 1) parameters (match-string 2) @@ -127,78 +225,12 @@ (when (plusp (length parameters)) (set-text-properties 0 (1- (length parameters)) nil parameters)) (delete-region start (point)) - (when (search-forward (concat "</" tag ">") (line-end-position) t) + (when (search-forward (concat "</" tag ">") nil t) (delete-region (match-beginning 0) (match-end 0))) (setq end (point)) (cond ;; Fetch and insert a picture. - ((equal tag "img_alt") - (when (string-match "src=\"\\([^\"]+\\)" parameters) - (setq url (match-string 1 parameters)) - (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) - (if (string-match "^cid:\\(.*\\)" url) - ;; URLs with cid: have their content stashed in other - ;; parts of the MIME structure, so just insert them - ;; immediately. - (let ((handle (mm-get-content-id - (setq url (match-string 1 url)))) - image) - (when handle - (mm-with-part handle - (setq image (gnus-create-image (buffer-string) - nil t)))) - (when image - (let ((string (buffer-substring start end))) - (delete-region start end) - (gnus-put-image image (gnus-string-or string "*") 'cid) - (gnus-add-image 'cid image)))) - ;; Normal, external URL. - (if (gnus-html-image-url-blocked-p - url - (if (buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - gnus-blocked-images)) - (progn - (widget-convert-button - 'link start end - :action 'gnus-html-insert-image - :help-echo url - :keymap gnus-html-image-map - :button-keymap gnus-html-image-map) - (let ((overlay (gnus-make-overlay start end)) - (spec (list url - (set-marker (make-marker) start) - (set-marker (make-marker) end)))) - (gnus-overlay-put overlay 'local-map gnus-html-image-map) - (gnus-overlay-put overlay 'gnus-image spec) - (gnus-put-text-property - start end - 'gnus-image spec))) - (let ((file (gnus-html-image-id url)) - width height) - (when (string-match "height=\"?\\([0-9]+\\)" parameters) - (setq height (string-to-number (match-string 1 parameters)))) - (when (string-match "width=\"?\\([0-9]+\\)" parameters) - (setq width (string-to-number (match-string 1 parameters)))) - ;; Don't fetch images that are really small. They're - ;; probably tracking pictures. - (when (and (or (null height) - (> height 4)) - (or (null width) - (> width 4))) - (if (file-exists-p file) - ;; It's already cached, so just insert it. - (let ((string (buffer-substring start end))) - ;; Delete the ALT text. - (delete-region start end) - (gnus-html-put-image file (point) string)) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (push (list url - (set-marker (make-marker) start) - (point-marker)) - images)))))))) + ((equal tag "img_alt")) ;; Add a link. ((or (equal tag "a") (equal tag "A")) @@ -227,8 +259,6 @@ ;; off any </pre_int>s that were left over. (while (re-search-forward "</pre_int>\\|</internal>" nil t) (replace-match "" t t)) - (when images - (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))) (mm-url-decode-entities))) (defun gnus-html-insert-image () @@ -237,21 +267,40 @@ (gnus-html-schedule-image-fetching (current-buffer) (list (get-text-property (point) 'gnus-image)))) +(defun gnus-html-show-alt-text () + "Show the ALT text of the image under point." + (interactive) + (message "%s" (get-text-property (point) 'gnus-alt-text))) + +(defun gnus-html-browse-image () + "Browse the image under point." + (interactive) + (browse-url (get-text-property (point) 'gnus-image))) + +(defun gnus-html-browse-url () + "Browse the image under point." + (interactive) + (let ((url (get-text-property (point) 'gnus-string))) + (if (not url) + (message "No URL at point") + (browse-url url)))) + (defun gnus-html-schedule-image-fetching (buffer images) (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" buffer images) - (let* ((url (caar images)) - (process (start-process - "images" nil "curl" - "-s" "--create-dirs" - "--location" - "--max-time" "60" - "-o" (gnus-html-image-id url) - url))) - (process-kill-without-query process) - (set-process-sentinel process 'gnus-html-curl-sentinel) - (gnus-set-process-plist process (list 'images images - 'buffer buffer)))) + (when (executable-find "curl") + (let* ((url (caar images)) + (process (start-process + "images" nil "curl" + "-s" "--create-dirs" + "--location" + "--max-time" "60" + "-o" (gnus-html-image-id url) + (mm-url-decode-entities-string url)))) + (process-kill-without-query process) + (set-process-sentinel process 'gnus-html-curl-sentinel) + (gnus-set-process-plist process (list 'images images + 'buffer buffer))))) (defun gnus-html-image-id (url) (expand-file-name (sha1 url) gnus-html-cache-directory)) @@ -276,7 +325,7 @@ (when images (gnus-html-schedule-image-fetching buffer images))))) -(defun gnus-html-put-image (file point string) +(defun gnus-html-put-image (file point string &optional url alt-text) (when (gnus-graphic-display-p) (let* ((image (ignore-errors (gnus-create-image file))) @@ -301,11 +350,17 @@ 'gif) (= (car size) 30) (= (cdr size) 30)))) - (progn + (let ((start (point))) (setq image (gnus-html-rescale-image image file size)) (gnus-put-image image (gnus-string-or string "*") 'external) + (let ((overlay (gnus-make-overlay start (point)))) + (gnus-overlay-put overlay 'local-map + gnus-html-displayed-image-map) + (gnus-put-text-property start (point) 'gnus-alt-text alt-text) + (when url + (gnus-put-text-property start (point) 'gnus-image url))) (gnus-add-image 'external image) t) (insert string) @@ -360,7 +415,7 @@ (delete-file (nth 2 file))))))) (defun gnus-html-image-url-blocked-p (url blocked-images) -"Find out if URL is blocked by BLOCKED-IMAGES." + "Find out if URL is blocked by BLOCKED-IMAGES." (let ((ret (and blocked-images (string-match blocked-images url)))) (if ret @@ -387,7 +442,8 @@ ;;;###autoload (defun gnus-html-prefetch-images (summary) (let (blocked-images urls) - (when (buffer-live-p summary) + (when (and (buffer-live-p summary) + (executable-find "curl")) (with-current-buffer summary (setq blocked-images gnus-blocked-images)) (save-match-data @@ -395,7 +451,7 @@ (let ((url (match-string 1))) (unless (gnus-html-image-url-blocked-p url blocked-images) (unless (file-exists-p (gnus-html-image-id url)) - (push url urls) + (push (mm-url-decode-entities-string url) urls) (push (gnus-html-image-id url) urls) (push "-o" urls))))) (let ((process
--- a/lisp/gnus/gnus-registry.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/gnus-registry.el Thu Sep 16 11:11:13 2010 +0900 @@ -783,7 +783,7 @@ (function-name (format function-format variant-name)) (shortcut (format "%c" data)) (shortcut (if remove (upcase shortcut) shortcut))) - (unintern function-name) + (unintern function-name obarray) (eval `(defun ;; function name
--- a/lisp/gnus/gnus-start.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/gnus-start.el Thu Sep 16 11:11:13 2010 +0900 @@ -1692,7 +1692,7 @@ (gnus-agent-article-local-times 0) (archive-method (gnus-server-to-method "archive")) infos info group active method cmethod - method-type method-group-list) + method-type method-group-list entry) (gnus-message 6 "Checking new news...") (while newsrc @@ -1737,12 +1737,18 @@ (push (setq method-group-list (list method method-type nil)) type-cache)) ;; Only add groups that need updating. - (when (<= (gnus-info-level info) - (if (eq (cadr method-group-list) 'foreign) - foreign-level - alevel)) - (setcar (nthcdr 2 method-group-list) - (cons info (nth 2 method-group-list))))) + (if (<= (gnus-info-level info) + (if (eq (cadr method-group-list) 'foreign) + foreign-level + alevel)) + (setcar (nthcdr 2 method-group-list) + (cons info (nth 2 method-group-list))) + ;; The group is inactive, so we nix out the number of unread articles. + ;; It leads `(gnus-group-unread group)' to return t. See also + ;; `gnus-group-prepare-flat'. + (unless active + (when (setq entry (gnus-group-entry group)) + (setcar entry t))))) ;; Sort the methods based so that the primary and secondary ;; methods come first. This is done for legacy reasons to try to @@ -1795,14 +1801,15 @@ (cond ((gnus-check-backend-function 'retrieve-groups (car method)) (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 - (mapcar (lambda (info) - (gnus-group-real-name (gnus-info-group info))) - infos) - method)) + (dolist (info infos) + (gnus-request-scan (gnus-info-group info) method))) + (let (groups) + (gnus-read-active-file-2 + (dolist (info infos (nreverse groups)) + (push (gnus-group-real-name (gnus-info-group info)) groups)) + method))) ((gnus-check-backend-function 'request-list (car method)) - (gnus-read-active-file-1 method nil)) + (gnus-read-active-file-1 method nil infos)) (t (dolist (info infos) (gnus-activate-group (gnus-info-group info) nil nil method t)))))) @@ -2031,7 +2038,7 @@ (message "Quit reading the active file") nil)))))))) -(defun gnus-read-active-file-1 (method force) +(defun gnus-read-active-file-1 (method force &optional infos) (let (where mesg) (setq where (nth 1 method) mesg (format "Reading active file%s via %s..." @@ -2041,10 +2048,14 @@ (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. - (when (and gnus-agent - (gnus-online method) + (when (and (or (and gnus-agent + (gnus-online method)) + (not gnus-agent)) (gnus-check-backend-function 'request-scan (car method))) - (gnus-request-scan nil method)) + (if infos + (dolist (info infos) + (gnus-request-scan (gnus-info-group info) method)) + (gnus-request-scan nil method))) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))
--- a/lisp/gnus/gnus-sum.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/gnus-sum.el Thu Sep 16 11:11:13 2010 +0900 @@ -985,8 +985,7 @@ :group 'gnus-various :type 'hook) -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) +(defcustom gnus-summary-update-hook nil "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. @@ -3753,6 +3752,7 @@ (error (gnus-message 5 "Error updating the summary line"))) (when (gnus-visual-p 'summary-highlight 'highlight) (forward-line -1) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)))) @@ -3785,6 +3785,7 @@ 'score)) ;; Do visual highlighting. (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook))))) (defvar gnus-tmp-new-adopts nil) @@ -5363,7 +5364,9 @@ 'gnus-number number) (when gnus-visual-p (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) + (gnus-summary-highlight-line) + (when gnus-summary-update-hook + (gnus-run-hooks 'gnus-summary-update-hook)) (forward-line 1)) (setq gnus-tmp-prev-subject simp-subject))) @@ -10734,6 +10737,7 @@ (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook)) t)
--- a/lisp/gnus/mail-source.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/mail-source.el Thu Sep 16 11:11:13 2010 +0900 @@ -34,7 +34,7 @@ (require 'cl) (require 'imap)) (autoload 'auth-source-user-or-password "auth-source") -(autoload 'pop3-streaming-movemail "pop3") +(autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (autoload 'nnheader-cancel-timer "nnheader") (require 'mm-util) @@ -839,11 +839,9 @@ (if (eq authentication 'apop) 'apop 'pass)) (pop3-stream-type stream)) (if (or debug-on-quit debug-on-error) - (save-excursion (pop3-streaming-movemail - mail-source-crash-box)) + (save-excursion (pop3-movemail mail-source-crash-box)) (condition-case err - (save-excursion (pop3-streaming-movemail - mail-source-crash-box)) + (save-excursion (pop3-movemail mail-source-crash-box)) (error ;; We nix out the password in case the error ;; was because of a wrong password being given.
--- a/lisp/gnus/mm-decode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/mm-decode.el Thu Sep 16 11:11:13 2010 +0900 @@ -105,9 +105,7 @@ ,disposition ,description ,cache ,id)) (defcustom mm-text-html-renderer - (cond ((and (executable-find "w3m") - (executable-find "curl")) - 'gnus-article-html) + (cond ((executable-find "w3m") 'gnus-article-html) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) ((locate-library "w3") 'w3)
--- a/lisp/gnus/nnrss.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/nnrss.el Thu Sep 16 11:11:13 2010 +0900 @@ -342,11 +342,6 @@ ;; we return the article number. (cons nnrss-group (car e)))))) -(deffoo nnrss-request-list (&optional server) - (nnrss-possibly-change-group nil server) - (nnrss-generate-active) - t) - (deffoo nnrss-open-server (server &optional defs connectionless) (nnrss-read-server-data server) (nnoo-change-server 'nnrss server defs) @@ -397,6 +392,18 @@ (insert (car elem) "\t" (third elem) "\n")))) t) +(deffoo nnrss-retrieve-groups (groups &optional server) + (nnrss-possibly-change-group nil server) + (dolist (group groups) + (nnrss-check-group group server)) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (group groups) + (let ((elem (assoc group nnrss-server-data))) + (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) + 'active)) + (nnoo-define-skeleton nnrss) ;;; Internal functions @@ -479,20 +486,6 @@ (nnrss-read-group-data group server) (setq nnrss-group group))) -(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories)) - -(defun nnrss-generate-active () - (when (y-or-n-p "Fetch extra categories? ") - (mapc 'funcall nnrss-extra-categories)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnrss-group-alist) - (insert (prin1-to-string (car elem)) " 0 1 y\n")) - (dolist (elem nnrss-server-data) - (unless (assoc (car elem) nnrss-group-alist) - (insert (prin1-to-string (car elem)) " 0 1 y\n"))))) - (autoload 'timezone-parse-date "timezone") (defun nnrss-normalize-date (date) @@ -868,33 +861,6 @@ (append nnheader-file-name-translation-alist '((?' . ?_))))) (nnheader-translate-file-chars name))) -(defvar nnrss-moreover-url - "http://w.moreover.com/categories/category_list_rss.html" - "The url of moreover.com categories.") - -(defun nnrss-snarf-moreover-categories () - "Snarf RSS links from moreover.com." - (interactive) - (let (category name url changed) - (with-temp-buffer - (nnrss-insert nnrss-moreover-url) - (goto-char (point-min)) - (while (re-search-forward - "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t) - (if (match-string 1) - (setq category (match-string 1)) - (setq url (match-string 2) - name (mm-url-decode-entities-string - (rfc2231-decode-encoded-string - (match-string 3)))) - (if category - (setq name (concat category "." name))) - (unless (assoc name nnrss-server-data) - (setq changed t) - (push (list name 0 url) nnrss-server-data))))) - (if changed - (nnrss-save-server-data "")))) - (defun nnrss-node-text (namespace local-name element) (let* ((node (assq (intern (concat namespace (symbol-name local-name))) element))
--- a/lisp/gnus/pop3.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/gnus/pop3.el Thu Sep 16 11:11:13 2010 +0900 @@ -129,7 +129,8 @@ (truncate pop3-read-timeout)) 1000)))))) -(defun pop3-streaming-movemail (file) +;;;###autoload +(defun pop3-movemail (file) "Transfer contents of a maildrop to the specified FILE. Use streaming commands." (let* ((process (pop3-open-server pop3-mailhost pop3-port)) @@ -227,44 +228,6 @@ (pop3-pass process)) (t (error "Invalid POP3 authentication scheme"))))) -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count - message-sizes) - (pop3-logon process) - (setq message-count (car (pop3-stat process))) - (when (> message-count 0) - (setq message-sizes (pop3-list process))) - (unwind-protect - (while (<= n message-count) - (message "Retrieving message %d of %d from %s... (%.1fk)" - n message-count pop3-mailhost - (/ (cdr (assoc n message-sizes)) - 1024.0)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) crashbox t 'nomesg)) - (set-buffer (process-buffer process)) - (erase-buffer)) - (unless pop3-leave-mail-on-server - (pop3-dele process n)) - (setq n (+ 1 n)) - (pop3-accept-process-output process)) - (when (and pop3-leave-mail-on-server - (> n 1)) - (message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server' -to %s might not give the result you'd expect." pop3-leave-mail-on-server) - (sit-for 1)) - (pop3-quit process)) - (kill-buffer crashbuf)) - t) - (defun pop3-get-message-count () "Return the number of messages in the maildrop." (let* ((process (pop3-open-server pop3-mailhost pop3-port))
--- a/lisp/image.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/image.el Thu Sep 16 11:11:13 2010 +0900 @@ -697,21 +697,28 @@ (defcustom imagemagick-types-inhibit '(C HTML HTM TXT PDF) - "Types the imagemagick loader should not try to handle.") + ;; FIXME what are the possible options? + ;; Are these actually file-name extensions? + ;; Why are these upper-case when eg image-types is lower-case? + "Types the ImageMagick loader should not try to handle." + :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil) + (repeat symbol)) + :version "24.1" + :group 'image) ;;;###autoload (defun imagemagick-register-types () - "Register file types that imagemagick is able to handle." + "Register the file types that ImageMagick is able to handle." (let ((im-types (imagemagick-types))) (dolist (im-inhibit imagemagick-types-inhibit) (setq im-types (remove im-inhibit im-types))) (dolist (im-type im-types) (let ((extension (downcase (symbol-name im-type)))) (push - (cons (concat "\\." extension "\\'") 'image-mode) + (cons (concat "\\." extension "\\'") 'image-mode) auto-mode-alist) (push - (cons (concat "\\." extension "\\'") 'imagemagick) + (cons (concat "\\." extension "\\'") 'imagemagick) image-type-file-name-regexps)))))
--- a/lisp/international/ucs-normalize.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/international/ucs-normalize.el Thu Sep 16 11:11:13 2010 +0900 @@ -100,7 +100,7 @@ ;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars') ;; ;; The block will be split to multiple samller blocks by starter -;; charcters. Each block is sorted, and composed if necessary. +;; characters. Each block is sorted, and composed if necessary. ;; ;; E. Composition of Entire Block (`ucs-normalize-compose-chars') ;;
--- a/lisp/language/hebrew.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/language/hebrew.el Thu Sep 16 11:11:13 2010 +0900 @@ -88,14 +88,14 @@ ;; corresponding glyph of FONT-OBJECT. (defun hebrew-font-get-precomposed (font-object) (let ((precomposed (font-get font-object 'hebrew-precomposed)) - ;; Vector of Hebrew precomposed charaters. + ;; Vector of Hebrew precomposed characters. (chars [#xFB2A #xFB2B #xFB2C #xFB2D #xFB2E #xFB2F #xFB30 #xFB31 #xFB32 #xFB33 #xFB34 #xFB35 #xFB36 #xFB38 #xFB39 #xFB3A #xFB3B #xFB3C #xFB3E #xFB40 #xFB41 #xFB43 #xFB44 #xFB46 #xFB47 #xFB48 #xFB49 #xFB4A #xFB4B #xFB4C #xFB4D #xFB4E]) ;; Vector of decomposition character sequences corresponding ;; to the above vector. - (decomposed + (decomposed [[#x05E9 #x05C1] [#x05E9 #x05C2] [#x05E9 #x05BC #x05C1]
--- a/lisp/makefile.w32-in Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/makefile.w32-in Thu Sep 16 11:11:13 2010 +0900 @@ -55,7 +55,7 @@ # Automatically generated autoload files, apart from lisp/loaddefs.el. LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ $(lisp)/calendar/diary-loaddefs.el $(lisp)/calendar/hol-loaddefs.el \ - $(lisp)/mh-e/mh-loaddefs.el + $(lisp)/mh-e/mh-loaddefs.el $(lisp)/net/tramp-loaddefs.el AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ $(lisp)/finder-inf.el $(lisp)/subdirs.el $(lisp)/eshell/esh-groups.el \ @@ -403,6 +403,25 @@ -f w32-batch-update-autoloads \ $(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e +# Update TRAMP internal autoloads. Maybe we could move tramp*.el into +# its own subdirectory. OTOH, it does not hurt to keep them in +# lisp/net. +TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \ + $(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \ + $(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \ + $(lisp)/net/tramp-gw.el $(lisp)/net/tramp-imap.el \ + $(lisp)/net/tramp-sh.el $(lisp)/net/tramp-smb.el \ + $(lisp)/net/tramp-uu.el $(lisp)/net/trampver.el + +$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) + "$(EMACS)" $(EMACSOPT) \ + -l autoload \ + --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \ + --eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \ + --eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \ + -f w32-batch-update-autoloads \ + $(ARGQUOTE)$(lisp)/net/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net + # Prepare a bootstrap in the lisp subdirectory. # # Build loaddefs.el to make sure it's up-to-date. If it's not, that
--- a/lisp/menu-bar.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/menu-bar.el Thu Sep 16 11:11:13 2010 +0900 @@ -664,13 +664,23 @@ ;; put on a customized-value property. (dolist (elt '(line-number-mode column-number-mode size-indication-mode cua-mode show-paren-mode transient-mark-mode - blink-cursor-mode display-time-mode display-battery-mode)) + blink-cursor-mode display-time-mode display-battery-mode + ;; These are set by other functions that don't set + ;; the customized state. Having them here has the + ;; side-effect that turning them off via X + ;; resources acts like having customized them, but + ;; that seems harmless. + menu-bar-mode tool-bar-mode)) + ;; FIXME ? It's a little annoying that running this command + ;; always loads cua-base, paren, time, and battery, even if they + ;; have not been customized in any way. (Due to custom-load-symbol.) (and (customize-mark-to-save elt) (setq need-save t))) ;; These are set with `customize-set-variable'. (dolist (elt '(scroll-bar-mode debug-on-quit debug-on-error - tooltip-mode menu-bar-mode tool-bar-mode + ;; Somehow this works, when tool-bar and menu-bar don't. + tooltip-mode save-place uniquify-buffer-name-style fringe-mode indicate-empty-lines indicate-buffer-boundaries case-fold-search font-use-system-font @@ -2037,6 +2047,16 @@ (run-with-idle-timer 0 nil 'message "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear."))) +;;;###autoload +;; (This does not work right unless it comes after the above definition.) +;; This comment is taken from tool-bar.el near +;; (put 'tool-bar-mode ...) +;; We want to pretend the menu bar by standard is on, as this will make +;; customize consider disabling the menu bar a customization, and save +;; that. We could do this for real by setting :init-value above, but +;; that would overwrite disabling the menu bar from X resources. +(put 'menu-bar-mode 'standard-value '(t)) + (defun toggle-menu-bar-mode-from-frame (&optional arg) "Toggle menu bar on or off, based on the status of the current frame. See `menu-bar-mode' for more information."
--- a/lisp/net/imap.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/imap.el Thu Sep 16 11:11:13 2010 +0900 @@ -448,6 +448,18 @@ The function should take two arguments, the first the IMAP tag and the second the status (OK, NO, BAD etc) of the command.") +(defvar imap-enable-exchange-bug-workaround nil + "Send FETCH UID commands as *:* instead of *. + +When non-nil, use an alternative UIDS form. Enabling appears to +be required for some servers (e.g., Microsoft Exchange 2007) +which otherwise would trigger a response 'BAD The specified +message set is invalid.'. We don't unconditionally use this +form, since this is said to be significantly inefficient. + +This variable is set to t automatically per server if the +canonical form fails.") + ;; Utility functions: @@ -1303,38 +1315,40 @@ ;; Mailbox functions: -(defun imap-mailbox-put (propname value &optional mailbox) - (if imap-mailbox-data - (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) - propname value) - (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" - propname value mailbox (current-buffer))) - t) +(defun imap-mailbox-put (propname value &optional mailbox buffer) + (with-current-buffer (or buffer (current-buffer)) + (if imap-mailbox-data + (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) + propname value) + (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" + propname value mailbox (current-buffer))) + t)) (defsubst imap-mailbox-get-1 (propname &optional mailbox) (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data) propname)) (defun imap-mailbox-get (propname &optional mailbox buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox) - imap-current-mailbox)))) + (let ((mailbox (imap-utf7-encode mailbox))) + (with-current-buffer (or buffer (current-buffer)) + (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox))))) -(defun imap-mailbox-map-1 (func &optional mailbox-decoder) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (if mailbox-decoder - (funcall mailbox-decoder (symbol-name s)) - (symbol-name s))) result)) - imap-mailbox-data) - result)) +(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer) + (with-current-buffer (or buffer (current-buffer)) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (if mailbox-decoder + (funcall mailbox-decoder (symbol-name s)) + (symbol-name s))) result)) + imap-mailbox-data) + result))) -(defun imap-mailbox-map (func) +(defun imap-mailbox-map (func &optional buffer) "Map a function across each mailbox in `imap-mailbox-data', returning a list. Function should take a mailbox name (a string) as the only argument." - (imap-mailbox-map-1 func 'imap-utf7-decode)) + (imap-mailbox-map-1 func 'imap-utf7-decode buffer)) (defun imap-current-mailbox (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1648,26 +1662,29 @@ uids) (imap-message-get uids receive)))))) -(defun imap-message-put (uid propname value) - (if imap-message-data - (put (intern (number-to-string uid) imap-message-data) - propname value) - (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" - uid propname value (current-buffer))) - t) +(defun imap-message-put (uid propname value &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (if imap-message-data + (put (intern (number-to-string uid) imap-message-data) + propname value) + (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" + uid propname value (current-buffer))) + t)) -(defun imap-message-get (uid propname) - (get (intern-soft (number-to-string uid) imap-message-data) - propname)) +(defun imap-message-get (uid propname &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (get (intern-soft (number-to-string uid) imap-message-data) + propname))) -(defun imap-message-map (func propname) +(defun imap-message-map (func propname &optional buffer) "Map a function across each message in `imap-message-data', returning a list." - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (get s 'UID) (get s propname)) result)) - imap-message-data) - result)) + (with-current-buffer (or buffer (current-buffer)) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (get s 'UID) (get s propname)) result)) + imap-message-data) + result))) (defmacro imap-message-envelope-date (uid &optional buffer) `(with-current-buffer (or ,buffer (current-buffer)) @@ -1763,6 +1780,48 @@ (format "String %s cannot be converted to a Lisp integer" number)) number))) +(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer) + "Like `imap-fetch', but DTRT with Exchange 2007 bug. +However, UIDS here is a cons, where the car is the canonical form +of the UIDS specification, and the cdr is the one which works with +Exchange 2007 or, potentially, other buggy servers. +See `imap-enable-exchange-bug-workaround'." + ;; The first time we get here for a given, we'll try the canonical + ;; form. If we get the known error from the buggy server, set the + ;; flag buffer-locally (to account for connections to multiple + ;; servers), then re-try with the alternative UIDS spec. We don't + ;; unconditionally use the alternative form, since the + ;; currently-used alternatives are seriously inefficient with some + ;; servers (although they are valid). + ;; + ;; FIXME: Maybe it would be cleaner to have a flag to not signal + ;; the error (which otherwise gives a message), and test + ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of + ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:* + ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not + ;; to do the same? + (condition-case data + ;; Binding `debug-on-error' allows us to get the error from + ;; `imap-parse-response' -- it's normally caught by Emacs around + ;; execution of a process filter. + (let ((debug-on-error t)) + (imap-fetch (if imap-enable-exchange-bug-workaround + (cdr uids) + (car uids)) + props receive nouidfetch buffer)) + (error + (if (and (not imap-enable-exchange-bug-workaround) + ;; This is the Exchange 2007 response. It may be more + ;; robust just to check for a BAD response to the + ;; attempted fetch. + (string-match "The specified message set is invalid" + (cadr data))) + (with-current-buffer (or buffer (current-buffer)) + (set (make-local-variable 'imap-enable-exchange-bug-workaround) + t) + (imap-fetch (cdr uids) props receive nouidfetch)) + (signal (car data) (cdr data)))))) + (defun imap-message-copyuid-1 (mailbox) (if (imap-capability 'UIDPLUS) (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) @@ -1772,7 +1831,7 @@ (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch "*:*" "UID") + (and (imap-fetch-safe '("*" . "*:*") "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -1818,7 +1877,7 @@ (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch "*:*" "UID") + (and (imap-fetch-safe '("*" . "*:*") "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -2892,6 +2951,105 @@ (imap-forward) (nreverse body))))) +(when imap-debug ; (untrace-all) + (require 'trace) + (buffer-disable-undo (get-buffer-create imap-debug-buffer)) + (mapc (lambda (f) (trace-function-background f imap-debug-buffer)) + '( + imap-utf7-encode + imap-utf7-decode + imap-error-text + imap-kerberos4s-p + imap-kerberos4-open + imap-ssl-p + imap-ssl-open + imap-network-p + imap-network-open + imap-interactive-login + imap-kerberos4a-p + imap-kerberos4-auth + imap-cram-md5-p + imap-cram-md5-auth + imap-login-p + imap-login-auth + imap-anonymous-p + imap-anonymous-auth + imap-open-1 + imap-open + imap-opened + imap-ping-server + imap-authenticate + imap-close + imap-capability + imap-namespace + imap-send-command-wait + imap-mailbox-put + imap-mailbox-get + imap-mailbox-map-1 + imap-mailbox-map + imap-current-mailbox + imap-current-mailbox-p-1 + imap-current-mailbox-p + imap-mailbox-select-1 + imap-mailbox-select + imap-mailbox-examine-1 + imap-mailbox-examine + imap-mailbox-unselect + imap-mailbox-expunge + imap-mailbox-close + imap-mailbox-create-1 + imap-mailbox-create + imap-mailbox-delete + imap-mailbox-rename + imap-mailbox-lsub + imap-mailbox-list + imap-mailbox-subscribe + imap-mailbox-unsubscribe + imap-mailbox-status + imap-mailbox-acl-get + imap-mailbox-acl-set + imap-mailbox-acl-delete + imap-current-message + imap-list-to-message-set + imap-fetch-asynch + imap-fetch + imap-fetch-safe + imap-message-put + imap-message-get + imap-message-map + imap-search + imap-message-flag-permanent-p + imap-message-flags-set + imap-message-flags-del + imap-message-flags-add + imap-message-copyuid-1 + imap-message-copyuid + imap-message-copy + imap-message-appenduid-1 + imap-message-appenduid + imap-message-append + imap-body-lines + imap-envelope-from + imap-send-command-1 + imap-send-command + imap-wait-for-tag + imap-sentinel + imap-find-next-line + imap-arrival-filter + imap-parse-greeting + imap-parse-response + imap-parse-resp-text + imap-parse-resp-text-code + imap-parse-data-list + imap-parse-fetch + imap-parse-status + imap-parse-acl + imap-parse-flag-list + imap-parse-envelope + imap-parse-body-extension + imap-parse-body + ))) + (provide 'imap) ;;; imap.el ends here
--- a/lisp/net/netrc.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/netrc.el Thu Sep 16 11:11:13 2010 +0900 @@ -54,12 +54,19 @@ "Netrc configuration." :group 'comm) +(defcustom netrc-file "~/.authinfo" + "File where user credentials are stored." + :type 'file + :group 'netrc) + (defvar netrc-services-file "/etc/services" "The name of the services file.") -(defun netrc-parse (file) +(defun netrc-parse (&optional file) (interactive "fFile to Parse: ") "Parse FILE and return a list of all entries in the file." + (unless file + (setq file netrc-file)) (if (listp file) file (when (file-exists-p file) @@ -221,6 +228,19 @@ (eq type (car (cddr service))))))) (cadr service))) +(defun netrc-credentials (machine &rest ports) + "Return a user name/password pair. +Port specifications will be prioritised in the order they are +listed in the PORTS list." + (let ((list (netrc-parse)) + found) + (while (and ports + (not found)) + (setq found (netrc-machine list machine (pop ports)))) + (when found + (list (cdr (assoc "login" found)) + (cdr (assoc "password" found)))))) + (provide 'netrc) ;;; netrc.el ends here
--- a/lisp/net/rcirc.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/rcirc.el Thu Sep 16 11:11:13 2010 +0900 @@ -774,42 +774,64 @@ (setq rcirc-input-ring-index (1- rcirc-input-ring-index)) (insert (rcirc-prev-input-string -1)))) -(defvar rcirc-nick-completions nil) -(defvar rcirc-nick-completion-start-offset nil) +(defvar rcirc-server-commands + '("/admin" "/away" "/connect" "/die" "/error" "/info" + "/invite" "/ison" "/join" "/kick" "/kill" "/links" + "/list" "/lusers" "/mode" "/motd" "/names" "/nick" + "/notice" "/oper" "/part" "/pass" "/ping" "/pong" + "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist" + "/server" "/squery" "/squit" "/stats" "/summon" "/time" + "/topic" "/trace" "/user" "/userhost" "/users" "/version" + "/wallops" "/who" "/whois" "/whowas") + "A list of user commands by IRC server. +The value defaults to RFCs 1459 and 2812.") + +;; /me and /ctcp are not defined by `defun-rcirc-command'. +(defvar rcirc-client-commands '("/me" "/ctcp") + "A list of user commands defined by IRC client rcirc. +The list is updated automatically by `defun-rcirc-command'.") -(defun rcirc-complete-nick () - "Cycle through nick completions from list of nicks in channel." +(defun rcirc-completion-at-point () + "Function used for `completion-at-point-functions' in `rcirc-mode'." + (let* ((beg (save-excursion + (if (re-search-backward " " rcirc-prompt-end-marker t) + (1+ (point)) + rcirc-prompt-end-marker))) + (table (if (and (= beg rcirc-prompt-end-marker) + (eq (char-after beg) ?/)) + (delete-dups + (nconc + (sort (copy-sequence rcirc-client-commands) 'string-lessp) + (sort (copy-sequence rcirc-server-commands) 'string-lessp))) + (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))) + (list beg (point) table))) + +(defvar rcirc-completions nil) +(defvar rcirc-completion-start nil) + +(defun rcirc-complete () + "Cycle through completions from list of nicks in channel or IRC commands. +IRC command completion is performed only if '/' is the first input char." (interactive) (if (eq last-command this-command) - (setq rcirc-nick-completions - (append (cdr rcirc-nick-completions) - (list (car rcirc-nick-completions)))) - (setq rcirc-nick-completion-start-offset - (- (save-excursion - (if (re-search-backward " " rcirc-prompt-end-marker t) - (1+ (point)) - rcirc-prompt-end-marker)) - rcirc-prompt-end-marker)) - (setq rcirc-nick-completions - (let ((completion-ignore-case t)) - (all-completions - (buffer-substring - (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (mapcar (lambda (x) (cons x nil)) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)))))) - (let ((completion (car rcirc-nick-completions))) + (setq rcirc-completions + (append (cdr rcirc-completions) (list (car rcirc-completions)))) + (let ((completion-ignore-case t) + (table (rcirc-completion-at-point))) + (setq rcirc-completion-start (car table)) + (setq rcirc-completions + (all-completions (buffer-substring rcirc-completion-start + (cadr table)) + (nth 2 table))))) + (let ((completion (car rcirc-completions))) (when completion - (delete-region (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (insert (concat completion - (if (= (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - rcirc-prompt-end-marker) - ": ")))))) + (delete-region rcirc-completion-start (point)) + (insert + (concat completion + (cond + ((= (aref completion 0) ?/) " ") + ((= rcirc-completion-start rcirc-prompt-end-marker) ": ") + (t ""))))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." @@ -827,7 +849,7 @@ (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) -(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick) +(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete) (define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) (define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) @@ -948,6 +970,9 @@ rcirc-buffer-alist)))) (rcirc-update-short-buffer-names)) + (add-hook 'completion-at-point-functions + 'rcirc-completion-at-point nil 'local) + (run-hooks 'rcirc-mode-hook)) (defun rcirc-update-prompt (&optional all) @@ -2004,16 +2029,18 @@ ;; containing the text following the /cmd. (defmacro defun-rcirc-command (command argument docstring interactive-form - &rest body) + &rest body) "Define a command." - `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) - (,@argument &optional process target) - ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - ,interactive-form - (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) - ,@body))) + `(progn + (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) + (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) + (,@argument &optional process target) + ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + ,interactive-form + (let ((process (or process (rcirc-buffer-process))) + (target (or target rcirc-target))) + ,@body)))) (defun-rcirc-command msg (message) "Send private MESSAGE to TARGET."
--- a/lisp/net/tramp-cache.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-cache.el Thu Sep 16 11:11:13 2010 +0900 @@ -50,24 +50,12 @@ ;;; Code: -;; Pacify byte-compiler. -(eval-when-compile - (require 'cl) - (autoload 'tramp-message "tramp") - (autoload 'tramp-tramp-file-p "tramp") - ;; We cannot autoload macro `with-parsed-tramp-file-name', it - ;; results in problems of byte-compiled code. - (autoload 'tramp-dissect-file-name "tramp") - (autoload 'tramp-file-name-method "tramp") - (autoload 'tramp-file-name-user "tramp") - (autoload 'tramp-file-name-host "tramp") - (autoload 'tramp-file-name-localname "tramp") - (autoload 'tramp-run-real-handler "tramp") - (autoload 'tramp-time-less-p "tramp") - (autoload 'time-stamp-string "time-stamp")) +(require 'tramp) +(autoload 'time-stamp-string "time-stamp") ;;; -- Cache -- +;;;###tramp-autoload (defvar tramp-cache-data (make-hash-table :test 'equal) "Hash table for remote files properties.") @@ -103,6 +91,7 @@ (defvar tramp-cache-data-changed nil "Whether persistent cache data have been changed.") +;;;###tramp-autoload (defun tramp-get-file-property (vec file property default) "Get the PROPERTY of FILE from the cache context of VEC. Returns DEFAULT if not set." @@ -130,6 +119,7 @@ (tramp-message vec 8 "%s %s %s" file property value) value)) +;;;###tramp-autoload (defun tramp-set-file-property (vec file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of VEC. Returns VALUE." @@ -144,6 +134,28 @@ (tramp-message vec 8 "%s %s %s" file property value) value)) +;;;###tramp-autoload +(defmacro with-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +;;;###tramp-autoload +(put 'with-file-property 'lisp-indent-function 3) +(put 'with-file-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-file-property\\>")) + +;;;###tramp-autoload (defun tramp-flush-file-property (vec file) "Remove all properties of FILE in the cache context of VEC." ;; Unify localname. @@ -152,6 +164,7 @@ (tramp-message vec 8 "%s" file) (remhash vec tramp-cache-data)) +;;;###tramp-autoload (defun tramp-flush-directory-property (vec directory) "Remove all properties of DIRECTORY in the cache context of VEC. Remove also properties of all files in subdirectories." @@ -175,8 +188,7 @@ (buffer-file-name) default-directory))) (when (tramp-tramp-file-p bfn) - (let* ((v (tramp-dissect-file-name bfn)) - (localname (tramp-file-name-localname v))) + (with-parsed-tramp-file-name bfn nil (tramp-flush-file-property v localname))))) (add-hook 'before-revert-hook 'tramp-flush-file-function) @@ -193,6 +205,7 @@ ;;; -- Properties -- +;;;###tramp-autoload (defun tramp-get-connection-property (key property default) "Get the named PROPERTY for the connection. KEY identifies the connection, it is either a process or a vector. @@ -209,6 +222,7 @@ (tramp-message key 7 "%s %s" property value) value)) +;;;###tramp-autoload (defun tramp-set-connection-property (key property value) "Set the named PROPERTY of a connection to VALUE. KEY identifies the connection, it is either a process or a vector. @@ -223,14 +237,28 @@ tramp-cache-data)))) (puthash property value hash) (setq tramp-cache-data-changed t) - ;; This function is called also during initialization of - ;; tramp-cache.el. `tramp-message´ is not defined yet at this - ;; time, so we ignore the corresponding error. - (condition-case nil - (tramp-message key 7 "%s %s" property value) - (error nil)) + (tramp-message key 7 "%s %s" property value) value)) +;;;###tramp-autoload +(defmacro with-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) + +;;;###tramp-autoload +(put 'with-connection-property 'lisp-indent-function 2) +(put 'with-connection-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-connection-property\\>")) + +;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. KEY identifies the connection, it is either a process or a vector." @@ -251,6 +279,7 @@ (setq tramp-cache-data-changed t) (remhash key tramp-cache-data)) +;;;###tramp-autoload (defun tramp-cache-print (table) "Print hash table TABLE." (when (hash-table-p table) @@ -271,6 +300,7 @@ table) result))) +;;;###tramp-autoload (defun tramp-list-connections () "Return a list of all known connection vectors according to `tramp-cache'." (let (result) @@ -284,41 +314,40 @@ (defun tramp-dump-connection-properties () "Write persistent connection properties into file `tramp-persistency-file-name'." ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed. - (condition-case nil - (when (and (hash-table-p tramp-cache-data) - (not (zerop (hash-table-count tramp-cache-data))) - tramp-cache-data-changed - (stringp tramp-persistency-file-name)) - (let ((cache (copy-hash-table tramp-cache-data))) - ;; Remove temporary data. - (maphash - '(lambda (key value) - (if (and (vectorp key) (not (tramp-file-name-localname key))) - (progn - (remhash "process-name" value) - (remhash "process-buffer" value) - (remhash "first-password-request" value)) - (remhash key cache))) - cache) - ;; Dump it. - (with-temp-buffer - (insert - ";; -*- emacs-lisp -*-" - ;; `time-stamp-string' might not exist in all (X)Emacs flavors. - (condition-case nil - (progn - (format - " <%s %s>\n" - (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") - tramp-persistency-file-name)) - (error "\n")) - ";; Tramp connection history. Don't change this file.\n" - ";; You can delete it, forcing Tramp to reapply the checks.\n\n" - (with-output-to-string - (pp (read (format "(%s)" (tramp-cache-print cache)))))) - (write-region - (point-min) (point-max) tramp-persistency-file-name)))) - (error nil))) + (ignore-errors + (when (and (hash-table-p tramp-cache-data) + (not (zerop (hash-table-count tramp-cache-data))) + tramp-cache-data-changed + (stringp tramp-persistency-file-name)) + (let ((cache (copy-hash-table tramp-cache-data))) + ;; Remove temporary data. + (maphash + '(lambda (key value) + (if (and (vectorp key) (not (tramp-file-name-localname key))) + (progn + (remhash "process-name" value) + (remhash "process-buffer" value) + (remhash "first-password-request" value)) + (remhash key cache))) + cache) + ;; Dump it. + (with-temp-buffer + (insert + ";; -*- emacs-lisp -*-" + ;; `time-stamp-string' might not exist in all (X)Emacs flavors. + (condition-case nil + (progn + (format + " <%s %s>\n" + (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") + tramp-persistency-file-name)) + (error "\n")) + ";; Tramp connection history. Don't change this file.\n" + ";; You can delete it, forcing Tramp to reapply the checks.\n\n" + (with-output-to-string + (pp (read (format "(%s)" (tramp-cache-print cache)))))) + (write-region + (point-min) (point-max) tramp-persistency-file-name)))))) (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties) (add-hook 'tramp-cache-unload-hook @@ -326,6 +355,7 @@ (remove-hook 'kill-emacs-hook 'tramp-dump-connection-properties))) +;;;###tramp-autoload (defun tramp-parse-connection-properties (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' @@ -364,6 +394,10 @@ tramp-persistency-file-name (error-message-string err)) (clrhash tramp-cache-data)))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-cache 'force))) + (provide 'tramp-cache) ;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
--- a/lisp/net/tramp-cmds.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-cmds.el Thu Sep 16 11:11:13 2010 +0900 @@ -129,6 +129,7 @@ ;; Tramp version is useful in a number of situations. +;;;###tramp-autoload (defun tramp-version (arg) "Print version number of tramp.el in minibuffer or current buffer." (interactive "P") @@ -387,6 +388,9 @@ (defalias 'tramp-submit-bug 'tramp-bug) +(add-hook 'tramp-unload-hook + (lambda () (unload-feature 'tramp-cmds 'force))) + (provide 'tramp-cmds) ;;; TODO: @@ -395,7 +399,7 @@ ;; * WIBNI there was an interactive command prompting for Tramp ;; method, hostname, username and filename and translates the user ;; input into the correct filename syntax (depending on the Emacs -;; flavor) (Reiner Steib) +;; flavor) (Reiner Steib) ;; * Let the user edit the connection properties interactively. ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. ;; * It's just that when I come to Customize `tramp-default-user-alist' @@ -404,7 +408,7 @@ ;; Option and should not be modified by the code. add-to-list is ;; called in several places. One way to handle that is to have a new ;; ordinary variable that gets its initial value from -;; tramp-default-user-alist and then is added to. (Pete Forman) +;; tramp-default-user-alist and then is added to. (Pete Forman) ;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c ;;; tramp-cmds.el ends here
--- a/lisp/net/tramp-compat.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-compat.el Thu Sep 16 11:11:13 2010 +0900 @@ -29,6 +29,8 @@ ;;; Code: +(require 'tramp-loaddefs) + (eval-when-compile ;; Pacify byte-compiler. @@ -36,40 +38,41 @@ (eval-and-compile + (require 'advice) (require 'custom) + (require 'format-spec) + + ;; As long as password.el is not part of (X)Emacs, it shouldn't be + ;; mandatory. + (if (featurep 'xemacs) + (load "password" 'noerror) + (or (require 'password-cache nil 'noerror) + (require 'password nil 'noerror))) ; Part of contrib. + + ;; auth-source is relatively new. + (if (featurep 'xemacs) + (load "auth-source" 'noerror) + (require 'auth-source nil 'noerror)) ;; Load the appropriate timer package. (if (featurep 'xemacs) (require 'timer-funcs) (require 'timer)) - (autoload 'tramp-tramp-file-p "tramp") - (autoload 'tramp-file-name-handler "tramp") - ;; We check whether `start-file-process' is bound. (unless (fboundp 'start-file-process) ;; tramp-util offers integration into other (X)Emacs packages like ;; compile.el, gud.el etc. Not necessary in Emacs 23. (eval-after-load "tramp" - '(progn - (require 'tramp-util) - (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-util) - (unload-feature 'tramp-util 'force)))))) + '(require 'tramp-util)) ;; Make sure that we get integration with the VC package. When it ;; is loaded, we need to pull in the integration module. Not ;; necessary in Emacs 23. (eval-after-load "vc" (eval-after-load "tramp" - '(progn - (require 'tramp-vc) - (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-vc) - (unload-feature 'tramp-vc 'force)))))))) + '(require 'tramp-vc)))) ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. @@ -93,11 +96,6 @@ (defvar byte-compile-not-obsolete-vars nil)) (setq byte-compile-not-obsolete-vars '(directory-sep-char)) - ;; `with-temp-message' does not exists in XEmacs. - (condition-case nil - (with-temp-message (current-message) nil) - (error (defmacro with-temp-message (message &rest body) `(progn ,@body)))) - ;; For not existing functions, or functions with a changed argument ;; list, there are compiler warnings. We want to avoid them in ;; cases we know what we do. @@ -111,10 +109,6 @@ (unless (fboundp 'set-buffer-multibyte) (defalias 'set-buffer-multibyte 'ignore)) - ;; `font-lock-add-keywords' does not exist in XEmacs. - (unless (fboundp 'font-lock-add-keywords) - (defalias 'font-lock-add-keywords 'ignore)) - ;; The following functions cannot be aliases of the corresponding ;; `tramp-handle-*' functions, because this would bypass the locking ;; mechanism. @@ -187,6 +181,19 @@ 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) (ad-activate 'file-expand-wildcards))))) +;; `with-temp-message' does not exists in XEmacs. +(if (fboundp 'with-temp-message) + (defalias 'tramp-compat-with-temp-message 'with-temp-message) + (defun tramp-compat-with-temp-message (message &rest body) + "Display MESSAGE temporarily if non-nil while BODY is evaluated." + `(progn ,@body))) + +;; `font-lock-add-keywords' does not exist in XEmacs. +(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how) + "Add highlighting KEYWORDS for MODE." + (ignore-errors + (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) + (defsubst tramp-compat-line-beginning-position () "Return point at beginning of line (compat function). Calls `line-beginning-position' or `point-at-bol' if defined, else @@ -263,6 +270,24 @@ ;; Default value in XEmacs. (t 134217727))) +(defun tramp-compat-decimal-to-octal (i) + "Return a string consisting of the octal digits of I. +Not actually used. Use `(format \"%o\" i)' instead?" + (cond ((< i 0) (error "Cannot convert negative number to octal")) + ((not (integerp i)) (error "Cannot convert non-integer to octal")) + ((zerop i) "0") + (t (concat (tramp-compat-decimal-to-octal (/ i 8)) + (number-to-string (% i 8)))))) + +;; Kudos to Gerd Moellmann for this suggestion. +(defun tramp-compat-octal-to-decimal (ostr) + "Given a string of octal digits, return a decimal number." + (let ((x (or ostr ""))) + ;; `save-match' is in `tramp-mode-string-to-int' which calls this. + (unless (string-match "\\`[0-7]*\\'" x) + (error "Non-octal junk in string `%s'" x)) + (string-to-number ostr 8))) + ;; ID-FORMAT does not exists in XEmacs. (defun tramp-compat-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files (compat function)." @@ -397,6 +422,20 @@ element is not omitted." (delete "" (split-string string pattern))) +(defun tramp-compat-call-process + (program &optional infile destination display &rest args) + "Calls `call-process' on the local host. +This is needed because for some Emacs flavors Tramp has +defadviced `call-process' to behave like `process-file'. The +Lisp error raised when PROGRAM is nil is trapped also, returning 1." + (let ((default-directory + (if (file-remote-p default-directory) + (tramp-compat-temporary-file-directory) + default-directory))) + (if (executable-find program) + (apply 'call-process program infile destination display args) + 1))) + (defun tramp-compat-process-running-p (process-name) "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) @@ -439,6 +478,22 @@ (setenv "UNIX95" unix95) result))))) +;; The following functions do not exist in XEmacs. We ignore this; +;; they are used for checking a remote tty. +(defun tramp-compat-process-get (process propname) + "Return the value of PROCESS' PROPNAME property. +This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." + (ignore-errors (tramp-compat-funcall 'process-get process propname))) + +(defun tramp-compat-process-put (process propname value) + "Change PROCESS' PROPNAME property to VALUE. +It can be retrieved with `(process-get PROCESS PROPNAME)'." + (ignore-errors (tramp-compat-funcall 'process-put process propname value))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-compat 'force))) + (provide 'tramp-compat) ;;; TODO:
--- a/lisp/net/tramp-fish.el Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1181 +0,0 @@ -;;; tramp-fish.el --- Tramp access functions for FISH protocol - -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Michael Albinus <michael.albinus@gmx.de> -;; Keywords: comm, processes -;; Package: tramp - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Access functions for FIles transferred over SHell protocol from Tramp. - -;; FISH is a protocol developped for the GNU Midnight Commander -;; <https://savannah.gnu.org/projects/mc>. A client connects to a -;; remote host via ssh (or rsh, shall be configurable), and starts -;; there a fish server via the command "start_fish_server". All -;; commands from the client have the form "#FISH_COMMAND\n" (always -;; one line), followed by equivalent shell commands in case there is -;; no fish server running. - -;; The fish server (or the equivalent shell commands) must return the -;; response, which is finished by a line "### xxx <optional text>\n". -;; "xxx" stands for 3 digits, representing a return code. Return -;; codes "# 000" and "# 001" are reserved for fallback implementation -;; with native shell commands; they are not used inside the server. See -;; <http://cvs.savannah.gnu.org/viewcvs/mc/vfs/README.fish?root=mc&view=markup> -;; for details of original specification. - -;; The GNU Midnight Commander implements the original fish protocol -;; version 0.0.2. The KDE Konqueror has its own implementation, which -;; can be found at -;; <http://websvn.kde.org/branches/KDE/3.5/kdebase/kioslave/fish>. It -;; implements an extended protocol version 0.0.3. Additionally, it -;; provides a fish server implementation in Perl (which is the only -;; implementation I've heard of). The following command reference is -;; based on that implementation. - -;; All commands return either "### 2xx\n" (OK) or "### 5xx <optional text>\n" -;; (NOK). Return codes are mentioned only if they are different from this. -;; Spaces in any parameter must be escaped by "\ ". - -;; Command/Return Code Comment -;; -;; #FISH initial connection, not used -;; in .fishsrv.pl -;; ### 100 transfer fish server missing server, or wrong checksum -;; version 0.0.3 only - -;; #VER a.b.c <commands requested> -;; VER x.y.z <commands offered> .fishsrv.pl response is not uptodate - -;; #PWD -;; /path/to/file - -;; #CWD /some/path - -;; #COPY /path/a /path/b version 0.0.3 only - -;; #RENAME /path/a /path/b - -;; #SYMLINK /path/a /path/b - -;; #LINK /path/a /path/b - -;; #DELE /some/path - -;; #MKD /some/path - -;; #RMD /some/path - -;; #CHOWN user /file/name - -;; #CHGRP group /file/name - -;; #CHMOD 1234 file - -;; #READ <offset> <size> /path/and/filename -;; ### 291 successful exit when reading -;; ended at eof -;; ### 292 successful exit when reading -;; did not end at eof - -;; #WRITE <offset> <size> /path/and/filename - -;; #APPEND <size> /path/and/filename version 0.0.3 only - -;; #LIST /directory -;; <number of entries> version 0.0.3 only -;; ### 100 version 0.0.3 only -;; P<unix permissions> <owner>.<group> -;; S<size> -;; d<3-letters month name> <day> <year or HH:MM> -;; D<year> <month> <day> <hour> <minute> <second>[.1234] -;; E<major-of-device>,<minor> -;; :<filename> -;; L<filename symlink points to> -;; M<mimetype> version 0.0.3 only -;; <blank line to separate items> - -;; #STAT /file version 0.0.3 only -;; like #LIST except for directories -;; <number of entries> -;; ### 100 -;; P<unix permissions> <owner>.<group> -;; S<size> -;; d<3-letters month name> <day> <year or HH:MM> -;; D<year> <month> <day> <hour> <minute> <second>[.1234] -;; E<major-of-device>,<minor> -;; :<filename> -;; L<filename symlink points to> -;; <blank line to separate items> - -;; #RETR /some/name -;; <filesize> -;; ### 100 -;; <binary data> exactly filesize bytes -;; ### 200 with no preceding newline - -;; #STOR <size> /file/name -;; ### 100 -;; <data> exactly size bytes -;; ### 001 partial success - -;; #EXEC <command> <tmpfile> version 0.0.3 only -;; <tmpfile> must not exists. It contains the output of <command>. -;; It can be retrieved afterwards. Last line is -;; ###RESULT: <returncode> - -;; This implementation is meant as proof of the concept, whether there -;; is a better performance compared with the native ssh method. It -;; looks like the file information retrieval is slower, especially the -;; #LIST command. On the other hand, the file contents transmission -;; seems to perform better than other inline methods, because there is -;; no need for data encoding/decoding, and it supports the APPEND -;; parameter of `write-region'. Transfer of binary data fails due to -;; Emacs' process input/output handling. - -;;; Code: - -(eval-when-compile - ;; Pacify byte-compiler. - (require 'cl)) - -(require 'tramp) -(require 'tramp-cache) -(require 'tramp-compat) - -;; Define FISH method ... -(defcustom tramp-fish-method "fish" - "*Method to connect via FISH protocol." - :group 'tramp - :type 'string) - -;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-fish-method nil)) - -;; Add a default for `tramp-default-user-alist'. Default is the local user. -(add-to-list 'tramp-default-user-alist - `(,tramp-fish-method nil ,(user-login-name))) - -;; Add completion function for FISH method. -(tramp-set-completion-function - tramp-fish-method tramp-completion-function-alist-ssh) - -(defconst tramp-fish-continue-prompt-regexp "^### 100.*\n" - "FISH return code OK.") - -;; It cannot be a defconst, occasionally we bind it locally. -(defvar tramp-fish-ok-prompt-regexp "^### 200\n" - "FISH return code OK.") - -(defconst tramp-fish-error-prompt-regexp "^### \\(4\\|5\\)[0-9]+.*\n" - "Regexp for possible error strings of FISH servers. -Used instead of analyzing error codes of commands.") - -(defcustom tramp-fish-start-fish-server-command - (concat "stty intr \"\" quit \"\" erase \"\" kill \"\" eof \"\" eol \"\" eol2 \"\" swtch \"\" start \"\" stop \"\" susp \"\" rprnt \"\" werase \"\" lnext \"\" flush \"\"; " - "perl .fishsrv.pl " - "`grep 'ARGV\\[0\\]' .fishsrv.pl | " - "sed -e 's/^[^\"]*\"//' -e 's/\"[^\"]*$//'`; " - "exit") - "*Command to connect via FISH protocol." - :group 'tramp - :type 'string) - -;; New handlers should be added here. -(defconst tramp-fish-file-name-handler-alist - '( - ;; `access-file' performed by default handler - (add-name-to-file . tramp-fish-handle-add-name-to-file) - ;; `byte-compiler-base-file-name' performed by default handler - (copy-file . tramp-fish-handle-copy-file) - (delete-directory . tramp-fish-handle-delete-directory) - (delete-file . tramp-fish-handle-delete-file) - ;; `diff-latest-backup-file' performed by default handler - (directory-file-name . tramp-handle-directory-file-name) - (directory-files . tramp-handle-directory-files) - (directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes) - ;; `dired-call-process' performed by default handler - ;; `dired-compress-file' performed by default handler - (dired-uncache . tramp-handle-dired-uncache) - (expand-file-name . tramp-fish-handle-expand-file-name) - ;; `file-accessible-directory-p' performed by default handler - (file-attributes . tramp-fish-handle-file-attributes) - (file-directory-p . tramp-fish-handle-file-directory-p) - (file-executable-p . tramp-fish-handle-file-executable-p) - (file-exists-p . tramp-fish-handle-file-exists-p) - (file-local-copy . tramp-fish-handle-file-local-copy) - (file-modes . tramp-handle-file-modes) - (file-name-all-completions . tramp-fish-handle-file-name-all-completions) - (file-name-as-directory . tramp-handle-file-name-as-directory) - (file-name-completion . tramp-handle-file-name-completion) - (file-name-directory . tramp-handle-file-name-directory) - (file-name-nondirectory . tramp-handle-file-name-nondirectory) - ;; `file-name-sans-versions' performed by default handler - (file-newer-than-file-p . tramp-fish-handle-file-newer-than-file-p) - (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-fish-handle-file-readable-p) - (file-regular-p . tramp-handle-file-regular-p) - (file-remote-p . tramp-handle-file-remote-p) - ;; `file-selinux-context' performed by default handler. - (file-symlink-p . tramp-handle-file-symlink-p) - ;; `file-truename' performed by default handler - (file-writable-p . tramp-fish-handle-file-writable-p) - (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler - ;; `get-file-buffer' performed by default handler - (insert-directory . tramp-fish-handle-insert-directory) - (insert-file-contents . tramp-fish-handle-insert-file-contents) - (load . tramp-handle-load) - (make-directory . tramp-fish-handle-make-directory) - (make-directory-internal . tramp-fish-handle-make-directory-internal) - (make-symbolic-link . tramp-fish-handle-make-symbolic-link) - (rename-file . tramp-fish-handle-rename-file) - (set-file-modes . tramp-fish-handle-set-file-modes) - ;; `set-file-selinux-context' performed by default handler. - (set-file-times . tramp-fish-handle-set-file-times) - (set-visited-file-modtime . ignore) - (shell-command . tramp-handle-shell-command) - (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) - (vc-registered . ignore) - (verify-visited-file-modtime . ignore) - (write-region . tramp-fish-handle-write-region) - (executable-find . tramp-fish-handle-executable-find) - (start-file-process . ignore) - (process-file . tramp-fish-handle-process-file) -) - "Alist of handler functions for Tramp FISH method. -Operations not mentioned here will be handled by the default Emacs primitives.") - -(defun tramp-fish-file-name-p (filename) - "Check if it's a filename for FISH protocol." - (let ((v (tramp-dissect-file-name filename))) - (string= (tramp-file-name-method v) tramp-fish-method))) - -(defun tramp-fish-file-name-handler (operation &rest args) - "Invoke the FISH related OPERATION. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." - (let ((fn (assoc operation tramp-fish-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) - -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler)) - - -;; File name primitives - -(defun tramp-fish-handle-add-name-to-file - (filename newname &optional ok-if-already-exists) - "Like `add-name-to-file' for Tramp files." - (unless (tramp-equal-remote filename newname) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-error - v 'file-error - "add-name-to-file: %s" - "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (when (and (not ok-if-already-exists) - (file-exists-p newname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error - v2 'file-error - "add-name-to-file: file %s already exists" newname)) - (tramp-flush-file-property v2 v2-localname) - (unless (tramp-fish-send-command-and-check - v1 (format "#LINK %s %s" v1-localname v2-localname)) - (tramp-error - v1 'file-error "Error with add-name-to-file %s" newname))))) - -(defun tramp-fish-handle-copy-file - (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) - "Like `copy-file' for Tramp files." - (tramp-fish-do-copy-or-rename-file - 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid)) - -(defun tramp-fish-handle-delete-directory (directory &optional recursive) - "Like `delete-directory' for Tramp files." - (when (file-exists-p directory) - (if recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (tramp-compat-delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) - (with-parsed-tramp-file-name - (directory-file-name (expand-file-name directory)) nil - (tramp-flush-directory-property v localname) - (tramp-fish-send-command-and-check v (format "#RMD %s" localname))))) - -(defun tramp-fish-handle-delete-file (filename &optional trash) - "Like `delete-file' for Tramp files." - (when (file-exists-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-flush-file-property v localname) - (tramp-fish-send-command-and-check v (format "#DELE %s" localname))))) - -(defun tramp-fish-handle-directory-files-and-attributes - (directory &optional full match nosort id-format) - "Like `directory-files-and-attributes' for Tramp files." - (mapcar - (lambda (x) - (cons x - (tramp-compat-file-attributes - (if full x (expand-file-name x directory)) - id-format))) - (directory-files directory full match nosort))) - -(defun tramp-fish-handle-expand-file-name (name &optional dir) - "Like `expand-file-name' for Tramp files." - ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". - (setq dir (or dir default-directory "/")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler, - (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name))) - (tramp-drop-volume-letter - (tramp-run-real-handler 'expand-file-name (list name nil))) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) - (setq localname (concat "~/" localname))) - ;; Tilde expansion if necessary. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - ;; We cannot apply "~user/", because this is not supported - ;; by the FISH protocol. - (unless (string-equal uname "~") - (tramp-error - v 'file-error "Tilde expansion not supported for %s" name)) - (setq uname - (with-connection-property v uname - (tramp-fish-send-command-and-check v "#PWD") - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (tramp-compat-line-end-position))))) - (setq localname (concat uname fname)))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; No tilde characters in file name, do normal - ;; expand-file-name (this does "/./" and "/../"). We bind - ;; `directory-sep-char' here for XEmacs on Windows, which - ;; would otherwise use backslash. `default-directory' is - ;; bound, because on Windows there would be problems with UNC - ;; shares or Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - method user host - (tramp-drop-volume-letter - (tramp-run-real-handler - 'expand-file-name (list localname)))))))) - -(defun tramp-fish-handle-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname (format "file-attributes-%s" id-format) - (cdr (car (tramp-fish-get-file-entries v localname nil)))))) - -(defun tramp-fish-handle-file-directory-p (filename) - "Like `file-directory-p' for Tramp files." - (let ((attributes (file-attributes filename))) - (and attributes - (or (string-match "d" (nth 8 attributes)) - (and (file-symlink-p filename) - (with-parsed-tramp-file-name filename nil - (file-directory-p - (tramp-make-tramp-file-name - method user host (nth 0 attributes)))))) - t))) - -(defun tramp-fish-handle-file-exists-p (filename) - "Like `file-exists-p' for Tramp files." - (and (file-attributes filename) t)) - -(defun tramp-fish-handle-file-executable-p (filename) - "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname "file-executable-p" - (when (file-exists-p filename) - (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename)))) - (home-directory - (tramp-make-tramp-file-name - method user host - (tramp-get-connection-property v "home-directory" nil)))) - (or (and (char-equal (aref mode-chars 3) ?x) - (equal (nth 2 (file-attributes filename)) - (nth 2 (file-attributes home-directory)))) - (and (char-equal (aref mode-chars 6) ?x) - (equal (nth 3 (file-attributes filename)) - (nth 3 (file-attributes home-directory)))) - (char-equal (aref mode-chars 9) ?x))))))) - -(defun tramp-fish-handle-file-readable-p (filename) - "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname "file-readable-p" - (when (file-exists-p filename) - (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename)))) - (home-directory - (tramp-make-tramp-file-name - method user host - (tramp-get-connection-property v "home-directory" nil)))) - (or (and (char-equal (aref mode-chars 1) ?r) - (equal (nth 2 (file-attributes filename)) - (nth 2 (file-attributes home-directory)))) - (and (char-equal (aref mode-chars 4) ?r) - (equal (nth 3 (file-attributes filename)) - (nth 3 (file-attributes home-directory)))) - (char-equal (aref mode-chars 7) ?r))))))) - -(defun tramp-fish-handle-file-writable-p (filename) - "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname "file-writable-p" - (if (not (file-exists-p filename)) - ;; If file doesn't exist, check if directory is writable. - (and (file-directory-p (file-name-directory filename)) - (file-writable-p (file-name-directory filename))) - ;; Existing files must be writable. - (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename)))) - (home-directory - (tramp-make-tramp-file-name - method user host - (tramp-get-connection-property v "home-directory" nil)))) - (or (and (char-equal (aref mode-chars 2) ?w) - (equal (nth 2 (file-attributes filename)) - (nth 2 (file-attributes home-directory)))) - (and (char-equal (aref mode-chars 5) ?w) - (equal (nth 3 (file-attributes filename)) - (nth 3 (file-attributes home-directory)))) - (char-equal (aref mode-chars 8) ?w))))))) - -(defun tramp-fish-handle-file-local-copy (filename) - "Like `file-local-copy' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (unless (file-exists-p filename) - (tramp-error - v 'file-error - "Cannot make local copy of non-existing file `%s'" filename)) - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (with-progress-reporter - v 3 (format "Fetching %s to tmp file %s" filename tmpfile) - (when (tramp-fish-retrieve-data v) - ;; Save file - (with-current-buffer (tramp-get-buffer v) - (write-region (point-min) (point-max) tmpfile)) - tmpfile))))) - -;; This function should return "foo/" for directories and "bar" for -;; files. -(defun tramp-fish-handle-file-name-all-completions (filename directory) - "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-file-property v localname "file-name-all-completions" - (save-match-data - (let ((entries - (with-file-property v localname "file-entries" - (tramp-fish-get-file-entries v localname t)))) - (mapcar - (lambda (x) - (list - (if (string-match "d" (nth 9 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - entries))))))) - -(defun tramp-fish-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond - ((not (file-exists-p file1)) nil) - ((not (file-exists-p file2)) t) - (t (tramp-time-less-p (nth 5 (file-attributes file2)) - (nth 5 (file-attributes file1)))))) - -(defun tramp-fish-handle-insert-directory - (filename switches &optional wildcard full-directory-p) - "Like `insert-directory' for Tramp files. -WILDCARD and FULL-DIRECTORY-P are not handled." - (setq filename (expand-file-name filename)) - (when (file-directory-p filename) - ;; This check is a little bit strange, but in `dired-add-entry' - ;; this function is called with a non-directory ... - (setq filename (file-name-as-directory filename))) - - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v localname) - (save-match-data - (let ((entries - (with-file-property v localname "file-entries" - (tramp-fish-get-file-entries v localname t)))) - - ;; Sort entries - (setq entries - (sort - entries - (lambda (x y) - (if (string-match "t" switches) - ;; Sort by date. - (tramp-time-less-p (nth 6 y) (nth 6 x)) - ;; Sort by name. - (string-lessp (nth 0 x) (nth 0 y)))))) - - ;; Print entries. - (mapcar - (lambda (x) - (insert - (format - "%10s %3d %-8s %-8s %8s %s %s%s\n" - (nth 9 x) ; mode - 1 ; hardlinks - (nth 3 x) ; uid - (nth 4 x) ; gid - (nth 8 x) ; size - (format-time-string - (if (tramp-time-less-p - (tramp-time-subtract (current-time) (nth 6 x)) - tramp-half-a-year) - "%b %e %R" - "%b %e %Y") - (nth 6 x)) ; date - (nth 0 x) ; file name - (if (stringp (nth 1 x)) (format " -> %s" (nth 1 x)) ""))) - (forward-line) - (beginning-of-line)) - entries))))) - -(defun tramp-fish-handle-insert-file-contents - (filename &optional visit beg end replace) - "Like `insert-file-contents' for Tramp files." - (barf-if-buffer-read-only) - (when visit - (setq buffer-file-name (expand-file-name filename)) - (set-visited-file-modtime) - (set-buffer-modified-p nil)) - - (with-parsed-tramp-file-name filename nil - (if (not (file-exists-p filename)) - (tramp-error - v 'file-error "File %s not found on remote host" filename) - - (let ((point (point)) - size) - (with-progress-reporter v 3 (format "Fetching file %s" filename) - (when (tramp-fish-retrieve-data v) - ;; Insert file - (insert - (with-current-buffer (tramp-get-buffer v) - (let ((beg (or beg (point-min))) - (end (min (or end (point-max)) (point-max)))) - (setq size (- end beg)) - (buffer-substring beg end)))) - (goto-char point))) - - (list (expand-file-name filename) size))))) - -(defun tramp-fish-handle-make-directory (dir &optional parents) - "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (unless (file-name-absolute-p dir) - (setq dir (expand-file-name dir default-directory))) - (with-parsed-tramp-file-name dir nil - (save-match-data - (let ((ldir (file-name-directory dir))) - ;; Make missing directory parts - (when (and parents (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it - (when (file-directory-p ldir) - (make-directory-internal dir)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) - -(defun tramp-fish-handle-make-directory-internal (directory) - "Like `make-directory-internal' for Tramp files." - (setq directory (directory-file-name (expand-file-name directory))) - (unless (file-name-absolute-p directory) - (setq directory (expand-file-name directory default-directory))) - (when (file-directory-p (file-name-directory directory)) - (with-parsed-tramp-file-name directory nil - (save-match-data - (unless - (tramp-fish-send-command-and-check v (format "#MKD %s" localname)) - (tramp-error - v 'file-error "Couldn't make directory %s" directory)))))) - -(defun tramp-fish-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (with-parsed-tramp-file-name linkname nil - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - localname))))) - (tramp-error - v 'file-already-exists "File %s already exists" localname) - (delete-file linkname))) - - ;; If FILENAME is a Tramp name, use just the localname component. - (when (tramp-tramp-file-p filename) - (setq filename (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name filename))))) - - ;; Right, they are on the same host, regardless of user, method, etc. - ;; We now make the link on the remote machine. This will occur as the user - ;; that FILENAME belongs to. - (unless - (tramp-fish-send-command-and-check - v (format "#SYMLINK %s %s" filename localname)) - (tramp-error v 'file-error "Error creating symbolic link %s" linkname)))) - -(defun tramp-fish-handle-rename-file - (filename newname &optional ok-if-already-exists) - "Like `rename-file' for Tramp files." - (tramp-fish-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t)) - -(defun tramp-fish-handle-set-file-modes (filename mode) - "Like `set-file-modes' for Tramp files." - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v localname) - (unless (tramp-fish-send-command-and-check - v (format "#CHMOD %s %s" - (tramp-decimal-to-octal mode) - (tramp-shell-quote-argument localname))) - (tramp-error - v 'file-error "Error while changing file's mode %s" filename)))) - -(defun tramp-fish-handle-set-file-times (filename &optional time) - "Like `set-file-times' for Tramp files." - (with-parsed-tramp-file-name filename nil - (let ((time (if (or (null time) (equal time '(0 0))) (current-time) time))) - (zerop (process-file - "touch" nil nil nil "-t" - (format-time-string "%Y%m%d%H%M.%S" time) - (tramp-shell-quote-argument localname)))))) - -(defun tramp-fish-handle-write-region - (start end filename &optional append visit lockname confirm) - "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm' - (when (and (not (featurep 'xemacs)) - confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " - filename)) - (tramp-error v 'file-error "File not overwritten"))) - - (tramp-flush-file-property v localname) - - ;; Send command - (let ((tramp-fish-ok-prompt-regexp - (concat - tramp-fish-ok-prompt-regexp "\\|" - tramp-fish-continue-prompt-regexp))) - (tramp-fish-send-command - v (format "%s %d %s\n### 100" - (if append "#APPEND" "#STOR") (- end start) localname))) - - ;; Send data, if there are any. - (when (> end start) - (tramp-fish-send-command v (buffer-substring-no-properties start end))) - - (when (eq visit t) - (set-visited-file-modtime)))) - -(defun tramp-fish-handle-executable-find (command) - "Like `executable-find' for Tramp files." - (with-temp-buffer - (if (zerop (process-file "which" nil t nil command)) - (progn - (goto-char (point-min)) - (buffer-substring (point-min) (tramp-compat-line-end-position)))))) - -(defun tramp-fish-handle-process-file - (program &optional infile destination display &rest args) - "Like `process-file' for Tramp files." - ;; The implementation is not complete yet. - (when (and (numberp destination) (zerop destination)) - (error "Implementation does not handle immediate return")) - - (with-parsed-tramp-file-name default-directory nil - (let (command input tmpinput output tmpoutput stderr tmpstderr - outbuf tmpfile ret) - ;; Compute command. - (setq command (mapconcat 'tramp-shell-quote-argument - (cons program args) " ")) - ;; Determine input. - (if (null infile) - (setq input "/dev/null") - (setq infile (expand-file-name infile)) - (if (tramp-equal-remote default-directory infile) - ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) - ;; INFILE must be copied to remote host. - (setq input (tramp-make-tramp-temp-file v) - tmpinput (tramp-make-tramp-file-name method user host input)) - (copy-file infile tmpinput t))) - (when input (setq command (format "%s <%s" command input))) - - ;; Determine output. - (setq output (tramp-make-tramp-temp-file v) - tmpoutput (tramp-make-tramp-file-name method user host output)) - (cond - ;; Just a buffer - ((bufferp destination) - (setq outbuf destination)) - ;; A buffer name - ((stringp destination) - (setq outbuf (get-buffer-create destination))) - ;; (REAL-DESTINATION ERROR-DESTINATION) - ((consp destination) - ;; output - (cond - ((bufferp (car destination)) - (setq outbuf (car destination))) - ((stringp (car destination)) - (setq outbuf (get-buffer-create (car destination))))) - ;; stderr - (cond - ((stringp (cadr destination)) - (setcar (cdr destination) (expand-file-name (cadr destination))) - (if (tramp-equal-remote default-directory (cadr destination)) - ;; stderr is on the same remote host. - (setq stderr (with-parsed-tramp-file-name - (cadr destination) nil localname)) - ;; stderr must be copied to remote host. The temporary - ;; file must be deleted after execution. - (setq stderr (tramp-make-tramp-temp-file v) - tmpstderr (tramp-make-tramp-file-name - method user host stderr)))) - ;; stderr to be discarded - ((null (cadr destination)) - (setq stderr "/dev/null")))) - ;; 't - (destination - (setq outbuf (current-buffer)))) - (when stderr (setq command (format "%s 2>%s" command stderr))) - - ;; Goto working directory. - (unless - (tramp-fish-send-command-and-check - v (format "#CWD %s" (tramp-shell-quote-argument localname))) - (tramp-error v 'file-error "No such directory: %s" default-directory)) - ;; Send the command. It might not return in time, so we protect it. - (condition-case nil - (unwind-protect - (unless (tramp-fish-send-command-and-check - v (format - "#EXEC %s %s" - (tramp-shell-quote-argument command) output)) - (error nil)) - ;; Check return code. - (setq tmpfile - (file-local-copy - (tramp-make-tramp-file-name method user host output))) - (with-temp-buffer - (insert-file-contents tmpfile) - (goto-char (point-max)) - (forward-line -1) - (looking-at "^###RESULT: \\([0-9]+\\)") - (setq ret (string-to-number (match-string 1))) - (delete-region (point) (point-max)) - (write-region (point-min) (point-max) tmpfile)) - ;; We should show the output anyway. - (when outbuf - (with-current-buffer outbuf (insert-file-contents tmpfile)) - (when display (display-buffer outbuf)))) - ;; When the user did interrupt, we should do it also. - (error (setq ret 1))) - - ;; Provide error file. - (when tmpstderr (rename-file tmpstderr (cadr destination) t)) - ;; Cleanup. - (when tmpinput (delete-file tmpinput)) - (when tmpoutput (delete-file tmpoutput)) - ;; Return exit status. - ret))) - - -;; Internal file name functions - -(defun tramp-fish-do-copy-or-rename-file - (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) - "Copy or rename a remote file. -OP must be `copy' or `rename' and indicates the operation to -perform. FILENAME specifies the file to copy or rename, NEWNAME -is the name of the new file (for copy) or the new name of the -file (for rename). OK-IF-ALREADY-EXISTS means don't barf if -NEWNAME exists already. KEEP-DATE means to make sure that -NEWNAME has the same timestamp as FILENAME. - -This function is invoked by `tramp-fish-handle-copy-file' and -`tramp-fish-handle-rename-file'. It is an error if OP is neither -of `copy' and `rename'. FILENAME and NEWNAME must be absolute -file names." - (unless (memq op '(copy rename)) - (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname))) - - (unless ok-if-already-exists - (when (and t2 (file-exists-p newname)) - (with-parsed-tramp-file-name newname nil - (tramp-error - v 'file-already-exists "File %s already exists" newname)))) - - (prog1 - (cond - ;; Both are Tramp files. - ((and t1 t2) - (cond - ;; Shortcut: if method, host, user are the same for both - ;; files, we invoke `cp' or `mv' on the remote host - ;; directly. - ((tramp-equal-remote filename newname) - (tramp-fish-do-copy-or-rename-file-directly - op filename newname keep-date preserve-uid-gid)) - ;; No shortcut was possible. So we copy the - ;; file first. If the operation was `rename', we go - ;; back and delete the original file (if the copy was - ;; successful). The approach is simple-minded: we - ;; create a new buffer, insert the contents of the - ;; source file into it, then write out the buffer to - ;; the target file. The advantage is that it doesn't - ;; matter which filename handlers are used for the - ;; source and target file. - (t - (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))) - - ;; One file is a Tramp file, the other one is local. - ((or t1 t2) - ;; Use the generic method via a Tramp buffer. - (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)) - - (t - ;; One of them must be a Tramp file. - (error "Tramp implementation says this cannot happen"))) - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-property v localname) - (tramp-flush-file-property v (file-name-directory localname))))))) - -(defun tramp-fish-do-copy-or-rename-file-directly - (op filename newname keep-date preserve-uid-gid) - "Invokes `COPY' or `RENAME' on the remote system. -OP must be one of `copy' or `rename', indicating `cp' or `mv', -respectively. VEC specifies the connection. LOCALNAME1 and -LOCALNAME2 specify the two arguments of `cp' or `mv'. If -KEEP-DATE is non-nil, preserve the time stamp when copying. -PRESERVE-UID-GID is completely ignored." - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (tramp-fish-send-command - v1 - (format "%s %s %s" - (if (eq op 'copy) "#COPY" "#RENAME") - (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname))))) - ;; KEEP-DATE handling. - (when (and keep-date (functionp 'set-file-times)) - (set-file-times newname (nth 5 (file-attributes filename)))) - ;; Set the mode. - (set-file-modes newname (tramp-default-file-modes filename))) - -(defun tramp-fish-get-file-entries (vec localname list) - "Read entries returned by FISH server. -When LIST is true, a #LIST command will be sent, including all entries -of a directory. Otherwise, #STAT is sent for just one entry. -Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME -SIZE MODE WEIRD INODE DEVICE)." - (block nil - (with-current-buffer (tramp-get-buffer vec) - ;; #LIST does not work properly with trailing "/", at least in - ;; .fishsrv.pl. - (when (string-match "/$" localname) - (setq localname (concat localname "."))) - - (let ((command (format "%s %s" (if list "#LIST" "#STAT") localname)) - buffer-read-only num res) - - ;; Send command - (tramp-fish-send-command vec command) - - ;; Read number of entries - (goto-char (point-min)) - (condition-case nil - (unless (integerp (setq num (read (current-buffer)))) (error nil)) - (error (return nil))) - (forward-line) - (delete-region (point-min) (point)) - - ;; Read return code - (goto-char (point-min)) - (condition-case nil - (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil)) - (error (return nil))) - (forward-line) - (delete-region (point-min) (point)) - - ;; Loop the listing - (dotimes (i num) - (let ((item (tramp-fish-read-file-entry))) - ;; Add inode and device. - (add-to-list - 'res (append item - (list (tramp-get-inode vec) - (tramp-get-device vec)))))) - - ;; Read return code - (goto-char (point-min)) - (condition-case nil - (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil)) - (error (tramp-error - vec 'file-error - "`%s' does not return a valid Lisp expression: `%s'" - command (buffer-string)))) - (forward-line) - (delete-region (point-min) (point)) - - res)))) - -(defun tramp-fish-read-file-entry () - "Parse entry in output buffer. -Result is the list (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME -SIZE MODE WEIRD)." - ;; We are called from `tramp-fish-get-file-entries', which sets the - ;; current buffer. - (let (buffer-read-only localname link uid gid mtime size mode) - (block nil - (while t - (cond - ;; P<unix permissions> <owner>.<group> - ((looking-at "^P\\(.+\\)\\s-\\(.+\\)\\.\\(.+\\)$") - (setq mode (match-string 1)) - (setq uid (match-string 2)) - (setq gid (match-string 3)) - (when (string-match "^d" mode) (setq link t))) - ;; S<size> - ((looking-at "^S\\([0-9]+\\)$") - (setq size (string-to-number (match-string 1)))) - ;; D<year> <month> <day> <hour> <minute> <second>[.1234] - ((looking-at - "^D\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\(\\S-+\\)$") - (setq mtime - (encode-time - (string-to-number (match-string 6)) - (string-to-number (match-string 5)) - (string-to-number (match-string 4)) - (string-to-number (match-string 3)) - (string-to-number (match-string 2)) - (string-to-number (match-string 1))))) - ;; d<3-letters month name> <day> <year or HH:MM> - ((looking-at "^d") nil) - ;; E<major-of-device>,<minor> - ((looking-at "^E") nil) - ;; :<filename> - ((looking-at "^:\\(.+\\)$") - (setq localname (match-string 1))) - ;; L<filename symlink points to> - ((looking-at "^L\\(.+\\)$") - (setq link (match-string 1))) - ;; M<mimetype> - ((looking-at "^M\\(.+\\)$") nil) - ;; last line - ((looking-at "^$") - (return))) - ;; Delete line. - (forward-line) - (delete-region (point-min) (point)))) - - ;; Delete trailing empty line. - (forward-line) - (delete-region (point-min) (point)) - - ;; Return entry in `file-attributes' format. - (list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil))) - -(defun tramp-fish-retrieve-data (vec) - "Reads remote data for FISH protocol. -The data are left in the connection buffer of VEC for further processing. -Returns the size of the data." - (block nil - (with-current-buffer (tramp-get-buffer vec) - ;; The retrieved data might be in binary format, without - ;; trailing newline. Therefore, the OK prompt might not start - ;; at the beginning of a line. - (let ((tramp-fish-ok-prompt-regexp "### 200\n") - size) - - ;; Send command - (tramp-fish-send-command - vec (format "#RETR %s" (tramp-file-name-localname vec))) - - ;; Read filesize - (goto-char (point-min)) - (condition-case nil - (unless (integerp (setq size (read (current-buffer)))) (error nil)) - (error (return nil))) - (forward-line) - (delete-region (point-min) (point)) - - ;; Read return code - (goto-char (point-min)) - (condition-case nil - (unless (looking-at tramp-fish-continue-prompt-regexp) (error nil)) - (error (return nil))) - (forward-line) - (delete-region (point-min) (point)) - - ;; The received data might contain the OK prompt already, so - ;; there might be outstanding data. - (while (/= (+ size (length tramp-fish-ok-prompt-regexp)) - (- (point-max) (point-min))) - (tramp-wait-for-regexp - (tramp-get-connection-process vec) nil - (concat tramp-fish-ok-prompt-regexp "$"))) - - ;; Read return code - (goto-char (+ (point-min) size)) - (condition-case nil - (unless (looking-at tramp-fish-ok-prompt-regexp) (error nil)) - (error (return nil))) - (delete-region (+ (point-min) size) (point-max)) - size)))) - - -;; Connection functions - -(defun tramp-fish-maybe-open-connection (vec) - "Maybe open a connection VEC. -Does not do anything if a connection is already open, but re-opens the -connection if a previous connection has died for some reason." - (let ((process-connection-type tramp-process-connection-type) - (p (get-buffer-process (tramp-get-buffer vec)))) - - ;; New connection must be opened. - (unless (and p (processp p) (memq (process-status p) '(run open))) - - ;; Set variables for computing the prompt for reading password. - (setq tramp-current-method (tramp-file-name-method vec) - tramp-current-user (tramp-file-name-user vec) - tramp-current-host (tramp-file-name-host vec)) - - ;; Start new process. - (when (and p (processp p)) - (delete-process p)) - (setenv "TERM" tramp-terminal-type) - (setenv "PS1" tramp-initial-end-of-output) - (with-progress-reporter - vec 3 - (format "Opening connection for %s@%s using %s" - tramp-current-user tramp-current-host tramp-current-method) - - (let* ((process-connection-type tramp-process-connection-type) - (inhibit-eol-conversion nil) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - ;; This must be done in order to avoid our file name handler. - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (start-process - (or (tramp-get-connection-property vec "process-name" nil) - (tramp-buffer-name vec)) - (tramp-get-connection-buffer vec) - "ssh" "-l" - (tramp-file-name-user vec) - (tramp-file-name-host vec))))) - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - - ;; Check whether process is alive. - (tramp-set-process-query-on-exit-flag p nil) - - (tramp-process-actions p vec tramp-actions-before-shell 60) - (tramp-fish-send-command vec tramp-fish-start-fish-server-command) - (tramp-message - vec 3 - "Found remote shell prompt on `%s'" (tramp-file-name-host vec))))))) - -(defun tramp-fish-send-command (vec command) - "Send the COMMAND to connection VEC." - (tramp-fish-maybe-open-connection vec) - (tramp-message vec 6 "%s" command) - (tramp-send-string vec command) - (tramp-wait-for-regexp - (tramp-get-connection-process vec) nil - (concat tramp-fish-ok-prompt-regexp "\\|" tramp-fish-error-prompt-regexp))) - -(defun tramp-fish-send-command-and-check (vec command) - "Send the COMMAND to connection VEC. -Returns nil if there has been an error message." - - ;; Send command. - (tramp-fish-send-command vec command) - - ;; Read return code. - (with-current-buffer (tramp-get-buffer vec) - (goto-char (point-min)) - (looking-at tramp-fish-ok-prompt-regexp))) - -(provide 'tramp-fish) -; -;;;; TODO: -; -;; * Evaluate the MIME information with #LIST or #STAT. -; - -;; arch-tag: a66df7df-5f29-42a7-a921-643ceb29db49 -;;;; tramp-fish.el ends here
--- a/lisp/net/tramp-ftp.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-ftp.el Thu Sep 16 11:11:13 2010 +0900 @@ -30,7 +30,6 @@ ;;; Code: (require 'tramp) -(autoload 'tramp-set-connection-property "tramp-cache") (eval-when-compile @@ -99,13 +98,14 @@ (add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp) ;; Define FTP method ... -(defcustom tramp-ftp-method "ftp" - "*When this method name is used, forward all calls to Ange-FTP." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-ftp-method "ftp" + "*When this method name is used, forward all calls to Ange-FTP.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-ftp-method nil)) +;;;###tramp-autoload +(unless (featurep 'xemacs) + (add-to-list 'tramp-methods (cons tramp-ftp-method nil))) ;; Add some defaults for `tramp-default-method-alist' (add-to-list 'tramp-default-method-alist @@ -129,6 +129,7 @@ (symbol-plist 'substitute-in-file-name)))))) +;;;###tramp-autoload (defun tramp-ftp-file-name-handler (operation &rest args) "Invoke the Ange-FTP handler for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -199,23 +200,26 @@ (inhibit-file-name-operation operation)) (apply 'ange-ftp-hook-function operation args))))))) -(defun tramp-ftp-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-ftp-file-name-p (filename) "Check if it's a filename that should be forwarded to Ange-FTP." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-ftp-method))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) +;;;###tramp-autoload +(unless (featurep 'xemacs) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-ftp 'force))) (provide 'tramp-ftp) ;;; TODO: -;; * In case of "/ftp:host:file" this works only for functions which -;; are defined in `tramp-file-name-handler-alist'. Call has to be -;; pretended in `tramp-file-name-handler' otherwise. -;; Furthermore, there are no backup files on FTP hosts. -;; Worth further investigations. +;; * There are no backup files on FTP hosts. ;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff ;;; tramp-ftp.el ends here
--- a/lisp/net/tramp-gvfs.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-gvfs.el Thu Sep 16 11:11:13 2010 +0900 @@ -103,11 +103,17 @@ (require 'custom)) (require 'tramp) + +;; We call several `tramp-handle-*' functions directly. So we must +;; reqire that package as well. +(require 'tramp-sh) + (require 'dbus) (require 'url-parse) (require 'url-util) (require 'zeroconf) +;;;###tramp-autoload (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce") "*List of methods for remote files, accessed with GVFS." :group 'tramp @@ -133,11 +139,11 @@ ;; Add the methods to `tramp-methods', in order to allow minibuffer ;; completion. -(eval-after-load "tramp-gvfs" - '(when (featurep 'tramp-gvfs) - (dolist (elt tramp-gvfs-methods) - (unless (assoc elt tramp-methods) - (add-to-list 'tramp-methods (cons elt nil)))))) +;;;###tramp-autoload +(when (featurep 'dbusbind) + (dolist (elt tramp-gvfs-methods) + (unless (assoc elt tramp-methods) + (add-to-list 'tramp-methods (cons elt nil))))) (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") "The preceeding object path for own objects.") @@ -145,9 +151,12 @@ (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" "The well known name of the GVFS daemon.") -;; Check that GVFS is available. -(unless (dbus-ping :session tramp-gvfs-service-daemon 100) - (throw 'tramp-loading nil)) +;; Check that GVFS is available. D-Bus integration is available since +;; Emacs 23 on some system types. We don't call `dbus-ping', because +;; this would load dbus.el. +(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session) + (tramp-compat-process-running-p "gvfs-fuse-daemon")) + (error "Package `tramp-gvfs' not supported")) (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" "The object path of the GVFS daemon.") @@ -385,7 +394,7 @@ (expand-file-name . tramp-gvfs-handle-expand-file-name) ;; `file-accessible-directory-p' performed by default handler. (file-attributes . tramp-gvfs-handle-file-attributes) - (file-directory-p . tramp-smb-handle-file-directory-p) + (file-directory-p . tramp-gvfs-handle-file-directory-p) (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-gvfs-handle-file-exists-p) (file-local-copy . tramp-gvfs-handle-file-local-copy) @@ -431,13 +440,15 @@ "Alist of handler functions for Tramp GVFS method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-gvfs-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-gvfs-file-name-p (filename) "Check if it's a filename handled by the GVFS daemon." (and (tramp-tramp-file-p filename) (let ((method (tramp-file-name-method (tramp-dissect-file-name filename)))) (and (stringp method) (member method tramp-gvfs-methods))))) +;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -449,8 +460,10 @@ ;; This might be moved to tramp.el. It shall be the first file name ;; handler. -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)) +;;;###tramp-autoload +(when (featurep 'dbusbind) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus message into readable UTF8 strings, used for traces." @@ -485,7 +498,8 @@ (put 'with-tramp-dbus-call-method 'lisp-indent-function 2) (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) (defmacro with-tramp-gvfs-error-message (filename handler &rest args) "Apply a Tramp GVFS `handler'. @@ -494,7 +508,7 @@ `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename))) elt) (condition-case err - (funcall ,handler ,@args) + (tramp-compat-funcall ,handler ,@args) (error (setq elt (cdr err)) (while elt @@ -506,7 +520,8 @@ (put 'with-tramp-gvfs-error-message 'lisp-indent-function 2) (put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body)) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>")) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>")) (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. @@ -647,6 +662,10 @@ "Like `file-attributes' for Tramp files." (file-attributes (tramp-gvfs-fuse-file-name filename) id-format)) +(defun tramp-gvfs-handle-file-directory-p (filename) + "Like `file-directory-p' for Tramp files." + (file-directory-p (tramp-gvfs-fuse-file-name filename))) + (defun tramp-gvfs-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." (file-executable-p (tramp-gvfs-fuse-file-name filename))) @@ -956,7 +975,7 @@ ;; host signature. (with-temp-buffer ;; Preserve message for `progress-reporter'. - (with-temp-message "" + (tramp-compat-with-temp-message "" (insert message) (pop-to-buffer (current-buffer)) (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) @@ -1403,6 +1422,10 @@ (tramp-set-completion-function "synce" '((tramp-synce-parse-device-names ""))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-gvfs 'force))) + (provide 'tramp-gvfs) ;;; TODO:
--- a/lisp/net/tramp-gw.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-gw.el Thu Sep 16 11:11:13 2010 +0900 @@ -38,11 +38,6 @@ (require 'cl) (require 'custom)) -;; Autoload the socks library. It is used only when we access a SOCKS server. -(autoload 'socks-open-network-stream "socks") -(defvar socks-username (user-login-name)) -(defvar socks-server (list "Default server" "socks" 1080 5)) - ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. (eval-when-compile @@ -50,21 +45,29 @@ (byte-compiler-options (warnings (- unused-vars))))) ;; Define HTTP tunnel method ... -(defvar tramp-gw-tunnel-method "tunnel" +;;;###tramp-autoload +(defconst tramp-gw-tunnel-method "tunnel" "*Method to connect HTTP gateways.") ;; ... and port. -(defvar tramp-gw-default-tunnel-port 8080 +(defconst tramp-gw-default-tunnel-port 8080 "*Default port for HTTP gateways.") ;; Define SOCKS method ... -(defvar tramp-gw-socks-method "socks" +;;;###tramp-autoload +(defconst tramp-gw-socks-method "socks" "*Method to connect SOCKS servers.") ;; ... and port. -(defvar tramp-gw-default-socks-port 1080 +(defconst tramp-gw-default-socks-port 1080 "*Default port for SOCKS servers.") +;; Autoload the socks library. It is used only when we access a SOCKS server. +(autoload 'socks-open-network-stream "socks") +(defvar socks-username (user-login-name)) +(defvar socks-server + (list "Default server" "socks" tramp-gw-default-socks-port 5)) + ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist `(,tramp-gw-tunnel-method nil ,(user-login-name))) @@ -125,6 +128,7 @@ (process-send-string (tramp-get-connection-property proc "process" nil) string))) +;;;###tramp-autoload (defun tramp-gw-open-connection (vec gw-vec target-vec) "Open a remote connection to VEC (see `tramp-file-name' structure). Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a @@ -239,10 +243,9 @@ ;; Trap errors to be traced in the right trace buffer. Often, ;; proxies have a timeout of 60". We wait 65" in order to ;; receive an answer this case. - (condition-case nil - (let (tramp-verbose) - (tramp-wait-for-regexp proc 65 "\r?\n\r?\n")) - (error nil)) + (ignore-errors + (let (tramp-verbose) + (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) ;; Check return code. (goto-char (point-min)) (narrow-to-region @@ -310,6 +313,9 @@ (format "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-gw 'force))) (provide 'tramp-gw)
--- a/lisp/net/tramp-imap.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-imap.el Thu Sep 16 11:11:13 2010 +0900 @@ -55,7 +55,6 @@ (require 'assoc) (require 'tramp) -(require 'tramp-compat) (autoload 'auth-source-user-or-password "auth-source") (autoload 'epg-context-operation "epg") @@ -76,21 +75,29 @@ '(add-to-list 'imap-hash-headers 'X-Size 'append)) ;; Define Tramp IMAP method ... +;;;###tramp-autoload (defconst tramp-imap-method "imap" "*Method to connect via IMAP protocol.") -(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143))) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-methods + (list tramp-imap-method '(tramp-default-port 143)))) ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist `(,tramp-imap-method nil ,(user-login-name))) ;; Define Tramp IMAPS method ... +;;;###tramp-autoload (defconst tramp-imaps-method "imaps" "*Method to connect via secure IMAP protocol.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993))) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-methods + (list tramp-imaps-method '(tramp-default-port 993)))) ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist @@ -184,13 +191,15 @@ (defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never (defvar tramp-imap-passphrase nil) -(defun tramp-imap-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-imap-file-name-p (filename) "Check if it's a filename for IMAP protocol." (let ((v (tramp-dissect-file-name filename))) (or (string= (tramp-file-name-method v) tramp-imap-method) (string= (tramp-file-name-method v) tramp-imaps-method)))) +;;;###tramp-autoload (defun tramp-imap-file-name-handler (operation &rest args) "Invoke the IMAP related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -200,8 +209,10 @@ (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))) (defun tramp-imap-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -776,6 +787,10 @@ tramp-imap-subject-marker (if needed-subject needed-subject ""))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-imap 'force))) + ;;; TODO: ;; * Implement `tramp-imap-handle-delete-directory',
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/tramp-sh.el Thu Sep 16 11:11:13 2010 +0900 @@ -0,0 +1,5509 @@ +;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; (copyright statements below in code to be updated with the above notice) + +;; Author: Kai Großjohann <kai.grossjohann@gmx.net> +;; Michael Albinus <michael.albinus@gmx.de> +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(eval-when-compile (require 'cl)) ; ignore-errors +(require 'tramp) +(require 'shell) + +;; Pacify byte-compiler. The function is needed on XEmacs only. I'm +;; not sure at all that this is the right way to do it, but let's hope +;; it works for now, and wait for a guru to point out the Right Way to +;; achieve this. +;;(eval-when-compile +;; (unless (fboundp 'dired-insert-set-properties) +;; (fset 'dired-insert-set-properties 'ignore))) +;; Gerd suggests this: +(eval-when-compile (require 'dired)) +;; Note that dired is required at run-time, too, when it is needed. +;; It is only needed on XEmacs for the function +;; `dired-insert-set-properties'. + +(defcustom tramp-inline-compress-start-size 4096 + "*The minimum size of compressing where inline transfer. +When inline transfer, compress transfered data of file +whose size is this value or above (up to `tramp-copy-size-limit'). +If it is nil, no compression at all will be applied." + :group 'tramp + :type '(choice (const nil) integer)) + +(defcustom tramp-copy-size-limit 10240 + "*The maximum file size where inline copying is preferred over an out-of-the-band copy. +If it is nil, inline out-of-the-band copy will be used without a check." + :group 'tramp + :type '(choice (const nil) integer)) + +;;;###tramp-autoload +(defcustom tramp-terminal-type "dumb" + "*Value of TERM environment variable for logging in to remote host. +Because Tramp wants to parse the output of the remote shell, it is easily +confused by ANSI color escape sequences and suchlike. Often, shell init +files conditionalize this setup based on the TERM environment variable." + :group 'tramp + :type 'string) + +;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for +;; root users. It uses the `$' character for other users. In order +;; to guarantee a proper prompt, we use "#$" for the prompt. + +(defvar tramp-end-of-output + (format + "///%s#$" + (md5 (concat (prin1-to-string process-environment) (current-time-string)))) + "String used to recognize end of output. +The '$' character at the end is quoted; the string cannot be +detected as prompt when being sent on echoing hosts, therefore.") + +;;;###tramp-autoload +(defconst tramp-initial-end-of-output "#$ " + "Prompt when establishing a connection.") + +;; Initialize `tramp-methods' with the supported methods. +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("rcp" + (tramp-login-program "rsh") + (tramp-login-args (("%h") ("-l" "%u"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "rcp") + (tramp-copy-args (("-p" "%k") ("-r"))) + (tramp-copy-keep-date t) + (tramp-copy-recursive t))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("remcp" + (tramp-login-program "remsh") + (tramp-login-args (("%h") ("-l" "%u"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "rcp") + (tramp-copy-args (("-p" "%k"))) + (tramp-copy-keep-date t))) +;;;###tramp-autoload +(add-to-list + 'tramp-methods + '("scp" (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "scp") + (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-keep-date t) + (tramp-copy-recursive t) + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("scp1" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "scp") + (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-keep-date t) + (tramp-copy-recursive t) + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("scp2" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "scp") + (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-keep-date t) + (tramp-copy-recursive t) + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("scpc" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-o" "ControlPath=%t.%%r@%%h:%%p") + ("-o" "ControlMaster=yes") + ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "scp") + (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") + ("-o" "ControlPath=%t.%%r@%%h:%%p") + ("-o" "ControlMaster=auto"))) + (tramp-copy-keep-date t) + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("scpx" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "scp") + (tramp-copy-args (("-p" "%k"))) + (tramp-copy-keep-date t) + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("sftp" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "sftp"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("rsync" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "rsync") + (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r"))) + (tramp-copy-keep-date t) + (tramp-copy-keep-tmpfile t) + (tramp-copy-recursive t))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + `("rsyncc" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-o" "ControlPath=%t.%%r@%%h:%%p") + ("-o" "ControlMaster=yes") + ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "rsync") + (tramp-copy-args (("-t" "%k") ("-r"))) + (tramp-copy-env (("RSYNC_RSH") + (,(concat + "ssh" + " -o ControlPath=%t.%%r@%%h:%%p" + " -o ControlMaster=auto")))) + (tramp-copy-keep-date t) + (tramp-copy-keep-tmpfile t) + (tramp-copy-recursive t))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("rsh" + (tramp-login-program "rsh") + (tramp-login-args (("%h") ("-l" "%u"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("remsh" + (tramp-login-program "remsh") + (tramp-login-args (("%h") ("-l" "%u"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("ssh" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("ssh1" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("ssh2" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("sshx" + (tramp-login-program "ssh") + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) + (tramp-async-args (("-q"))) + (tramp-remote-sh "/bin/sh") + (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") + ("-o" "UserKnownHostsFile=/dev/null") + ("-o" "StrictHostKeyChecking=no"))) + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("telnet" + (tramp-login-program "telnet") + (tramp-login-args (("%h") ("%p"))) + (tramp-remote-sh "/bin/sh") + (tramp-default-port 23))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("su" + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("sudo" + (tramp-login-program "sudo") + (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("krlogin" + (tramp-login-program "krlogin") + (tramp-login-args (("%h") ("-l" "%u") ("-x"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("plink" + (tramp-login-program "plink") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + (tramp-remote-sh "/bin/sh") + (tramp-password-end-of-line "xy") ;see docstring for "xy" + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("plink1" + (tramp-login-program "plink") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h"))) + (tramp-remote-sh "/bin/sh") + (tramp-password-end-of-line "xy") ;see docstring for "xy" + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + `("plinkx" + (tramp-login-program "plink") + ;; ("%h") must be a single element, see + ;; `tramp-compute-multi-hops'. + (tramp-login-args (("-load") ("%h") ("-t") + (,(format + "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" + tramp-terminal-type + tramp-initial-end-of-output)) + ("/bin/sh"))) + (tramp-remote-sh "/bin/sh"))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("pscp" + (tramp-login-program "plink") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "pscp") + (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k"))) + (tramp-copy-keep-date t) + (tramp-password-end-of-line "xy") ;see docstring for "xy" + (tramp-default-port 22))) +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("psftp" + (tramp-login-program "plink") + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + (tramp-remote-sh "/bin/sh") + (tramp-copy-program "pscp") + (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k"))) + (tramp-copy-keep-date t) + (tramp-password-end-of-line "xy"))) ;see docstring for "xy" +;;;###tramp-autoload +(add-to-list 'tramp-methods + '("fcp" + (tramp-login-program "fsh") + (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) + (tramp-remote-sh "/bin/sh -i") + (tramp-copy-program "fcp") + (tramp-copy-args (("-p" "%k"))) + (tramp-copy-keep-date t))) + +(add-to-list 'tramp-default-method-alist + `(,tramp-local-host-regexp "\\`root\\'" "su")) + +(add-to-list 'tramp-default-user-alist + '("\\`su\\(do\\)?\\'" nil "root")) +(add-to-list 'tramp-default-user-alist + `("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'" + nil ,(user-login-name))) + +(defconst tramp-completion-function-alist-rsh + '((tramp-parse-rhosts "/etc/hosts.equiv") + (tramp-parse-rhosts "~/.rhosts")) + "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.") + +(defconst tramp-completion-function-alist-ssh + '((tramp-parse-rhosts "/etc/hosts.equiv") + (tramp-parse-rhosts "/etc/shosts.equiv") + (tramp-parse-shosts "/etc/ssh_known_hosts") + (tramp-parse-sconfig "/etc/ssh_config") + (tramp-parse-shostkeys "/etc/ssh2/hostkeys") + (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") + (tramp-parse-rhosts "~/.rhosts") + (tramp-parse-rhosts "~/.shosts") + (tramp-parse-shosts "~/.ssh/known_hosts") + (tramp-parse-sconfig "~/.ssh/config") + (tramp-parse-shostkeys "~/.ssh2/hostkeys") + (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) + "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") + +(defconst tramp-completion-function-alist-telnet + '((tramp-parse-hosts "/etc/hosts")) + "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.") + +(defconst tramp-completion-function-alist-su + '((tramp-parse-passwd "/etc/passwd")) + "Default list of (FUNCTION FILE) pairs to be examined for su methods.") + +(defconst tramp-completion-function-alist-putty + '((tramp-parse-putty + "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions")) + "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.") + +(tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh) +(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) +(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "rsyncc" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) +(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) +(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "ssh1_old" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "ssh2_old" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet) +(tramp-set-completion-function "su" tramp-completion-function-alist-su) +(tramp-set-completion-function "sudo" tramp-completion-function-alist-su) +(tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) +(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "plink1" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty) +(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) +(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh) + +;; "getconf PATH" yields: +;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin +;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin +;; GNU/Linux (Debian, Suse): /bin:/usr/bin +;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; IRIX64: /usr/bin +(defcustom tramp-remote-path + '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin" + "/local/bin" "/local/freeware/bin" "/local/gnu/bin" + "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin") + "*List of directories to search for executables on remote host. +For every remote host, this variable will be set buffer local, +keeping the list of existing directories on that host. + +You can use `~' in this list, but when searching for a shell which groks +tilde expansion, all directory names starting with `~' will be ignored. + +`Default Directories' represent the list of directories given by +the command \"getconf PATH\". It is recommended to use this +entry on top of this list, because these are the default +directories for POSIX compatible commands. + +`Private Directories' are the settings of the $PATH environment, +as given in your `~/.profile'." + :group 'tramp + :type '(repeat (choice + (const :tag "Default Directories" tramp-default-remote-path) + (const :tag "Private Directories" tramp-own-remote-path) + (string :tag "Directory")))) + +(defcustom tramp-remote-process-environment + `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" + ,(format "TERM=%s" tramp-terminal-type) + "EMACS=t" ;; Deprecated. + ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) + "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" + "autocorrect=" "correct=") + + "*List of environment variables to be set on the remote host. + +Each element should be a string of the form ENVVARNAME=VALUE. An +entry ENVVARNAME= diables the corresponding environment variable, +which might have been set in the init files like ~/.profile. + +Special handling is applied to the PATH environment, which should +not be set here. Instead of, it should be set via `tramp-remote-path'." + :group 'tramp + :type '(repeat string)) + +(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) + "*Alist specifying extra arguments to pass to the remote shell. +Entries are (REGEXP . ARGS) where REGEXP is a regular expression +matching the shell file name and ARGS is a string specifying the +arguments. + +This variable is only used when Tramp needs to start up another shell +for tilde expansion. The extra arguments should typically prevent the +shell from reading its init file." + :group 'tramp + ;; This might be the wrong way to test whether the widget type + ;; `alist' is available. Who knows the right way to test it? + :type (if (get 'alist 'widget-type) + '(alist :key-type string :value-type string) + '(repeat (cons string string)))) + +(defconst tramp-actions-before-shell + '((tramp-login-prompt-regexp tramp-action-login) + (tramp-password-prompt-regexp tramp-action-password) + (tramp-wrong-passwd-regexp tramp-action-permission-denied) + (shell-prompt-pattern tramp-action-succeed) + (tramp-shell-prompt-pattern tramp-action-succeed) + (tramp-yesno-prompt-regexp tramp-action-yesno) + (tramp-yn-prompt-regexp tramp-action-yn) + (tramp-terminal-prompt-regexp tramp-action-terminal) + (tramp-process-alive-regexp tramp-action-process-alive)) + "List of pattern/action pairs. +Whenever a pattern matches, the corresponding action is performed. +Each item looks like (PATTERN ACTION). + +The PATTERN should be a symbol, a variable. The value of this +variable gives the regular expression to search for. Note that the +regexp must match at the end of the buffer, \"\\'\" is implicitly +appended to it. + +The ACTION should also be a symbol, but a function. When the +corresponding PATTERN matches, the ACTION function is called.") + +(defconst tramp-actions-copy-out-of-band + '((tramp-password-prompt-regexp tramp-action-password) + (tramp-wrong-passwd-regexp tramp-action-permission-denied) + (tramp-copy-failed-regexp tramp-action-permission-denied) + (tramp-process-alive-regexp tramp-action-out-of-band)) + "List of pattern/action pairs. +This list is used for copying/renaming with out-of-band methods. + +See `tramp-actions-before-shell' for more info.") + +(defconst tramp-uudecode + "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode +cat /tmp/tramp.$$ +rm -f /tmp/tramp.$$" + "Shell function to implement `uudecode' to standard output. +Many systems support `uudecode -o /dev/stdout' or `uudecode -o -' +for this or `uudecode -p', but some systems don't, and for them +we have this shell function.") + +(defconst tramp-perl-file-truename + "%s -e ' +use File::Spec; +use Cwd \"realpath\"; + +sub recursive { + my ($volume, @dirs) = @_; + my $real = realpath(File::Spec->catpath( + $volume, File::Spec->catdir(@dirs), \"\")); + if ($real) { + my ($vol, $dir) = File::Spec->splitpath($real, 1); + return ($vol, File::Spec->splitdir($dir)); + } + else { + my $last = pop(@dirs); + ($volume, @dirs) = recursive($volume, @dirs); + push(@dirs, $last); + return ($volume, @dirs); + } +} + +$result = realpath($ARGV[0]); +if (!$result) { + my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1); + ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir)); + + $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\"); +} + +if ($ARGV[0] =~ /\\/$/) { + $result = $result . \"/\"; +} + +print \"\\\"$result\\\"\\n\"; +' \"$1\" 2>/dev/null" + "Perl script to produce output suitable for use with `file-truename' +on the remote file system. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-perl-file-name-all-completions + "%s -e 'sub case { + my $str = shift; + if ($ARGV[2]) { + return lc($str); + } + else { + return $str; + } +} +opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); +@files = readdir(d); closedir(d); +foreach $f (@files) { + if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { + if (-d \"$ARGV[0]/$f\") { + print \"$f/\\n\"; + } + else { + print \"$f\\n\"; + } + } +} +print \"ok\\n\" +' \"$1\" \"$2\" \"$3\" 2>/dev/null" + "Perl script to produce output suitable for use with +`file-name-all-completions' on the remote file system. Escape +sequence %s is replaced with name of Perl binary. This string is +passed to `format', so percent characters need to be doubled.") + +;; Perl script to implement `file-attributes' in a Lisp `read'able +;; output. If you are hacking on this, note that you get *no* output +;; unless this spits out a complete line, including the '\n' at the +;; end. +;; The device number is returned as "-1", because there will be a virtual +;; device number set in `tramp-handle-file-attributes'. +(defconst tramp-perl-file-attributes + "%s -e ' +@stat = lstat($ARGV[0]); +if (!@stat) { + print \"nil\\n\"; + exit 0; +} +if (($stat[2] & 0170000) == 0120000) +{ + $type = readlink($ARGV[0]); + $type = \"\\\"$type\\\"\"; +} +elsif (($stat[2] & 0170000) == 040000) +{ + $type = \"t\"; +} +else +{ + $type = \"nil\" +}; +$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; +$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; +printf( + \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\", + $type, + $stat[3], + $uid, + $gid, + $stat[8] >> 16 & 0xffff, + $stat[8] & 0xffff, + $stat[9] >> 16 & 0xffff, + $stat[9] & 0xffff, + $stat[10] >> 16 & 0xffff, + $stat[10] & 0xffff, + $stat[7], + $stat[2], + $stat[1] >> 16 & 0xffff, + $stat[1] & 0xffff +);' \"$1\" \"$2\" 2>/dev/null" + "Perl script to produce output suitable for use with `file-attributes' +on the remote file system. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-perl-directory-files-and-attributes + "%s -e ' +chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit(); +opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit(); +@list = readdir(DIR); +closedir(DIR); +$n = scalar(@list); +printf(\"(\\n\"); +for($i = 0; $i < $n; $i++) +{ + $filename = $list[$i]; + @stat = lstat($filename); + if (($stat[2] & 0170000) == 0120000) + { + $type = readlink($filename); + $type = \"\\\"$type\\\"\"; + } + elsif (($stat[2] & 0170000) == 040000) + { + $type = \"t\"; + } + else + { + $type = \"nil\" + }; + $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; + $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; + printf( + \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\", + $filename, + $type, + $stat[3], + $uid, + $gid, + $stat[8] >> 16 & 0xffff, + $stat[8] & 0xffff, + $stat[9] >> 16 & 0xffff, + $stat[9] & 0xffff, + $stat[10] >> 16 & 0xffff, + $stat[10] & 0xffff, + $stat[7], + $stat[2], + $stat[1] >> 16 & 0xffff, + $stat[1] & 0xffff, + $stat[0] >> 16 & 0xffff, + $stat[0] & 0xffff); +} +printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null" + "Perl script implementing `directory-files-attributes' as Lisp `read'able +output. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled.") + +;; These two use base64 encoding. +(defconst tramp-perl-encode-with-module + "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null" + "Perl program to use for encoding a file. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled. +This implementation requires the MIME::Base64 Perl module to be installed +on the remote host.") + +(defconst tramp-perl-decode-with-module + "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null" + "Perl program to use for decoding a file. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled. +This implementation requires the MIME::Base64 Perl module to be installed +on the remote host.") + +(defconst tramp-perl-encode + "%s -e ' +# This script contributed by Juanma Barranquero <lektu@terra.es>. +# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +# Free Software Foundation, Inc. +use strict; + +my %%trans = do { + my $i = 0; + map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)} + split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/); +}; + +binmode(\\*STDIN); + +# We read in chunks of 54 bytes, to generate output lines +# of 72 chars (plus end of line) +$/ = \\54; + +while (my $data = <STDIN>) { + my $pad = q(); + + # Only for the last chunk, and only if did not fill the last three-byte packet + if (eof) { + my $mod = length($data) %% 3; + $pad = q(=) x (3 - $mod) if $mod; + } + + # Not the fastest method, but it is simple: unpack to binary string, split + # by groups of 6 bits and convert back from binary to byte; then map into + # the translation table + print + join q(), + map($trans{$_}, + (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), + $pad, + qq(\\n); +}' 2>/dev/null" + "Perl program to use for encoding a file. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-perl-decode + "%s -e ' +# This script contributed by Juanma Barranquero <lektu@terra.es>. +# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +# Free Software Foundation, Inc. +use strict; + +my %%trans = do { + my $i = 0; + map {($_, substr(unpack(q(B8), chr $i++), 2, 6))} + split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/) +}; + +my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255; + +binmode(\\*STDOUT); + +# We are going to accumulate into $pending to accept any line length +# (we do not check they are <= 76 chars as the RFC says) +my $pending = q(); + +while (my $data = <STDIN>) { + chomp $data; + + # If we find one or two =, we have reached the end and + # any following data is to be discarded + my $finished = $data =~ s/(==?).*/$1/; + $pending .= $data; + + my $len = length($pending); + my $chunk = substr($pending, 0, $len & ~3); + $pending = substr($pending, $len & ~3 + 1); + + # Easy method: translate from chars to (pregenerated) six-bit packets, join, + # split in 8-bit chunks and convert back to char. + print join q(), + map $bytes{$_}, + ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); + + last if $finished; +}' 2>/dev/null" + "Perl program to use for decoding a file. +Escape sequence %s is replaced with name of Perl binary. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-vc-registered-read-file-names + "echo \"(\" +while read file; do + if %s \"$file\"; then + echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\" + else + echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\" + fi + if %s \"$file\"; then + echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\" + else + echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\" + fi +done +echo \")\"" + "Script to check existence of VC related files. +It must be send formatted with two strings; the tests for file +existence, and file readability. Input shall be read via +here-document, otherwise the command could exceed maximum length +of command line.") + +(defconst tramp-file-mode-type-map + '((0 . "-") ; Normal file (SVID-v2 and XPG2) + (1 . "p") ; fifo + (2 . "c") ; character device + (3 . "m") ; multiplexed character device (v7) + (4 . "d") ; directory + (5 . "?") ; Named special file (XENIX) + (6 . "b") ; block device + (7 . "?") ; multiplexed block device (v7) + (8 . "-") ; regular file + (9 . "n") ; network special file (HP-UX) + (10 . "l") ; symlink + (11 . "?") ; ACL shadow inode (Solaris, not userspace) + (12 . "s") ; socket + (13 . "D") ; door special (Solaris) + (14 . "w")) ; whiteout (BSD) + "A list of file types returned from the `stat' system call. +This is used to map a mode number to a permission string.") + +;; New handlers should be added here. The following operations can be +;; handled using the normal primitives: file-name-sans-versions, +;; get-file-buffer. +(defconst tramp-sh-file-name-handler-alist + '((load . tramp-handle-load) + (make-symbolic-link . tramp-handle-make-symbolic-link) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) + (file-truename . tramp-handle-file-truename) + (file-exists-p . tramp-handle-file-exists-p) + (file-directory-p . tramp-handle-file-directory-p) + (file-executable-p . tramp-handle-file-executable-p) + (file-readable-p . tramp-handle-file-readable-p) + (file-regular-p . tramp-handle-file-regular-p) + (file-symlink-p . tramp-handle-file-symlink-p) + (file-writable-p . tramp-handle-file-writable-p) + (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-attributes . tramp-handle-file-attributes) + (file-modes . tramp-handle-file-modes) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) + (file-name-all-completions . tramp-handle-file-name-all-completions) + (file-name-completion . tramp-handle-file-name-completion) + (add-name-to-file . tramp-handle-add-name-to-file) + (copy-file . tramp-handle-copy-file) + (copy-directory . tramp-handle-copy-directory) + (rename-file . tramp-handle-rename-file) + (set-file-modes . tramp-handle-set-file-modes) + (set-file-times . tramp-handle-set-file-times) + (make-directory . tramp-handle-make-directory) + (delete-directory . tramp-handle-delete-directory) + (delete-file . tramp-handle-delete-file) + (directory-file-name . tramp-handle-directory-file-name) + ;; `executable-find' is not official yet. + (executable-find . tramp-handle-executable-find) + (start-file-process . tramp-handle-start-file-process) + (process-file . tramp-handle-process-file) + (shell-command . tramp-handle-shell-command) + (insert-directory . tramp-handle-insert-directory) + (expand-file-name . tramp-handle-expand-file-name) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (file-local-copy . tramp-handle-file-local-copy) + (file-remote-p . tramp-handle-file-remote-p) + (insert-file-contents . tramp-handle-insert-file-contents) + (insert-file-contents-literally + . tramp-handle-insert-file-contents-literally) + (write-region . tramp-handle-write-region) + (find-backup-file-name . tramp-handle-find-backup-file-name) + (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) + (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (dired-compress-file . tramp-handle-dired-compress-file) + (dired-recursive-delete-directory + . tramp-handle-dired-recursive-delete-directory) + (dired-uncache . tramp-handle-dired-uncache) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (file-selinux-context . tramp-handle-file-selinux-context) + (set-file-selinux-context . tramp-handle-set-file-selinux-context) + (vc-registered . tramp-handle-vc-registered)) + "Alist of handler functions. +Operations not mentioned here will be handled by the normal Emacs functions.") + +;; This must be the last entry, because `identity' always matches. +;;;###tramp-autoload +(add-to-list 'tramp-foreign-file-name-handler-alist + '(identity . tramp-sh-file-name-handler) 'append) + +;;; File Name Handler Functions: + +(defun tramp-handle-make-symbolic-link + (filename linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files. +If LINKNAME is a non-Tramp file, it is used verbatim as the target of +the symlink. If LINKNAME is a Tramp file, only the localname component is +used as the target of the symlink. + +If LINKNAME is a Tramp file and the localname component is relative, then +it is expanded first, before the localname component is taken. Note that +this can give surprising results if the user/host for the source and +target of the symlink differ." + (with-parsed-tramp-file-name linkname l + (let ((ln (tramp-get-remote-ln l)) + (cwd (tramp-run-real-handler + 'file-name-directory (list l-localname)))) + (unless ln + (tramp-error + l 'file-error + "Making a symbolic link. ln(1) does not exist on the remote host.")) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + l-localname))))) + (tramp-error + l 'file-already-exists "File %s already exists" l-localname) + (delete-file linkname))) + + ;; If FILENAME is a Tramp name, use just the localname component. + (when (tramp-tramp-file-p filename) + (setq filename + (tramp-file-name-localname + (tramp-dissect-file-name (expand-file-name filename))))) + + (tramp-flush-file-property l (file-name-directory l-localname)) + (tramp-flush-file-property l l-localname) + + ;; Right, they are on the same host, regardless of user, method, etc. + ;; We now make the link on the remote machine. This will occur as the user + ;; that FILENAME belongs to. + (tramp-send-command-and-check + l + (format + "cd %s && %s -sf %s %s" + (tramp-shell-quote-argument cwd) + ln + (tramp-shell-quote-argument filename) + (tramp-shell-quote-argument l-localname)) + t)))) + +(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) + "Like `load' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name file) nil + (unless nosuffix + (cond ((file-exists-p (concat file ".elc")) + (setq file (concat file ".elc"))) + ((file-exists-p (concat file ".el")) + (setq file (concat file ".el"))))) + (when must-suffix + ;; The first condition is always true for absolute file names. + ;; Included for safety's sake. + (unless (or (file-name-directory file) + (string-match "\\.elc?\\'" file)) + (tramp-error + v 'file-error + "File `%s' does not include a `.el' or `.elc' suffix" file))) + (unless noerror + (when (not (file-exists-p file)) + (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file))) + (if (not (file-exists-p file)) + nil + (let ((tramp-message-show-message (not nomessage))) + (with-progress-reporter v 0 (format "Loading %s" file) + (let ((local-copy (file-local-copy file))) + ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. + (unwind-protect + (load local-copy noerror t t) + (delete-file local-copy))))) + t))) + +;; Localname manipulation functions that grok Tramp localnames... +(defun tramp-handle-file-name-as-directory (file) + "Like `file-name-as-directory' but aware of Tramp files." + ;; `file-name-as-directory' would be sufficient except localname is + ;; the empty string. + (let ((v (tramp-dissect-file-name file t))) + ;; Run the command on the localname portion only. + (tramp-make-tramp-file-name + (tramp-file-name-method v) + (tramp-file-name-user v) + (tramp-file-name-host v) + (tramp-run-real-handler + 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))))) + +(defun tramp-handle-file-name-directory (file) + "Like `file-name-directory' but aware of Tramp files." + ;; Everything except the last filename thing is the directory. We + ;; cannot apply `with-parsed-tramp-file-name', because this expands + ;; the remote file name parts. This is a problem when we are in + ;; file name completion. + (let ((v (tramp-dissect-file-name file t))) + ;; Run the command on the localname portion only. + (tramp-make-tramp-file-name + (tramp-file-name-method v) + (tramp-file-name-user v) + (tramp-file-name-host v) + (tramp-run-real-handler + 'file-name-directory (list (or (tramp-file-name-localname v) "")))))) + +(defun tramp-handle-file-name-nondirectory (file) + "Like `file-name-nondirectory' but aware of Tramp files." + (with-parsed-tramp-file-name file nil + (tramp-run-real-handler 'file-name-nondirectory (list localname)))) + +(defun tramp-handle-file-truename (filename &optional counter prev-dirs) + "Like `file-truename' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-file-property v localname "file-truename" + (let ((result nil)) ; result steps in reverse order + (tramp-message v 4 "Finding true name for `%s'" filename) + (cond + ;; Use GNU readlink --canonicalize-missing where available. + ((tramp-get-remote-readlink v) + (setq result + (tramp-send-command-and-read + v + (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\"" + (tramp-get-remote-readlink v) + (tramp-shell-quote-argument localname))))) + + ;; Use Perl implementation. + ((and (tramp-get-remote-perl v) + (tramp-get-connection-property v "perl-file-spec" nil) + (tramp-get-connection-property v "perl-cwd-realpath" nil)) + (tramp-maybe-send-script + v tramp-perl-file-truename "tramp_perl_file_truename") + (setq result + (tramp-send-command-and-read + v + (format "tramp_perl_file_truename %s" + (tramp-shell-quote-argument localname))))) + + ;; Do it yourself. We bind `directory-sep-char' here for + ;; XEmacs on Windows, which would otherwise use backslash. + (t (let* ((directory-sep-char ?/) + (steps (tramp-compat-split-string localname "/")) + (localnamedir (tramp-run-real-handler + 'file-name-as-directory (list localname))) + (is-dir (string= localname localnamedir)) + (thisstep nil) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; + ;; otherwise they might think that Emacs is hung. + ;; Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) + (while (and steps (< numchase numchase-limit)) + (setq thisstep (pop steps)) + (tramp-message + v 5 "Check %s" + (mapconcat 'identity + (append '("") (reverse result) (list thisstep)) + "/")) + (setq symlink-target + (nth 0 (file-attributes + (tramp-make-tramp-file-name + method user host + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) + (cond ((string= "." thisstep) + (tramp-message v 5 "Ignoring step `.'")) + ((string= ".." thisstep) + (tramp-message v 5 "Processing step `..'") + (pop result)) + ((stringp symlink-target) + ;; It's a symlink, follow it. + (tramp-message v 5 "Follow symlink to %s" symlink-target) + (setq numchase (1+ numchase)) + (when (file-name-absolute-p symlink-target) + (setq result nil)) + ;; If the symlink was absolute, we'll get a string like + ;; "/user@host:/some/target"; extract the + ;; "/some/target" part from it. + (when (tramp-tramp-file-p symlink-target) + (unless (tramp-equal-remote filename symlink-target) + (tramp-error + v 'file-error + "Symlink target `%s' on wrong host" symlink-target)) + (setq symlink-target localname)) + (setq steps + (append (tramp-compat-split-string + symlink-target "/") + steps))) + (t + ;; It's a file. + (setq result (cons thisstep result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit)) + (setq result (reverse result)) + ;; Combine list to form string. + (setq result + (if result + (mapconcat 'identity (cons "" result) "/") + "/")) + (when (and is-dir (or (string= "" result) + (not (string= (substring result -1) "/")))) + (setq result (concat result "/")))))) + + (tramp-message v 4 "True name of `%s' is `%s'" filename result) + (tramp-make-tramp-file-name method user host result))))) + +;; Basic functions. + +(defun tramp-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-exists-p" + (or (not (null (tramp-get-file-property + v localname "file-attributes-integer" nil))) + (not (null (tramp-get-file-property + v localname "file-attributes-string" nil))) + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname))))))) + +;; CCC: This should check for an error condition and signal failure +;; when something goes wrong. +;; Daniel Pittman <daniel@danann.net> +(defun tramp-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (unless id-format (setq id-format 'integer)) + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used)) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-file-property v localname (format "file-attributes-%s" id-format) + (save-excursion + (tramp-convert-file-attributes + v + (cond + ((tramp-get-remote-stat v) + (tramp-do-file-attributes-with-stat v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-file-attributes-with-perl v localname id-format)) + (t + (tramp-do-file-attributes-with-ls v localname id-format))))))))) + +(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) + "Implement `file-attributes' for Tramp files using the ls(1) command." + (let (symlinkp dirp + res-inode res-filemodes res-numlinks + res-uid res-gid res-size res-symlink-target) + (tramp-message vec 5 "file attributes with ls: %s" localname) + (tramp-send-command + vec + (format "(%s %s || %s -h %s) && %s %s %s" + (tramp-get-file-exists-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-test-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-ls-command vec) + (if (eq id-format 'integer) "-ildn" "-ild") + (tramp-shell-quote-argument localname))) + ;; parse `ls -l' output ... + (with-current-buffer (tramp-get-buffer vec) + (when (> (buffer-size) 0) + (goto-char (point-min)) + ;; ... inode + (setq res-inode + (condition-case err + (read (current-buffer)) + (invalid-read-syntax + (when (and (equal (cadr err) + "Integer constant overflow in reader") + (string-match + "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" + (car (cddr err)))) + (let* ((big (read (substring (car (cddr err)) 0 + (match-beginning 1)))) + (small (read (match-string 1 (car (cddr err))))) + (twiddle (/ small 65536))) + (cons (+ big twiddle) + (- small (* twiddle 65536)))))))) + ;; ... file mode flags + (setq res-filemodes (symbol-name (read (current-buffer)))) + ;; ... number links + (setq res-numlinks (read (current-buffer))) + ;; ... uid and gid + (setq res-uid (read (current-buffer))) + (setq res-gid (read (current-buffer))) + (if (eq id-format 'integer) + (progn + (unless (numberp res-uid) (setq res-uid -1)) + (unless (numberp res-gid) (setq res-gid -1))) + (progn + (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) + (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) + ;; ... size + (setq res-size (read (current-buffer))) + ;; From the file modes, figure out other stuff. + (setq symlinkp (eq ?l (aref res-filemodes 0))) + (setq dirp (eq ?d (aref res-filemodes 0))) + ;; if symlink, find out file name pointed to + (when symlinkp + (search-forward "-> ") + (setq res-symlink-target + (buffer-substring (point) (tramp-compat-line-end-position)))) + ;; return data gathered + (list + ;; 0. t for directory, string (name linked to) for symbolic + ;; link, or nil. + (or dirp res-symlink-target) + ;; 1. Number of links to file. + res-numlinks + ;; 2. File uid. + res-uid + ;; 3. File gid. + res-gid + ;; 4. Last access time, as a list of two integers. First + ;; integer has high-order 16 bits of time, second has low 16 + ;; bits. + ;; 5. Last modification time, likewise. + ;; 6. Last status change time, likewise. + '(0 0) '(0 0) '(0 0) ;CCC how to find out? + ;; 7. Size in bytes (-1, if number is out of range). + res-size + ;; 8. File modes, as a string of ten letters or dashes as in ls -l. + res-filemodes + ;; 9. t if file's gid would change if file were deleted and + ;; recreated. Will be set in `tramp-convert-file-attributes' + t + ;; 10. inode number. + res-inode + ;; 11. Device number. Will be replaced by a virtual device number. + -1 + ))))) + +(defun tramp-do-file-attributes-with-perl + (vec localname &optional id-format) + "Implement `file-attributes' for Tramp files using a Perl script." + (tramp-message vec 5 "file attributes with perl: %s" localname) + (tramp-maybe-send-script + vec tramp-perl-file-attributes "tramp_perl_file_attributes") + (tramp-send-command-and-read + vec + (format "tramp_perl_file_attributes %s %s" + (tramp-shell-quote-argument localname) id-format))) + +(defun tramp-do-file-attributes-with-stat + (vec localname &optional id-format) + "Implement `file-attributes' for Tramp files using stat(1) command." + (tramp-message vec 5 "file attributes with stat: %s" localname) + (tramp-send-command-and-read + vec + (format + ;; On Opsware, pdksh (which is the true name of ksh there) doesn't + ;; parse correctly the sequence "((". Therefore, we add a space. + "( (%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)" + (tramp-get-file-exists-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-test-command vec) + (tramp-shell-quote-argument localname) + (tramp-get-remote-stat vec) + (if (eq id-format 'integer) "%u" "\"%U\"") + (if (eq id-format 'integer) "%g" "\"%G\"") + (tramp-shell-quote-argument localname)))) + +(defun tramp-handle-set-visited-file-modtime (&optional time-list) + "Like `set-visited-file-modtime' for Tramp files." + (unless (buffer-file-name) + (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" + (buffer-name))) + (if time-list + (tramp-run-real-handler 'set-visited-file-modtime (list time-list)) + (let ((f (buffer-file-name)) + coding-system-used) + (with-parsed-tramp-file-name f nil + (let* ((attr (file-attributes f)) + ;; '(-1 65535) means file doesn't exists yet. + (modtime (or (nth 5 attr) '(-1 65535)))) + (when (boundp 'last-coding-system-used) + (setq coding-system-used (symbol-value 'last-coding-system-used))) + ;; We use '(0 0) as a don't-know value. See also + ;; `tramp-do-file-attributes-with-ls'. + (if (not (equal modtime '(0 0))) + (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) + (progn + (tramp-send-command + v + (format "%s -ild %s" + (tramp-get-ls-command v) + (tramp-shell-quote-argument localname))) + (setq attr (buffer-substring (point) + (progn (end-of-line) (point))))) + (tramp-set-file-property + v localname "visited-file-modtime-ild" attr)) + (when (boundp 'last-coding-system-used) + (set 'last-coding-system-used coding-system-used)) + nil))))) + +;; This function makes the same assumption as +;; `tramp-handle-set-visited-file-modtime'. +(defun tramp-handle-verify-visited-file-modtime (buf) + "Like `verify-visited-file-modtime' for Tramp files. +At the time `verify-visited-file-modtime' calls this function, we +already know that the buffer is visiting a file and that +`visited-file-modtime' does not return 0. Do not call this +function directly, unless those two cases are already taken care +of." + (with-current-buffer buf + (let ((f (buffer-file-name))) + ;; There is no file visiting the buffer, or the buffer has no + ;; recorded last modification time, or there is no established + ;; connection. + (if (or (not f) + (eq (visited-file-modtime) 0) + (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + t + (with-parsed-tramp-file-name f nil + (tramp-flush-file-property v localname) + (let* ((attr (file-attributes f)) + (modtime (nth 5 attr)) + (mt (visited-file-modtime))) + + (cond + ;; File exists, and has a known modtime. + ((and attr (not (equal modtime '(0 0)))) + (< (abs (tramp-time-diff + modtime + ;; For compatibility, deal with both the old + ;; (HIGH . LOW) and the new (HIGH LOW) return + ;; values of `visited-file-modtime'. + (if (atom (cdr mt)) + (list (car mt) (cdr mt)) + mt))) + 2)) + ;; Modtime has the don't know value. + (attr + (tramp-send-command + v + (format "%s -ild %s" + (tramp-get-ls-command v) + (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-buffer v) + (setq attr (buffer-substring + (point) (progn (end-of-line) (point))))) + (equal + attr + (tramp-get-file-property + v localname "visited-file-modtime-ild" ""))) + ;; If file does not exist, say it is not modified if and + ;; only if that agrees with the buffer's record. + (t (equal mt '(-1 65535)))))))))) + +(defun tramp-handle-set-file-modes (filename mode) + "Like `set-file-modes' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname) + ;; FIXME: extract the proper text from chmod's stderr. + (tramp-barf-unless-okay + v + (format "chmod %s %s" + (tramp-compat-decimal-to-octal mode) + (tramp-shell-quote-argument localname)) + "Error while changing file's mode %s" filename))) + +(defun tramp-handle-set-file-times (filename &optional time) + "Like `set-file-times' for Tramp files." + (if (file-remote-p filename) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time)) + ;; With GNU Emacs, `format-time-string' has an optional + ;; parameter UNIVERSAL. This is preferred, because we + ;; could handle the case when the remote host is located + ;; in a different time zone as the local host. + (utc (not (featurep 'xemacs)))) + (tramp-send-command-and-check + v (format "%s touch -t %s %s" + (if utc "TZ=UTC; export TZ;" "") + (if utc + (format-time-string "%Y%m%d%H%M.%S" time t) + (format-time-string "%Y%m%d%H%M.%S" time)) + (tramp-shell-quote-argument localname))))) + + ;; We handle also the local part, because in older Emacsen, + ;; without `set-file-times', this function is an alias for this. + ;; We are local, so we don't need the UTC settings. + (zerop + (tramp-compat-call-process + "touch" nil nil nil "-t" + (format-time-string "%Y%m%d%H%M.%S" time) + (tramp-shell-quote-argument filename))))) + +(defun tramp-set-file-uid-gid (filename &optional uid gid) + "Set the ownership for FILENAME. +If UID and GID are provided, these values are used; otherwise uid +and gid of the corresponding user is taken. Both parameters must be integers." + ;; Modern Unices allow chown only for root. So we might need + ;; another implementation, see `dired-do-chown'. OTOH, it is mostly + ;; working with su(do)? when it is needed, so it shall succeed in + ;; the majority of cases. + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used)) + (if (file-remote-p filename) + (with-parsed-tramp-file-name filename nil + (if (and (zerop (user-uid)) (tramp-local-host-p v)) + ;; If we are root on the local host, we can do it directly. + (tramp-set-file-uid-gid localname uid gid) + (let ((uid (or (and (integerp uid) uid) + (tramp-get-remote-uid v 'integer))) + (gid (or (and (integerp gid) gid) + (tramp-get-remote-gid v 'integer)))) + (tramp-send-command + v (format + "chown %d:%d %s" uid gid + (tramp-shell-quote-argument localname)))))) + + ;; We handle also the local part, because there doesn't exist + ;; `set-file-uid-gid'. On W32 "chown" might not work. + (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer))) + (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))) + (tramp-compat-call-process + "chown" nil nil nil + (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) + +(defun tramp-remote-selinux-p (vec) + "Check, whether SELINUX is enabled on the remote host." + (with-connection-property (tramp-get-connection-process vec) "selinux-p" + (let ((result (tramp-find-executable + vec "getenforce" (tramp-get-remote-path vec) t t))) + (and result + (string-equal + (tramp-send-command-and-read + vec (format "echo \\\"`%S`\\\"" result)) + "Enforcing"))))) + +(defun tramp-handle-file-selinux-context (filename) + "Like `file-selinux-context' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-selinux-context" + (let ((context '(nil nil nil nil)) + (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" + "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))) + (when (and (tramp-remote-selinux-p v) + (tramp-send-command-and-check + v (format + "%s -d -Z %s" + (tramp-get-ls-command v) + (tramp-shell-quote-argument localname)))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (when (re-search-forward regexp (tramp-compat-line-end-position) t) + (setq context (list (match-string 1) (match-string 2) + (match-string 3) (match-string 4)))))) + ;; Return the context. + context)))) + +(defun tramp-handle-set-file-selinux-context (filename context) + "Like `set-file-selinux-context' for Tramp files." + (with-parsed-tramp-file-name filename nil + (if (and (consp context) + (tramp-remote-selinux-p v) + (tramp-send-command-and-check + v (format "chcon %s %s %s %s %s" + (if (stringp (nth 0 context)) + (format "--user=%s" (nth 0 context)) "") + (if (stringp (nth 1 context)) + (format "--role=%s" (nth 1 context)) "") + (if (stringp (nth 2 context)) + (format "--type=%s" (nth 2 context)) "") + (if (stringp (nth 3 context)) + (format "--range=%s" (nth 3 context)) "") + (tramp-shell-quote-argument localname)))) + (tramp-set-file-property v localname "file-selinux-context" context) + (tramp-set-file-property v localname "file-selinux-context" 'undef))) + ;; We always return nil. + nil) + +;; Simple functions using the `test' command. + +(defun tramp-handle-file-executable-p (filename) + "Like `file-executable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-executable-p" + ;; Examine `file-attributes' cache to see if request can be + ;; satisfied without remote operation. + (or (tramp-check-cached-permissions v ?x) + (tramp-run-test "-x" filename))))) + +(defun tramp-handle-file-readable-p (filename) + "Like `file-readable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-readable-p" + ;; Examine `file-attributes' cache to see if request can be + ;; satisfied without remote operation. + (or (tramp-check-cached-permissions v ?r) + (tramp-run-test "-r" filename))))) + +;; When the remote shell is started, it looks for a shell which groks +;; tilde expansion. Here, we assume that all shells which grok tilde +;; expansion will also provide a `test' command which groks `-nt' (for +;; newer than). If this breaks, tell me about it and I'll try to do +;; something smarter about it. +(defun tramp-handle-file-newer-than-file-p (file1 file2) + "Like `file-newer-than-file-p' for Tramp files." + (cond ((not (file-exists-p file1)) + nil) + ((not (file-exists-p file2)) + t) + ;; We are sure both files exist at this point. + (t + (save-excursion + ;; We try to get the mtime of both files. If they are not + ;; equal to the "dont-know" value, then we subtract the times + ;; and obtain the result. + (let ((fa1 (file-attributes file1)) + (fa2 (file-attributes file2))) + (if (and (not (equal (nth 5 fa1) '(0 0))) + (not (equal (nth 5 fa2) '(0 0)))) + (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1))) + ;; If one of them is the dont-know value, then we can + ;; still try to run a shell command on the remote host. + ;; However, this only works if both files are Tramp + ;; files and both have the same method, same user, same + ;; host. + (unless (tramp-equal-remote file1 file2) + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p file1) file1 file2) nil + (tramp-error + v 'file-error + "Files %s and %s must have same method, user, host" + file1 file2))) + (with-parsed-tramp-file-name file1 nil + (tramp-run-test2 + (tramp-get-test-nt-command v) file1 file2)))))))) + +;; Functions implemented using the basic functions above. + +(defun tramp-handle-file-modes (filename) + "Like `file-modes' for Tramp files." + (let ((truename (or (file-truename filename) filename))) + (when (file-exists-p truename) + (tramp-mode-string-to-int (nth 8 (file-attributes truename)))))) + +(defun tramp-handle-file-directory-p (filename) + "Like `file-directory-p' for Tramp files." + ;; Care must be taken that this function returns `t' for symlinks + ;; pointing to directories. Surely the most obvious implementation + ;; would be `test -d', but that returns false for such symlinks. + ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And + ;; I now think he's right. So we could be using `test -d', couldn't + ;; we? + ;; + ;; Alternatives: `cd %s', `test -d %s' + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-directory-p" + (tramp-run-test "-d" filename)))) + +(defun tramp-handle-file-regular-p (filename) + "Like `file-regular-p' for Tramp files." + (and (file-exists-p filename) + (eq ?- (aref (nth 8 (file-attributes filename)) 0)))) + +(defun tramp-handle-file-symlink-p (filename) + "Like `file-symlink-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (let ((x (car (file-attributes filename)))) + (when (stringp x) + ;; When Tramp is running on VMS, then `file-name-absolute-p' + ;; might do weird things. + (if (file-name-absolute-p x) + (tramp-make-tramp-file-name method user host x) + x))))) + +(defun tramp-handle-file-writable-p (filename) + "Like `file-writable-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-writable-p" + (if (file-exists-p filename) + ;; Examine `file-attributes' cache to see if request can be + ;; satisfied without remote operation. + (or (tramp-check-cached-permissions v ?w) + (tramp-run-test "-w" filename)) + ;; If file doesn't exist, check if directory is writable. + (and (tramp-run-test "-d" (file-name-directory filename)) + (tramp-run-test "-w" (file-name-directory filename))))))) + +(defun tramp-handle-file-ownership-preserved-p (filename) + "Like `file-ownership-preserved-p' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-file-property v localname "file-ownership-preserved-p" + (let ((attributes (file-attributes filename))) + ;; Return t if the file doesn't exist, since it's true that no + ;; information would be lost by an (attempted) delete and create. + (or (null attributes) + (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))))))) + +;; Other file name ops. + +(defun tramp-handle-directory-file-name (directory) + "Like `directory-file-name' for Tramp files." + ;; If localname component of filename is "/", leave it unchanged. + ;; Otherwise, remove any trailing slash from localname component. + ;; Method, host, etc, are unchanged. Does it make sense to try + ;; to avoid parsing the filename? + (with-parsed-tramp-file-name directory nil + (if (and (not (zerop (length localname))) + (eq (aref localname (1- (length localname))) ?/) + (not (string= localname "/"))) + (substring directory 0 -1) + directory))) + +;; Directory listings. + +(defun tramp-handle-directory-files + (directory &optional full match nosort files-only) + "Like `directory-files' for Tramp files." + ;; FILES-ONLY is valid for XEmacs only. + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + result item) + + (while temp + (setq item (directory-file-name (pop temp))) + (when (and (or (null match) (string-match match item)) + (or (null files-only) + ;; Files only. + (and (equal files-only t) (file-regular-p item)) + ;; Directories only. + (file-directory-p item))) + (push (if full (concat directory item) item) + result))) + (if nosort result (sort result 'string<))))) + +(defun tramp-handle-directory-files-and-attributes + (directory &optional full match nosort id-format) + "Like `directory-files-and-attributes' for Tramp files." + (unless id-format (setq id-format 'integer)) + (when (file-directory-p directory) + (setq directory (expand-file-name directory)) + (let* ((temp + (copy-tree + (with-parsed-tramp-file-name directory nil + (with-file-property + v localname + (format "directory-files-and-attributes-%s" id-format) + (save-excursion + (mapcar + (lambda (x) + (cons (car x) + (tramp-convert-file-attributes v (cdr x)))) + (cond + ((tramp-get-remote-stat v) + (tramp-do-directory-files-and-attributes-with-stat + v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-directory-files-and-attributes-with-perl + v localname id-format))))))))) + result item) + + (while temp + (setq item (pop temp)) + (when (or (null match) (string-match match (car item))) + (when full + (setcar item (expand-file-name (car item) directory))) + (push item result))) + + (if nosort + result + (sort result (lambda (x y) (string< (car x) (car y)))))))) + +(defun tramp-do-directory-files-and-attributes-with-perl + (vec localname &optional id-format) + "Implement `directory-files-and-attributes' for Tramp files using a Perl script." + (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname) + (tramp-maybe-send-script + vec tramp-perl-directory-files-and-attributes + "tramp_perl_directory_files_and_attributes") + (let ((object + (tramp-send-command-and-read + vec + (format "tramp_perl_directory_files_and_attributes %s %s" + (tramp-shell-quote-argument localname) id-format)))) + (when (stringp object) (tramp-error vec 'file-error object)) + object)) + +(defun tramp-do-directory-files-and-attributes-with-stat + (vec localname &optional id-format) + "Implement `directory-files-and-attributes' for Tramp files using stat(1) command." + (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname) + (tramp-send-command-and-read + vec + (format + (concat + ;; We must care about filenames with spaces, or starting with + ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, + ;; but it does not work on all remote systems. Therefore, we + ;; quote the filenames via sed. + "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs " + "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); " + "echo \")\"") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command vec) + (tramp-get-remote-stat vec) + (if (eq id-format 'integer) "%u" "\"%U\"") + (if (eq id-format 'integer) "%g" "\"%G\"")))) + +;; This function should return "foo/" for directories and "bar" for +;; files. +(defun tramp-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (unless (save-match-data (string-match "/" filename)) + (with-parsed-tramp-file-name (expand-file-name directory) nil + + (all-completions + filename + (mapcar + 'list + (or + ;; Try cache first + (and + ;; Ignore if expired + (or (not (integerp tramp-completion-reread-directory-timeout)) + (<= (tramp-time-diff + (current-time) + (tramp-get-file-property + v localname "last-completion" '(0 0 0))) + tramp-completion-reread-directory-timeout)) + + ;; Try cache entries for filename, filename with last + ;; character removed, filename with last two characters + ;; removed, ..., and finally the empty string - all + ;; concatenated to the local directory name + + ;; This is inefficient for very long filenames, pity + ;; `reduce' is not available... + (car + (apply + 'append + (mapcar + (lambda (x) + (let ((cache-hit + (tramp-get-file-property + v + (concat localname (substring filename 0 x)) + "file-name-all-completions" + nil))) + (when cache-hit (list cache-hit)))) + (tramp-compat-number-sequence (length filename) 0 -1))))) + + ;; Cache expired or no matching cache entry found so we need + ;; to perform a remote operation + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing '/'. Because I + ;; rock. --daniel@danann.net + + ;; Changed to perform `cd' in the same remote op and only + ;; get entries starting with `filename'. Capture any `cd' + ;; error messages. Ensure any `cd' and `echo' aliases are + ;; ignored. + (tramp-send-command + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s %s %d" + (tramp-shell-quote-argument localname) + (tramp-shell-quote-argument filename) + (if (symbol-value + ;; `read-file-name-completion-ignore-case' + ;; is introduced with Emacs 22.1. + (if (boundp + 'read-file-name-completion-ignore-case) + 'read-file-name-completion-ignore-case + 'completion-ignore-case)) + 1 0))) + + (format (concat + "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null" + ;; `ls' with wildcard might fail with `Argument + ;; list too long' error in some corner cases; if + ;; `ls' fails after `cd' succeeded, chances are + ;; that's the case, so let's retry without + ;; wildcard. This will return "too many" entries + ;; but that isn't harmful. + " || %s -a 2>/dev/null)" + " | while read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + ;; When `filename' is empty, just `ls' without + ;; filename argument is more efficient than `ls *' + ;; for very large directories and might avoid the + ;; `Argument list too long' error. + ;; + ;; With and only with wildcard, we need to add + ;; `-d' to prevent `ls' from descending into + ;; sub-directories. + (if (zerop (length filename)) + "." + (concat (tramp-shell-quote-argument filename) "* -d")) + (tramp-get-ls-command v) + (tramp-get-test-command v)))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + + ;; Check result code, found in last line of output + (forward-line -1) + (if (looking-at "^fail$") + (progn + ;; Grab error message from line before last line + ;; (it was put there by `cd 2>&1') + (forward-line -1) + (tramp-error + v 'file-error + "tramp-handle-file-name-all-completions: %s" + (buffer-substring + (point) (tramp-compat-line-end-position)))) + ;; For peace of mind, if buffer doesn't end in `fail' + ;; then it should end in `ok'. If neither are in the + ;; buffer something went seriously wrong on the remote + ;; side. + (unless (looking-at "^ok$") + (tramp-error + v 'file-error + "\ +tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'" + (tramp-shell-quote-argument localname) (buffer-string)))) + + (while (zerop (forward-line -1)) + (push (buffer-substring + (point) (tramp-compat-line-end-position)) + result))) + + ;; Because the remote op went through OK we know the + ;; directory we `cd'-ed to exists + (tramp-set-file-property + v localname "file-exists-p" t) + + ;; Because the remote op went through OK we know every + ;; file listed by `ls' exists. + (mapc (lambda (entry) + (tramp-set-file-property + v (concat localname entry) "file-exists-p" t)) + result) + + (tramp-set-file-property + v localname "last-completion" (current-time)) + + ;; Store result in the cache + (tramp-set-file-property + v (concat localname filename) + "file-name-all-completions" + result)))))))) + +(defun tramp-handle-file-name-completion + (filename directory &optional predicate) + "Like `file-name-completion' for Tramp files." + (unless (tramp-tramp-file-p directory) + (error + "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" + directory)) + (try-completion + filename + (mapcar 'list (file-name-all-completions filename directory)) + (when predicate + (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) + +;; cp, mv and ln + +(defun tramp-handle-add-name-to-file + (filename newname &optional ok-if-already-exists) + "Like `add-name-to-file' for Tramp files." + (unless (tramp-equal-remote filename newname) + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p filename) filename newname) nil + (tramp-error + v 'file-error + "add-name-to-file: %s" + "only implemented for same method, same user, same host"))) + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + (let ((ln (when v1 (tramp-get-remote-ln v1)))) + (when (and (not ok-if-already-exists) + (file-exists-p newname) + (not (numberp ok-if-already-exists)) + (y-or-n-p + (format + "File %s already exists; make it a new name anyway? " + newname))) + (tramp-error + v2 'file-error + "add-name-to-file: file %s already exists" newname)) + (tramp-flush-file-property v2 (file-name-directory v2-localname)) + (tramp-flush-file-property v2 v2-localname) + (tramp-barf-unless-okay + v1 + (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname) + (tramp-shell-quote-argument v2-localname)) + "error with add-name-to-file, see buffer `%s' for details" + (buffer-name)))))) + +(defun tramp-handle-copy-file + (filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-selinux-context) + "Like `copy-file' for Tramp files." + (setq filename (expand-file-name filename)) + (setq newname (expand-file-name newname)) + (cond + ;; At least one file a Tramp file? + ((or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-do-copy-or-rename-file + 'copy filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-selinux-context)) + ;; Compat section. + (preserve-selinux-context + (tramp-run-real-handler + 'copy-file + (list filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-selinux-context))) + (preserve-uid-gid + (tramp-run-real-handler + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) + (t + (tramp-run-real-handler + 'copy-file (list filename newname ok-if-already-exists keep-date))))) + +(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents) + "Like `copy-directory' for Tramp files." + (let ((t1 (tramp-tramp-file-p dirname)) + (t2 (tramp-tramp-file-p newname))) + (with-parsed-tramp-file-name (if t1 dirname newname) nil + (if (and (tramp-get-method-parameter method 'tramp-copy-recursive) + ;; When DIRNAME and NEWNAME are remote, they must have + ;; the same method. + (or (null t1) (null t2) + (string-equal + (tramp-file-name-method (tramp-dissect-file-name dirname)) + (tramp-file-name-method (tramp-dissect-file-name newname))))) + ;; scp or rsync DTRT. + (progn + (setq dirname (directory-file-name (expand-file-name dirname)) + newname (directory-file-name (expand-file-name newname))) + (if (and (file-directory-p newname) + (not (string-equal (file-name-nondirectory dirname) + (file-name-nondirectory newname)))) + (setq newname + (expand-file-name + (file-name-nondirectory dirname) newname))) + (if (not (file-directory-p (file-name-directory newname))) + (make-directory (file-name-directory newname) parents)) + (tramp-do-copy-or-rename-file-out-of-band + 'copy dirname newname keep-date)) + ;; We must do it file-wise. + (tramp-run-real-handler + 'copy-directory (list dirname newname keep-date parents))) + + ;; When newname did exist, we have wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname)))))) + +(defun tramp-handle-rename-file + (filename newname &optional ok-if-already-exists) + "Like `rename-file' for Tramp files." + ;; Check if both files are local -- invoke normal rename-file. + ;; Otherwise, use Tramp from local system. + (setq filename (expand-file-name filename)) + (setq newname (expand-file-name newname)) + ;; At least one file a Tramp file? + (if (or (tramp-tramp-file-p filename) + (tramp-tramp-file-p newname)) + (tramp-do-copy-or-rename-file + 'rename filename newname ok-if-already-exists t t) + (tramp-run-real-handler + 'rename-file (list filename newname ok-if-already-exists)))) + +(defun tramp-do-copy-or-rename-file + (op filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-selinux-context) + "Copy or rename a remote file. +OP must be `copy' or `rename' and indicates the operation to perform. +FILENAME specifies the file to copy or rename, NEWNAME is the name of +the new file (for copy) or the new name of the file (for rename). +OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. +KEEP-DATE means to make sure that NEWNAME has the same timestamp +as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep +the uid and gid if both files are on the same host. +PRESERVE-SELINUX-CONTEXT activates selinux commands. + +This function is invoked by `tramp-handle-copy-file' and +`tramp-handle-rename-file'. It is an error if OP is neither of `copy' +and `rename'. FILENAME and NEWNAME must be absolute file names." + (unless (memq op '(copy rename)) + (error "Unknown operation `%s', must be `copy' or `rename'" op)) + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (context (and preserve-selinux-context + (apply 'file-selinux-context (list filename)))) + pr tm) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error + v 'file-already-exists "File %s already exists" newname)) + + (with-progress-reporter + v 0 (format "%s %s to %s" + (if (eq op 'copy) "Copying" "Renaming") + filename newname) + + (cond + ;; Both are Tramp files. + ((and t1 t2) + (with-parsed-tramp-file-name filename v1 + (with-parsed-tramp-file-name newname v2 + (cond + ;; Shortcut: if method, host, user are the same for + ;; both files, we invoke `cp' or `mv' on the remote + ;; host directly. + ((tramp-equal-remote filename newname) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; Try out-of-band operation. + ((tramp-method-out-of-band-p + v1 (nth 7 (file-attributes filename))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date)) + + ;; No shortcut was possible. So we copy the file + ;; first. If the operation was `rename', we go back + ;; and delete the original file (if the copy was + ;; successful). The approach is simple-minded: we + ;; create a new buffer, insert the contents of the + ;; source file into it, then write out the buffer to + ;; the target file. The advantage is that it doesn't + ;; matter which filename handlers are used for the + ;; source and target file. + (t + (tramp-do-copy-or-rename-file-via-buffer + op filename newname keep-date)))))) + + ;; One file is a Tramp file, the other one is local. + ((or t1 t2) + (cond + ;; Fast track on local machine. + ((tramp-local-host-p v) + (tramp-do-copy-or-rename-file-directly + op filename newname + ok-if-already-exists keep-date preserve-uid-gid)) + + ;; If the Tramp file has an out-of-band method, the + ;; corresponding copy-program can be invoked. + ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date)) + + ;; Use the inline method via a Tramp buffer. + (t (tramp-do-copy-or-rename-file-via-buffer + op filename newname keep-date)))) + + (t + ;; One of them must be a Tramp file. + (error "Tramp implementation says this cannot happen"))) + + ;; Handle `preserve-selinux-context'. + (when context (apply 'set-file-selinux-context (list newname context))) + + ;; In case of `rename', we must flush the cache of the source file. + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-property v1 (file-name-directory localname)) + (tramp-flush-file-property v1 localname))) + + ;; When newname did exist, we have wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-property v2 (file-name-directory localname)) + (tramp-flush-file-property v2 localname))))))) + +(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date) + "Use an Emacs buffer to copy or rename a file. +First arg OP is either `copy' or `rename' and indicates the operation. +FILENAME is the source file, NEWNAME the target file. +KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." + (with-temp-buffer + ;; We must disable multibyte, because binary data shall not be + ;; converted. + (set-buffer-multibyte nil) + (let ((coding-system-for-read 'binary) + (jka-compr-inhibit t)) + (insert-file-contents-literally filename)) + ;; We don't want the target file to be compressed, so we let-bind + ;; `jka-compr-inhibit' to t. + (let ((coding-system-for-write 'binary) + (jka-compr-inhibit t)) + (write-region (point-min) (point-max) newname))) + ;; KEEP-DATE handling. + (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))) + ;; Set the mode. + (set-file-modes newname (tramp-default-file-modes filename)) + ;; If the operation was `rename', delete the original file. + (unless (eq op 'copy) (delete-file filename))) + +(defun tramp-do-copy-or-rename-file-directly + (op filename newname ok-if-already-exists keep-date preserve-uid-gid) + "Invokes `cp' or `mv' on the remote system. +OP must be one of `copy' or `rename', indicating `cp' or `mv', +respectively. FILENAME specifies the file to copy or rename, +NEWNAME is the name of the new file (for copy) or the new name of +the file (for rename). Both files must reside on the same host. +KEEP-DATE means to make sure that NEWNAME has the same timestamp +as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep +the uid and gid from FILENAME." + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (file-times (nth 5 (file-attributes filename))) + (file-modes (tramp-default-file-modes filename))) + (with-parsed-tramp-file-name (if t1 filename newname) nil + (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") + ((eq op 'copy) "cp -f") + ((eq op 'rename) "mv -f") + (t (tramp-error + v 'file-error + "Unknown operation `%s', must be `copy' or `rename'" + op)))) + (localname1 + (if t1 + (tramp-file-name-handler 'file-remote-p filename 'localname) + filename)) + (localname2 + (if t2 + (tramp-file-name-handler 'file-remote-p newname 'localname) + newname)) + (prefix (file-remote-p (if t1 filename newname))) + cmd-result) + + (cond + ;; Both files are on a remote host, with same user. + ((and t1 t2) + (setq cmd-result + (tramp-send-command-and-check + v (format "%s %s %s" cmd + (tramp-shell-quote-argument localname1) + (tramp-shell-quote-argument localname2)))) + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-min)) + (unless + (or + (and keep-date + ;; Mask cp -f error. + (re-search-forward + tramp-operation-not-permitted-regexp nil t)) + cmd-result) + (tramp-error-with-buffer + nil v 'file-error + "Copying directly failed, see buffer `%s' for details." + (buffer-name))))) + + ;; We are on the local host. + ((or t1 t2) + (cond + ;; We can do it directly. + ((let (file-name-handler-alist) + (and (file-readable-p localname1) + (file-writable-p (file-name-directory localname2)) + (or (file-directory-p localname2) + (file-writable-p localname2)))) + (if (eq op 'copy) + (tramp-compat-copy-file + localname1 localname2 ok-if-already-exists + keep-date preserve-uid-gid) + (tramp-run-real-handler + 'rename-file (list localname1 localname2 ok-if-already-exists)))) + + ;; We can do it directly with `tramp-send-command' + ((and (file-readable-p (concat prefix localname1)) + (file-writable-p + (file-name-directory (concat prefix localname2))) + (or (file-directory-p (concat prefix localname2)) + (file-writable-p (concat prefix localname2)))) + (tramp-do-copy-or-rename-file-directly + op (concat prefix localname1) (concat prefix localname2) + ok-if-already-exists keep-date t) + ;; We must change the ownership to the local user. + (tramp-set-file-uid-gid + (concat prefix localname2) + (tramp-get-local-uid 'integer) + (tramp-get-local-gid 'integer))) + + ;; We need a temporary file in between. + (t + ;; Create the temporary file. + (let ((tmpfile (tramp-compat-make-temp-file localname1))) + (unwind-protect + (progn + (cond + (t1 + (tramp-barf-unless-okay + v (format + "%s %s %s" cmd + (tramp-shell-quote-argument localname1) + (tramp-shell-quote-argument tmpfile)) + "Copying directly failed, see buffer `%s' for details." + (tramp-get-buffer v)) + ;; We must change the ownership as remote user. + ;; Since this does not work reliable, we also + ;; give read permissions. + (set-file-modes + (concat prefix tmpfile) + (tramp-compat-octal-to-decimal "0777")) + (tramp-set-file-uid-gid + (concat prefix tmpfile) + (tramp-get-local-uid 'integer) + (tramp-get-local-gid 'integer))) + (t2 + (if (eq op 'copy) + (tramp-compat-copy-file + localname1 tmpfile t + keep-date preserve-uid-gid) + (tramp-run-real-handler + 'rename-file + (list localname1 tmpfile t))) + ;; We must change the ownership as local user. + ;; Since this does not work reliable, we also + ;; give read permissions. + (set-file-modes + tmpfile (tramp-compat-octal-to-decimal "0777")) + (tramp-set-file-uid-gid + tmpfile + (tramp-get-remote-uid v 'integer) + (tramp-get-remote-gid v 'integer)))) + + ;; Move the temporary file to its destination. + (cond + (t2 + (tramp-barf-unless-okay + v (format + "cp -f -p %s %s" + (tramp-shell-quote-argument tmpfile) + (tramp-shell-quote-argument localname2)) + "Copying directly failed, see buffer `%s' for details." + (tramp-get-buffer v))) + (t1 + (tramp-run-real-handler + 'rename-file + (list tmpfile localname2 ok-if-already-exists))))) + + ;; Save exit. + (condition-case nil + (delete-file tmpfile) + (error))))))))) + + ;; Set the time and mode. Mask possible errors. + (condition-case nil + (when keep-date + (set-file-times newname file-times) + (set-file-modes newname file-modes)) + (error))))) + +(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) + "Invoke rcp program to copy. +The method used must be an out-of-band method." + (let ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + copy-program copy-args copy-env copy-keep-date port spec + source target) + + (with-parsed-tramp-file-name (if t1 filename newname) nil + (if (and t1 t2) + + ;; Both are Tramp files. We shall optimize it, when the + ;; methods for filename and newname are the same. + (let* ((dir-flag (file-directory-p filename)) + (tmpfile (tramp-compat-make-temp-file localname dir-flag))) + (if dir-flag + (setq tmpfile + (expand-file-name + (file-name-nondirectory newname) tmpfile))) + (unwind-protect + (progn + (tramp-do-copy-or-rename-file-out-of-band + op filename tmpfile keep-date) + (tramp-do-copy-or-rename-file-out-of-band + 'rename tmpfile newname keep-date)) + ;; Save exit. + (condition-case nil + (if dir-flag + (tramp-compat-delete-directory + (expand-file-name ".." tmpfile) 'recursive) + (delete-file tmpfile)) + (error)))) + + ;; Expand hops. Might be necessary for gateway methods. + (setq v (car (tramp-compute-multi-hops v))) + (aset v 3 localname) + + ;; Check which ones of source and target are Tramp files. + (setq source (if t1 (tramp-make-copy-program-file-name v) filename) + target (funcall + (if (and (file-directory-p filename) + (string-equal + (file-name-nondirectory filename) + (file-name-nondirectory newname))) + 'file-name-directory + 'identity) + (if t2 (tramp-make-copy-program-file-name v) newname))) + + ;; Check for port number. Until now, there's no need for handling + ;; like method, user, host. + (setq host (tramp-file-name-real-host v) + port (tramp-file-name-port v) + port (or (and port (number-to-string port)) "")) + + ;; Compose copy command. + (setq spec (format-spec-make + ?h host ?u user ?p port + ?t (tramp-get-connection-property + (tramp-get-connection-process v) "temp-file" "") + ?k (if keep-date " " "")) + copy-program (tramp-get-method-parameter + method 'tramp-copy-program) + copy-keep-date (tramp-get-method-parameter + method 'tramp-copy-keep-date) + copy-args + (delq + nil + (mapcar + (lambda (x) + (setq + x + ;; " " is indication for keep-date argument. + (delete " " (mapcar (lambda (y) (format-spec y spec)) x))) + (unless (member "" x) (mapconcat 'identity x " "))) + (tramp-get-method-parameter method 'tramp-copy-args))) + copy-env + (delq + nil + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) + (tramp-get-method-parameter method 'tramp-copy-env)))) + + ;; Check for program. + (when (and (fboundp 'executable-find) + (not (let ((default-directory + (tramp-compat-temporary-file-directory))) + (executable-find copy-program)))) + (tramp-error + v 'file-error "Cannot find copy program: %s" copy-program)) + + ;; Set variables for computing the prompt for reading + ;; password. + (setq tramp-current-method (tramp-file-name-method v) + tramp-current-user (tramp-file-name-user v) + tramp-current-host (tramp-file-name-host v)) + + (unwind-protect + (with-temp-buffer + ;; The default directory must be remote. + (let ((default-directory + (file-name-directory (if t1 filename newname))) + (process-environment (copy-sequence process-environment))) + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + (while copy-env + (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env)) + (setenv (pop copy-env) (pop copy-env))) + + ;; Use an asynchronous process. By this, password can + ;; be handled. The default directory must be local, in + ;; order to apply the correct `copy-program'. We don't + ;; set a timeout, because the copying of large files can + ;; last longer than 60 secs. + (let ((p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (apply 'start-process + (tramp-get-connection-property + v "process-name" nil) + (tramp-get-connection-property + v "process-buffer" nil) + copy-program + (append copy-args (list source target)))))) + (tramp-message + v 6 "%s" (mapconcat 'identity (process-command p) " ")) + (tramp-set-process-query-on-exit-flag p nil) + (tramp-process-actions p v tramp-actions-copy-out-of-band)))) + + ;; Reset the transfer process properties. + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil)) + + ;; Handle KEEP-DATE argument. + (when (and keep-date (not copy-keep-date)) + (set-file-times newname (nth 5 (file-attributes filename)))) + + ;; Set the mode. + (unless (and keep-date copy-keep-date) + (ignore-errors + (set-file-modes newname (tramp-default-file-modes filename))))) + + ;; If the operation was `rename', delete the original file. + (unless (eq op 'copy) + (if (file-regular-p filename) + (delete-file filename) + (tramp-compat-delete-directory filename 'recursive)))))) + +(defun tramp-handle-make-directory (dir &optional parents) + "Like `make-directory' for Tramp files." + (setq dir (expand-file-name dir)) + (with-parsed-tramp-file-name dir nil + (tramp-flush-directory-property v (file-name-directory localname)) + (save-excursion + (tramp-barf-unless-okay + v (format "%s %s" + (if parents "mkdir -p" "mkdir") + (tramp-shell-quote-argument localname)) + "Couldn't make directory %s" dir)))) + +(defun tramp-handle-delete-directory (directory &optional recursive) + "Like `delete-directory' for Tramp files." + (setq directory (expand-file-name directory)) + (with-parsed-tramp-file-name directory nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-directory-property v localname) + (tramp-barf-unless-okay + v (format "%s %s" + (if recursive "rm -rf" "rmdir") + (tramp-shell-quote-argument localname)) + "Couldn't delete %s" directory))) + +(defun tramp-handle-delete-file (filename &optional trash) + "Like `delete-file' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (tramp-barf-unless-okay + v (format "%s %s" + (or (and trash (tramp-get-remote-trash v)) "rm -f") + (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) + +;; Dired. + +;; CCC: This does not seem to be enough. Something dies when +;; we try and delete two directories under Tramp :/ +(defun tramp-handle-dired-recursive-delete-directory (filename) + "Recursively delete the directory given. +This is like `dired-recursive-delete-directory' for Tramp files." + (with-parsed-tramp-file-name filename nil + ;; Run a shell command 'rm -r <localname>' + ;; Code shamelessly stolen from the dired implementation and, um, hacked :) + (unless (file-exists-p filename) + (tramp-error v 'file-error "No such directory: %s" filename)) + ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>) + (tramp-send-command + v + (format "rm -rf %s" (tramp-shell-quote-argument localname)) + ;; Don't read the output, do it explicitely. + nil t) + ;; Wait for the remote system to return to us... + ;; This might take a while, allow it plenty of time. + (tramp-wait-for-output (tramp-get-connection-process v) 120) + ;; Make sure that it worked... + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-directory-property v localname) + (and (file-exists-p filename) + (tramp-error + v 'file-error "Failed to recursively delete %s" filename)))) + +(defun tramp-handle-dired-compress-file (file &rest ok-flag) + "Like `dired-compress-file' for Tramp files." + ;; OK-FLAG is valid for XEmacs only, but not implemented. + ;; Code stolen mainly from dired-aux.el. + (with-parsed-tramp-file-name file nil + (tramp-flush-file-property v localname) + (save-excursion + (let ((suffixes + (if (not (featurep 'xemacs)) + ;; Emacs case + (symbol-value 'dired-compress-file-suffixes) + ;; XEmacs has `dired-compression-method-alist', which is + ;; transformed into `dired-compress-file-suffixes' structure. + (mapcar + (lambda (x) + (list (concat (regexp-quote (nth 1 x)) "\\'") + nil + (mapconcat 'identity (nth 3 x) " "))) + (symbol-value 'dired-compression-method-alist)))) + suffix) + ;; See if any suffix rule matches this file name. + (while suffixes + (let (case-fold-search) + (if (string-match (car (car suffixes)) localname) + (setq suffix (car suffixes) suffixes nil)) + (setq suffixes (cdr suffixes)))) + + (cond ((file-symlink-p file) + nil) + ((and suffix (nth 2 suffix)) + ;; We found an uncompression rule. + (with-progress-reporter v 0 (format "Uncompressing %s" file) + (when (tramp-send-command-and-check + v (concat (nth 2 suffix) " " + (tramp-shell-quote-argument localname))) + ;; `dired-remove-file' is not defined in XEmacs. + (tramp-compat-funcall 'dired-remove-file file) + (string-match (car suffix) file) + (concat (substring file 0 (match-beginning 0)))))) + (t + ;; We don't recognize the file as compressed, so compress it. + ;; Try gzip. + (with-progress-reporter v 0 (format "Compressing %s" file) + (when (tramp-send-command-and-check + v (concat "gzip -f " + (tramp-shell-quote-argument localname))) + ;; `dired-remove-file' is not defined in XEmacs. + (tramp-compat-funcall 'dired-remove-file file) + (cond ((file-exists-p (concat file ".gz")) + (concat file ".gz")) + ((file-exists-p (concat file ".z")) + (concat file ".z")) + (t nil)))))))))) + +(defun tramp-handle-dired-uncache (dir &optional dir-p) + "Like `dired-uncache' for Tramp files." + ;; DIR-P is valid for XEmacs only. + (with-parsed-tramp-file-name + (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil + (tramp-flush-directory-property v localname))) + +(defun tramp-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (if (and (featurep 'ls-lisp) + (not (symbol-value 'ls-lisp-use-insert-directory-program))) + (tramp-run-real-handler + 'insert-directory (list filename switches wildcard full-directory-p)) + (when (stringp switches) + (setq switches (split-string switches))) + (when (and (member "--dired" switches) + (not (tramp-get-ls-command-with-dired v))) + (setq switches (delete "--dired" switches))) + (when wildcard + (setq wildcard (tramp-run-real-handler + 'file-name-nondirectory (list localname))) + (setq localname (tramp-run-real-handler + 'file-name-directory (list localname)))) + (unless full-directory-p + (setq switches (add-to-list 'switches "-d" 'append))) + (setq switches (mapconcat 'tramp-shell-quote-argument switches " ")) + (when wildcard + (setq switches (concat switches " " wildcard))) + (tramp-message + v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" + switches filename (if wildcard "yes" "no") + (if full-directory-p "yes" "no")) + ;; If `full-directory-p', we just say `ls -l FILENAME'. + ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. + (if full-directory-p + (tramp-send-command + v + (format "%s %s %s 2>/dev/null" + (tramp-get-ls-command v) + switches + (if wildcard + localname + (tramp-shell-quote-argument (concat localname "."))))) + (tramp-barf-unless-okay + v + (format "cd %s" (tramp-shell-quote-argument + (tramp-run-real-handler + 'file-name-directory (list localname)))) + "Couldn't `cd %s'" + (tramp-shell-quote-argument + (tramp-run-real-handler 'file-name-directory (list localname)))) + (tramp-send-command + v + (format "%s %s %s" + (tramp-get-ls-command v) + switches + (if (or wildcard + (zerop (length + (tramp-run-real-handler + 'file-name-nondirectory (list localname))))) + "" + (tramp-shell-quote-argument + (tramp-run-real-handler + 'file-name-nondirectory (list localname))))))) + (let ((beg (point))) + ;; We cannot use `insert-buffer-substring' because the Tramp + ;; buffer changes its contents before insertion due to calling + ;; `expand-file' and alike. + (insert + (with-current-buffer (tramp-get-buffer v) + (buffer-string))) + + ;; Check for "--dired" output. + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (when (looking-at "//DIRED//\\s-+") + (let ((databeg (match-end 0)) + (end (tramp-compat-line-end-position))) + ;; Now read the numeric positions of file names. + (goto-char databeg) + (while (< (point) end) + (let ((start (+ beg (read (current-buffer)))) + (end (+ beg (read (current-buffer))))) + (if (memq (char-after end) '(?\n ?\ )) + ;; End is followed by \n or by " -> ". + (put-text-property start end 'dired-filename t)))))) + ;; Remove trailing lines. + (goto-char (tramp-compat-line-beginning-position)) + (while (looking-at "//") + (forward-line 1) + (delete-region (match-beginning 0) (point))) + + ;; The inserted file could be from somewhere else. + (when (and (not wildcard) (not full-directory-p)) + (goto-char (point-max)) + (when (file-symlink-p filename) + (goto-char (search-backward "->" beg 'noerror))) + (search-backward + (if (zerop (length (file-name-nondirectory filename))) + "." + (file-name-nondirectory filename)) + beg 'noerror) + (replace-match (file-relative-name filename) t)) + + (goto-char (point-max)))))) + +(defun tramp-handle-unhandled-file-name-directory (filename) + "Like `unhandled-file-name-directory' for Tramp files." + ;; With Emacs 23, we could simply return `nil'. But we must keep it + ;; for backward compatibility. + (expand-file-name "~/")) + +;; Canonicalization of file names. + +(defun tramp-handle-expand-file-name (name &optional dir) + "Like `expand-file-name' for Tramp files. +If the localname part of the given filename starts with \"/../\" then +the result will be a local, non-Tramp, filename." + ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If NAME is not a Tramp file, run the real handler. + (if (not (tramp-connectable-p name)) + (tramp-run-real-handler 'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) + (setq localname (concat "~/" localname))) + ;; Tilde expansion if necessary. This needs a shell which + ;; groks tilde expansion! The function `tramp-find-shell' is + ;; supposed to find such a shell on the remote host. Please + ;; tell me about it when this doesn't work on your system. + (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname))) + ;; We cannot simply apply "~/", because under sudo "~/" is + ;; expanded to the local user home directory but to the + ;; root home directory. On the other hand, using always + ;; the default user name for tilde expansion is not + ;; appropriate either, because ssh and companions might + ;; use a user name from the config file. + (when (and (string-equal uname "~") + (string-match "\\`su\\(do\\)?\\'" method)) + (setq uname (concat uname user))) + (setq uname + (with-connection-property v uname + (tramp-send-command + v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-min)) + (buffer-substring + (point) (tramp-compat-line-end-position))))) + (setq localname (concat uname fname)))) + ;; There might be a double slash, for example when "~/" + ;; expands to "/". Remove this. + (while (string-match "//" localname) + (setq localname (replace-match "/" t t localname))) + ;; No tilde characters in file name, do normal + ;; `expand-file-name' (this does "/./" and "/../"). We bind + ;; `directory-sep-char' here for XEmacs on Windows, which would + ;; otherwise use backslash. `default-directory' is bound, + ;; because on Windows there would be problems with UNC shares or + ;; Cygwin mounts. + (let ((directory-sep-char ?/) + (default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + method user host + (tramp-drop-volume-letter + (tramp-run-real-handler + 'expand-file-name (list localname)))))))) + +(defun tramp-handle-substitute-in-file-name (filename) + "Like `substitute-in-file-name' for Tramp files. +\"//\" and \"/~\" substitute only in the local filename part. +If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at +beginning of local filename are not substituted." + ;; First, we must replace environment variables. + (setq filename (tramp-replace-environment-variables filename)) + (with-parsed-tramp-file-name filename nil + (if (equal tramp-syntax 'url) + ;; We need to check localname only. The other parts cannot contain + ;; "//" or "/~". + (if (and (> (length localname) 1) + (or (string-match "//" localname) + (string-match "/~" localname 1))) + (tramp-run-real-handler 'substitute-in-file-name (list filename)) + (tramp-make-tramp-file-name + (when method (substitute-in-file-name method)) + (when user (substitute-in-file-name user)) + (when host (substitute-in-file-name host)) + (when localname + (tramp-run-real-handler + 'substitute-in-file-name (list localname))))) + ;; Ignore in LOCALNAME everything before "//" or "/~". + (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (setq filename + (concat (file-remote-p filename) + (replace-match "\\1" nil nil localname))) + ;; "/m:h:~" does not work for completion. We use "/m:h:~/". + (when (string-match "~$" filename) + (setq filename (concat filename "/")))) + (tramp-run-real-handler 'substitute-in-file-name (list filename))))) + +;;; Remote commands: + +(defun tramp-handle-executable-find (command) + "Like `executable-find' for Tramp files." + (with-parsed-tramp-file-name default-directory nil + (tramp-find-executable v command (tramp-get-remote-path v) t))) + +(defun tramp-process-sentinel (proc event) + "Flush file caches." + (unless (memq (process-status proc) '(run open)) + (let ((vec (tramp-get-connection-property proc "vector" nil))) + (when vec + (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event) + (tramp-flush-directory-property vec ""))))) + +;; We use BUFFER also as connection buffer during setup. Because of +;; this, its original contents must be saved, and restored once +;; connection has been setup. +(defun tramp-handle-start-file-process (name buffer program &rest args) + "Like `start-file-process' for Tramp files." + (with-parsed-tramp-file-name default-directory nil + (unwind-protect + ;; When PROGRAM is nil, we just provide a tty. + (let ((command + (when (stringp program) + (format "cd %s; exec %s" + (tramp-shell-quote-argument localname) + (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) + (name1 name) + (i 0)) + (unless buffer + ;; BUFFER can be nil. We use a temporary buffer. + (setq buffer (generate-new-buffer tramp-temp-buffer-name))) + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + (setq name name1) + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name) + (tramp-set-connection-property v "process-buffer" buffer) + ;; Activate narrowing in order to save BUFFER contents. + ;; Clear also the modification time; otherwise we might be + ;; interrupted by `verify-visited-file-modtime'. + (with-current-buffer (tramp-get-connection-buffer v) + (clear-visited-file-modtime) + (narrow-to-region (point-max) (point-max))) + (if command + ;; Send the command. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated. + (tramp-maybe-open-connection v) + (unless (tramp-compat-process-get + (tramp-get-connection-process v) 'remote-tty) + (tramp-error + v 'file-error "pty association is not supported for `%s'" name))) + (let ((p (tramp-get-connection-process v))) + ;; Set sentinel and query flag for this process. + (tramp-set-connection-property p "vector" v) + (set-process-sentinel p 'tramp-process-sentinel) + (tramp-set-process-query-on-exit-flag p t) + ;; Return process. + p)) + ;; Save exit. + (with-current-buffer (tramp-get-connection-buffer v) + (if (string-match tramp-temp-buffer-name (buffer-name)) + (progn + (set-process-buffer (tramp-get-connection-process v) nil) + (kill-buffer (current-buffer))) + (widen) + (goto-char (point-max)))) + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil)))) + +(defun tramp-handle-process-file + (program &optional infile destination display &rest args) + "Like `process-file' for Tramp files." + ;; The implementation is not complete yet. + (when (and (numberp destination) (zerop destination)) + (error "Implementation does not handle immediate return")) + + (with-parsed-tramp-file-name default-directory nil + (let (command input tmpinput stderr tmpstderr outbuf ret) + ;; Compute command. + (setq command (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")) + ;; Determine input. + (if (null infile) + (setq input "/dev/null") + (setq infile (expand-file-name infile)) + (if (tramp-equal-remote default-directory infile) + ;; INFILE is on the same remote host. + (setq input (with-parsed-tramp-file-name infile nil localname)) + ;; INFILE must be copied to remote host. + (setq input (tramp-make-tramp-temp-file v) + tmpinput (tramp-make-tramp-file-name method user host input)) + (copy-file infile tmpinput t))) + (when input (setq command (format "%s <%s" command input))) + + ;; Determine output. + (cond + ;; Just a buffer. + ((bufferp destination) + (setq outbuf destination)) + ;; A buffer name. + ((stringp destination) + (setq outbuf (get-buffer-create destination))) + ;; (REAL-DESTINATION ERROR-DESTINATION) + ((consp destination) + ;; output. + (cond + ((bufferp (car destination)) + (setq outbuf (car destination))) + ((stringp (car destination)) + (setq outbuf (get-buffer-create (car destination)))) + ((car destination) + (setq outbuf (current-buffer)))) + ;; stderr. + (cond + ((stringp (cadr destination)) + (setcar (cdr destination) (expand-file-name (cadr destination))) + (if (tramp-equal-remote default-directory (cadr destination)) + ;; stderr is on the same remote host. + (setq stderr (with-parsed-tramp-file-name + (cadr destination) nil localname)) + ;; stderr must be copied to remote host. The temporary + ;; file must be deleted after execution. + (setq stderr (tramp-make-tramp-temp-file v) + tmpstderr (tramp-make-tramp-file-name + method user host stderr)))) + ;; stderr to be discarded. + ((null (cadr destination)) + (setq stderr "/dev/null")))) + ;; 't + (destination + (setq outbuf (current-buffer)))) + (when stderr (setq command (format "%s 2>%s" command stderr))) + + ;; Send the command. It might not return in time, so we protect + ;; it. Call it in a subshell, in order to preserve working + ;; directory. + (condition-case nil + (unwind-protect + (setq ret + (if (tramp-send-command-and-check + v (format "\\cd %s; %s" + (tramp-shell-quote-argument localname) + command) + t t) + 0 1)) + ;; We should show the output anyway. + (when outbuf + (with-current-buffer outbuf + (insert + (with-current-buffer (tramp-get-connection-buffer v) + (buffer-string)))) + (when display (display-buffer outbuf)))) + ;; When the user did interrupt, we should do it also. We use + ;; return code -1 as marker. + (quit + (kill-buffer (tramp-get-connection-buffer v)) + (setq ret -1)) + ;; Handle errors. + (error + (kill-buffer (tramp-get-connection-buffer v)) + (setq ret 1))) + + ;; Provide error file. + (when tmpstderr (rename-file tmpstderr (cadr destination) t)) + + ;; Cleanup. We remove all file cache values for the connection, + ;; because the remote process could have changed them. + (when tmpinput (delete-file tmpinput)) + + ;; `process-file-side-effects' has been introduced with GNU + ;; Emacs 23.2. If set to `nil', no remote file will be changed + ;; by `program'. If it doesn't exist, we assume its default + ;; value 't'. + (unless (and (boundp 'process-file-side-effects) + (not (symbol-value 'process-file-side-effects))) + (tramp-flush-directory-property v "")) + + ;; Return exit status. + (if (equal ret -1) + (keyboard-quit) + ret)))) + +(defun tramp-handle-call-process-region + (start end program &optional delete buffer display &rest args) + "Like `call-process-region' for Tramp files." + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + (apply 'call-process program tmpfile buffer display args) + (delete-file tmpfile)))) + +(defun tramp-handle-shell-command + (command &optional output-buffer error-buffer) + "Like `shell-command' for Tramp files." + (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + ;; We cannot use `shell-file-name' and `shell-command-switch', + ;; they are variables of the local host. + (args (list + (tramp-get-method-parameter + (tramp-file-name-method + (tramp-dissect-file-name default-directory)) + 'tramp-remote-sh) + "-c" (substring command 0 asynchronous))) + current-buffer-p + (output-buffer + (cond + ((bufferp output-buffer) output-buffer) + ((stringp output-buffer) (get-buffer-create output-buffer)) + (output-buffer + (setq current-buffer-p t) + (current-buffer)) + (t (get-buffer-create + (if asynchronous + "*Async Shell Command*" + "*Shell Command Output*"))))) + (error-buffer + (cond + ((bufferp error-buffer) error-buffer) + ((stringp error-buffer) (get-buffer-create error-buffer)))) + (buffer + (if (and (not asynchronous) error-buffer) + (with-parsed-tramp-file-name default-directory nil + (list output-buffer (tramp-make-tramp-temp-file v))) + output-buffer)) + (p (get-buffer-process output-buffer))) + + ;; Check whether there is another process running. Tramp does not + ;; support 2 (asynchronous) processes in parallel. + (when p + (if (yes-or-no-p "A command is running. Kill it? ") + (ignore-errors (kill-process p)) + (error "Shell command in progress"))) + + (if current-buffer-p + (progn + (barf-if-buffer-read-only) + (push-mark nil t)) + (with-current-buffer output-buffer + (setq buffer-read-only nil) + (erase-buffer))) + + (if (and (not current-buffer-p) (integerp asynchronous)) + (prog1 + ;; Run the process. + (apply 'start-file-process "*Async Shell*" buffer args) + ;; Display output. + (pop-to-buffer output-buffer) + (setq mode-line-process '(":%s")) + (shell-mode)) + + (prog1 + ;; Run the process. + (apply 'process-file (car args) nil buffer nil (cdr args)) + ;; Insert error messages if they were separated. + (when (listp buffer) + (with-current-buffer error-buffer + (insert-file-contents (cadr buffer))) + (delete-file (cadr buffer))) + (if current-buffer-p + ;; This is like exchange-point-and-mark, but doesn't + ;; activate the mark. It is cleaner to avoid activation, + ;; even though the command loop would deactivate the mark + ;; because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) + (current-buffer)))) + ;; There's some output, display it. + (when (with-current-buffer output-buffer (> (point-max) (point-min))) + (if (functionp 'display-message-or-buffer) + (tramp-compat-funcall 'display-message-or-buffer output-buffer) + (pop-to-buffer output-buffer)))))))) + +(defun tramp-handle-file-local-copy (filename) + "Like `file-local-copy' for Tramp files." + + (with-parsed-tramp-file-name filename nil + (unless (file-exists-p filename) + (tramp-error + v 'file-error + "Cannot make local copy of non-existing file `%s'" filename)) + + (let* ((size (nth 7 (file-attributes filename))) + (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) + (loc-dec (tramp-get-inline-coding v "local-decoding" size)) + (tmpfile (tramp-compat-make-temp-file filename))) + + (condition-case err + (cond + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (copy-file filename tmpfile t t)) + + ;; Use inline encoding for file transfer. + (rem-enc + (save-excursion + (with-progress-reporter + v 3 (format "Encoding remote file %s" filename) + (tramp-barf-unless-okay + v (format rem-enc (tramp-shell-quote-argument localname)) + "Encoding remote file failed")) + + (if (functionp loc-dec) + ;; If local decoding is a function, we call it. We + ;; must disable multibyte, because + ;; `uudecode-decode-region' doesn't handle it + ;; correctly. + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring (tramp-get-buffer v)) + (with-progress-reporter + v 3 (format "Decoding remote file %s with function %s" + filename loc-dec) + (funcall loc-dec (point-min) (point-max)) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (write-region (point-min) (point-max) tmpfile)))) + + ;; If tramp-decoding-function is not defined for this + ;; method, we invoke tramp-decoding-command instead. + (let ((tmpfile2 (tramp-compat-make-temp-file filename))) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (write-region (point-min) (point-max) tmpfile2)) + (with-progress-reporter + v 3 (format "Decoding remote file %s with command %s" + filename loc-dec) + (unwind-protect + (tramp-call-local-coding-command + loc-dec tmpfile2 tmpfile) + (delete-file tmpfile2))))) + + ;; Set proper permissions. + (set-file-modes tmpfile (tramp-default-file-modes filename)) + ;; Set local user ownership. + (tramp-set-file-uid-gid tmpfile))) + + ;; Oops, I don't know what to do. + (t (tramp-error + v 'file-error "Wrong method specification for `%s'" method))) + + ;; Error handling. + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + (run-hooks 'tramp-handle-file-local-copy-hook) + tmpfile))) + +(defun tramp-handle-file-remote-p (filename &optional identification connected) + "Like `file-remote-p' for Tramp files." + (let ((tramp-verbose 3)) + (when (tramp-tramp-file-p filename) + (let* ((v (tramp-dissect-file-name filename)) + (p (tramp-get-connection-process v)) + (c (and p (processp p) (memq (process-status p) '(run open))))) + ;; We expand the file name only, if there is already a connection. + (with-parsed-tramp-file-name + (if c (expand-file-name filename) filename) nil + (and (or (not connected) c) + (cond + ((eq identification 'method) method) + ((eq identification 'user) user) + ((eq identification 'host) host) + ((eq identification 'localname) localname) + (t (tramp-make-tramp-file-name method user host ""))))))))) + +(defun tramp-handle-insert-file-contents + (filename &optional visit beg end replace) + "Like `insert-file-contents' for Tramp files." + (barf-if-buffer-read-only) + (setq filename (expand-file-name filename)) + (let (result local-copy remote-copy) + (with-parsed-tramp-file-name filename nil + (unwind-protect + (if (not (file-exists-p filename)) + ;; We don't raise a Tramp error, because it might be + ;; suppressed, like in `find-file-noselect-1'. + (signal 'file-error + (list "File not found on remote host" filename)) + + (if (and (tramp-local-host-p v) + (let (file-name-handler-alist) + (file-readable-p localname))) + ;; Short track: if we are on the local host, we can + ;; run directly. + (setq result + (tramp-run-real-handler + 'insert-file-contents + (list localname visit beg end replace))) + + ;; When we shall insert only a part of the file, we copy + ;; this part. + (when (or beg end) + (setq remote-copy (tramp-make-tramp-temp-file v)) + (tramp-send-command + v + (cond + ((and beg end) + (format "tail -c +%d %s | head -c +%d >%s" + (1+ beg) (tramp-shell-quote-argument localname) + (- end beg) remote-copy)) + (beg + (format "tail -c +%d %s >%s" + (1+ beg) (tramp-shell-quote-argument localname) + remote-copy)) + (end + (format "head -c +%d %s >%s" + (1+ end) (tramp-shell-quote-argument localname) + remote-copy))))) + + ;; `insert-file-contents-literally' takes care to avoid + ;; calling jka-compr. By let-binding + ;; `inhibit-file-name-operation', we propagate that care + ;; to the `file-local-copy' operation. + (setq local-copy + (let ((inhibit-file-name-operation + (when (eq inhibit-file-name-operation + 'insert-file-contents) + 'file-local-copy))) + (cond + ((stringp remote-copy) + (file-local-copy + (tramp-make-tramp-file-name + method user host remote-copy))) + ((stringp tramp-temp-buffer-file-name) + (copy-file filename tramp-temp-buffer-file-name 'ok) + tramp-temp-buffer-file-name) + (t (file-local-copy filename))))) + + ;; When the file is not readable for the owner, it + ;; cannot be inserted, even it is redable for the group + ;; or for everybody. + (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600")) + + (when (and (null remote-copy) + (tramp-get-method-parameter + method 'tramp-copy-keep-tmpfile)) + ;; We keep the local file for performance reasons, + ;; useful for "rsync". + (setq tramp-temp-buffer-file-name local-copy) + (put 'tramp-temp-buffer-file-name 'permanent-local t)) + + (with-progress-reporter + v 3 (format "Inserting local temp file `%s'" local-copy) + ;; We must ensure that `file-coding-system-alist' + ;; matches `local-copy'. + (let ((file-coding-system-alist + (tramp-find-file-name-coding-system-alist + filename local-copy))) + (setq result + (insert-file-contents + local-copy nil nil nil replace)))))) + + ;; Save exit. + (progn + (when visit + (setq buffer-file-name filename) + (setq buffer-read-only (not (file-writable-p filename))) + (set-visited-file-modtime) + (set-buffer-modified-p nil)) + (when (and (stringp local-copy) + (or remote-copy (null tramp-temp-buffer-file-name))) + (delete-file local-copy)) + (when (stringp remote-copy) + (delete-file + (tramp-make-tramp-file-name method user host remote-copy)))))) + + ;; Result. + (list (expand-file-name filename) + (cadr result)))) + +;; This is needed for XEmacs only. Code stolen from files.el. +(defun tramp-handle-insert-file-contents-literally + (filename &optional visit beg end replace) + "Like `insert-file-contents-literally' for Tramp files." + (let ((format-alist nil) + (after-insert-file-functions nil) + (coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion) + (find-buffer-file-type-function + (if (fboundp 'find-buffer-file-type) + (symbol-function 'find-buffer-file-type) + nil)) + (inhibit-file-name-handlers '(jka-compr-handler image-file-handler)) + (inhibit-file-name-operation 'insert-file-contents)) + (unwind-protect + (progn + (fset 'find-buffer-file-type (lambda (filename) t)) + (insert-file-contents filename visit beg end replace)) + ;; Save exit. + (if find-buffer-file-type-function + (fset 'find-buffer-file-type find-buffer-file-type-function) + (fmakunbound 'find-buffer-file-type))))) + +(defun tramp-handle-find-backup-file-name (filename) + "Like `find-backup-file-name' for Tramp files." + (with-parsed-tramp-file-name filename nil + ;; We set both variables. It doesn't matter whether it is + ;; Emacs or XEmacs. + (let ((backup-directory-alist + ;; Emacs case. + (when (boundp 'backup-directory-alist) + (if (symbol-value 'tramp-backup-directory-alist) + (mapcar + (lambda (x) + (cons + (car x) + (if (and (stringp (cdr x)) + (file-name-absolute-p (cdr x)) + (not (tramp-file-name-p (cdr x)))) + (tramp-make-tramp-file-name method user host (cdr x)) + (cdr x)))) + (symbol-value 'tramp-backup-directory-alist)) + (symbol-value 'backup-directory-alist)))) + + (bkup-backup-directory-info + ;; XEmacs case. + (when (boundp 'bkup-backup-directory-info) + (if (symbol-value 'tramp-bkup-backup-directory-info) + (mapcar + (lambda (x) + (nconc + (list (car x)) + (list + (if (and (stringp (car (cdr x))) + (file-name-absolute-p (car (cdr x))) + (not (tramp-file-name-p (car (cdr x))))) + (tramp-make-tramp-file-name + method user host (car (cdr x))) + (car (cdr x)))) + (cdr (cdr x)))) + (symbol-value 'tramp-bkup-backup-directory-info)) + (symbol-value 'bkup-backup-directory-info))))) + + (tramp-run-real-handler 'find-backup-file-name (list filename))))) + +(defun tramp-handle-make-auto-save-file-name () + "Like `make-auto-save-file-name' for Tramp files. +Returns a file name in `tramp-auto-save-directory' for autosaving this file." + (let ((tramp-auto-save-directory tramp-auto-save-directory) + (buffer-file-name + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (buffer-file-name)))) + ;; File name must be unique. This is ensured with Emacs 22 (see + ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for + ;; all other cases we must do it ourselves. + (when (boundp 'auto-save-file-name-transforms) + (mapc + (lambda (x) + (when (and (string-match (car x) buffer-file-name) + (not (car (cddr x)))) + (setq tramp-auto-save-directory + (or tramp-auto-save-directory + (tramp-compat-temporary-file-directory))))) + (symbol-value 'auto-save-file-name-transforms))) + ;; Create directory. + (when tramp-auto-save-directory + (setq buffer-file-name + (expand-file-name buffer-file-name tramp-auto-save-directory)) + (unless (file-exists-p tramp-auto-save-directory) + (make-directory tramp-auto-save-directory t))) + ;; Run plain `make-auto-save-file-name'. There might be an advice when + ;; it is not a magic file name operation (since Emacs 22). + ;; We must deactivate it temporarily. + (if (not (ad-is-active 'make-auto-save-file-name)) + (tramp-run-real-handler 'make-auto-save-file-name nil) + ;; else + (ad-deactivate 'make-auto-save-file-name) + (prog1 + (tramp-run-real-handler 'make-auto-save-file-name nil) + (ad-activate 'make-auto-save-file-name))))) + +(defvar tramp-handle-write-region-hook nil + "Normal hook to be run at the end of `tramp-handle-write-region'.") + +;; CCC grok LOCKNAME +(defun tramp-handle-write-region + (start end filename &optional append visit lockname confirm) + "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + ;; Following part commented out because we don't know what to do about + ;; file locking, and it does not appear to be a problem to ignore it. + ;; Ange-ftp ignores it, too. + ;; (when (and lockname (stringp lockname)) + ;; (setq lockname (expand-file-name lockname))) + ;; (unless (or (eq lockname nil) + ;; (string= lockname filename)) + ;; (error + ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME")) + + ;; XEmacs takes a coding system as the seventh argument, not `confirm'. + (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) + (tramp-error v 'file-error "File not overwritten"))) + + (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer)) + (tramp-get-remote-uid v 'integer))) + (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer)) + (tramp-get-remote-gid v 'integer)))) + + (if (and (tramp-local-host-p v) + ;; `file-writable-p' calls `file-expand-file-name'. We + ;; cannot use `tramp-run-real-handler' therefore. + (let (file-name-handler-alist) + (and + (file-writable-p (file-name-directory localname)) + (or (file-directory-p localname) + (file-writable-p localname))))) + ;; Short track: if we are on the local host, we can run directly. + (tramp-run-real-handler + 'write-region + (list start end localname append 'no-message lockname confirm)) + + (let ((modes (save-excursion (tramp-default-file-modes filename))) + ;; We use this to save the value of + ;; `last-coding-system-used' after writing the tmp + ;; file. At the end of the function, we set + ;; `last-coding-system-used' to this saved value. This + ;; way, any intermediary coding systems used while + ;; talking to the remote shell or suchlike won't hose + ;; this variable. This approach was snarfed from + ;; ange-ftp.el. + coding-system-used + ;; Write region into a tmp file. This isn't really + ;; needed if we use an encoding function, but currently + ;; we use it always because this makes the logic + ;; simpler. + (tmpfile (or tramp-temp-buffer-file-name + (tramp-compat-make-temp-file filename)))) + + ;; If `append' is non-nil, we copy the file locally, and let + ;; the native `write-region' implementation do the job. + (when append (copy-file filename tmpfile 'ok)) + + ;; We say `no-message' here because we don't want the + ;; visited file modtime data to be clobbered from the temp + ;; file. We call `set-visited-file-modtime' ourselves later + ;; on. We must ensure that `file-coding-system-alist' + ;; matches `tmpfile'. + (let (file-name-handler-alist + (file-coding-system-alist + (tramp-find-file-name-coding-system-alist filename tmpfile))) + (condition-case err + (tramp-run-real-handler + 'write-region + (list start end tmpfile append 'no-message lockname confirm)) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Now, `last-coding-system-used' has the right value. Remember it. + (when (boundp 'last-coding-system-used) + (setq coding-system-used + (symbol-value 'last-coding-system-used)))) + + ;; The permissions of the temporary file should be set. If + ;; filename does not exist (eq modes nil) it has been + ;; renamed to the backup file. This case `save-buffer' + ;; handles permissions. + ;; Ensure, that it is still readable. + (when modes + (set-file-modes + tmpfile + (logior (or modes 0) (tramp-compat-octal-to-decimal "0400")))) + + ;; This is a bit lengthy due to the different methods + ;; possible for file transfer. First, we check whether the + ;; method uses an rcp program. If so, we call it. + ;; Otherwise, both encoding and decoding command must be + ;; specified. However, if the method _also_ specifies an + ;; encoding function, then that is used for encoding the + ;; contents of the tmp file. + (let* ((size (nth 7 (file-attributes tmpfile))) + (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) + (loc-enc (tramp-get-inline-coding v "local-encoding" size))) + (cond + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (if (and (not (stringp start)) + (= (or end (point-max)) (point-max)) + (= (or start (point-min)) (point-min)) + (tramp-get-method-parameter + method 'tramp-copy-keep-tmpfile)) + (progn + (setq tramp-temp-buffer-file-name tmpfile) + (condition-case err + ;; We keep the local file for performance + ;; reasons, useful for "rsync". + (copy-file tmpfile filename t) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err))))) + (setq tramp-temp-buffer-file-name nil) + ;; Don't rename, in order to keep context in SELinux. + (unwind-protect + (copy-file tmpfile filename t) + (delete-file tmpfile)))) + + ;; Use inline file transfer. + (rem-dec + ;; Encode tmpfile. + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + ;; Use encoding function or command. + (if (functionp loc-enc) + (with-progress-reporter + v 3 (format "Encoding region using function `%s'" + loc-enc) + (let ((coding-system-for-read 'binary)) + (insert-file-contents-literally tmpfile)) + ;; The following `let' is a workaround for the + ;; base64.el that comes with pgnus-0.84. If + ;; both of the following conditions are + ;; satisfied, it tries to write to a local + ;; file in default-directory, but at this + ;; point, default-directory is remote. + ;; (`call-process-region' can't write to + ;; remote files, it seems.) The file in + ;; question is a tmp file anyway. + (let ((default-directory + (tramp-compat-temporary-file-directory))) + (funcall loc-enc (point-min) (point-max)))) + + (with-progress-reporter + v 3 (format "Encoding region using command `%s'" + loc-enc) + (unless (zerop (tramp-call-local-coding-command + loc-enc tmpfile t)) + (tramp-error + v 'file-error + (concat "Cannot write to `%s', " + "local encoding command `%s' failed") + filename loc-enc)))) + + ;; Send buffer into remote decoding command which + ;; writes to remote file. Because this happens on + ;; the remote host, we cannot use the function. + (with-progress-reporter + v 3 + (format "Decoding region into remote file %s" filename) + (goto-char (point-max)) + (unless (bolp) (newline)) + (tramp-send-command + v + (format + (concat rem-dec " <<'EOF'\n%sEOF") + (tramp-shell-quote-argument localname) + (buffer-string))) + (tramp-barf-unless-okay + v nil + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec) + ;; When `file-precious-flag' is set, the region is + ;; written to a temporary file. Check that the + ;; checksum is equal to that from the local tmpfile. + (when file-precious-flag + (erase-buffer) + (and + ;; cksum runs locally, if possible. + (zerop (tramp-compat-call-process "cksum" tmpfile t)) + ;; cksum runs remotely. + (tramp-send-command-and-check + v + (format + "cksum <%s" (tramp-shell-quote-argument localname))) + ;; ... they are different. + (not + (string-equal + (buffer-string) + (with-current-buffer (tramp-get-buffer v) + (buffer-string)))) + (tramp-error + v 'file-error + (concat "Couldn't write region to `%s'," + " decode using `%s' failed") + filename rem-dec))))) + + ;; Save exit. + (delete-file tmpfile))) + + ;; That's not expected. + (t + (tramp-error + v 'file-error + (concat "Method `%s' should specify both encoding and " + "decoding command or an rcp program") + method)))) + + ;; Make `last-coding-system-used' have the right value. + (when coding-system-used + (set 'last-coding-system-used coding-system-used)))) + + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + ;; We must protect `last-coding-system-used', now we have set it + ;; to its correct value. + (let (last-coding-system-used (need-chown t)) + ;; Set file modification time. + (when (or (eq visit t) (stringp visit)) + (let ((file-attr (file-attributes filename))) + (set-visited-file-modtime + ;; We must pass modtime explicitely, because filename can + ;; be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (nth 5 file-attr)) + (when (and (eq (nth 2 file-attr) uid) + (eq (nth 3 file-attr) gid)) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid filename uid gid)) + (when (or (eq visit t) (null visit) (stringp visit)) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook))))) + +(defvar tramp-vc-registered-file-names nil + "List used to collect file names, which are checked during `vc-registered'.") + +;; VC backends check for the existence of various different special +;; files. This is very time consuming, because every single check +;; requires a remote command (the file cache must be invalidated). +;; Therefore, we apply a kind of optimization. We install the file +;; name handler `tramp-vc-file-name-handler', which does nothing but +;; remembers all file names for which `file-exists-p' or +;; `file-readable-p' has been applied. A first run of `vc-registered' +;; is performed. Afterwards, a script is applied for all collected +;; file names, using just one remote command. The result of this +;; script is used to fill the file cache with actual values. Now we +;; can reset the file name handlers, and we make a second run of +;; `vc-registered', which returns the expected result without sending +;; any other remote command. +(defun tramp-handle-vc-registered (file) + "Like `vc-registered' for Tramp files." + (tramp-compat-with-temp-message "" + (with-parsed-tramp-file-name file nil + (with-progress-reporter + v 3 (format "Checking `vc-registered' for %s" file) + + ;; There could be new files, created by the vc backend. We + ;; cannot reuse the old cache entries, therefore. + (let (tramp-vc-registered-file-names + (tramp-cache-inhibit-cache (current-time)) + (file-name-handler-alist + `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) + + ;; Here we collect only file names, which need an operation. + (tramp-run-real-handler 'vc-registered (list file)) + (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) + + ;; Send just one command, in order to fill the cache. + (when tramp-vc-registered-file-names + (tramp-maybe-send-script + v + (format tramp-vc-registered-read-file-names + (tramp-get-file-exists-command v) + (format "%s -r" (tramp-get-test-command v))) + "tramp_vc_registered_read_file_names") + + (dolist + (elt + (tramp-send-command-and-read + v + (format + "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n" + (mapconcat 'tramp-shell-quote-argument + tramp-vc-registered-file-names + "\n")))) + + (tramp-set-file-property + v (car elt) (cadr elt) (cadr (cdr elt)))))) + + ;; Second run. Now all `file-exists-p' or `file-readable-p' + ;; calls shall be answered from the file cache. We unset + ;; `process-file-side-effects' in order to keep the cache when + ;; `process-file' calls appear. + (let (process-file-side-effects) + (tramp-run-real-handler 'vc-registered (list file))))))) + +;;;###tramp-autoload +(defun tramp-sh-file-name-handler (operation &rest args) + "Invoke remote-shell Tramp file name handler. +Fall back to normal file name handler if no Tramp handler exists." + (when (and tramp-locked (not tramp-locker)) + (setq tramp-locked nil) + (signal 'file-error (list "Forbidden reentrant call of Tramp"))) + (let ((tl tramp-locked)) + (unwind-protect + (progn + (setq tramp-locked t) + (let ((tramp-locker t)) + (save-match-data + (let ((fn (assoc operation tramp-sh-file-name-handler-alist))) + (if fn + (apply (cdr fn) args) + (tramp-run-real-handler operation args)))))) + (setq tramp-locked tl)))) + +(defun tramp-vc-file-name-handler (operation &rest args) + "Invoke special file name handler, which collects files to be handled." + (save-match-data + (let ((filename + (tramp-replace-environment-variables + (apply 'tramp-file-name-for-operation operation args))) + (fn (assoc operation tramp-sh-file-name-handler-alist))) + (with-parsed-tramp-file-name filename nil + (cond + ;; That's what we want: file names, for which checks are + ;; applied. We assume, that VC uses only `file-exists-p' and + ;; `file-readable-p' checks; otherwise we must extend the + ;; list. We do not perform any action, but return nil, in + ;; order to keep `vc-registered' running. + ((and fn (memq operation '(file-exists-p file-readable-p))) + (add-to-list 'tramp-vc-registered-file-names localname 'append) + nil) + ;; Tramp file name handlers like `expand-file-name'. They + ;; must still work. + (fn + (save-match-data (apply (cdr fn) args))) + ;; Default file name handlers, we don't care. + (t (tramp-run-real-handler operation args))))))) + +;;; Internal Functions: + +(defun tramp-maybe-send-script (vec script name) + "Define in remote shell function NAME implemented as SCRIPT. +Only send the definition if it has not already been done." + (let* ((p (tramp-get-connection-process vec)) + (scripts (tramp-get-connection-property p "scripts" nil))) + (unless (member name scripts) + (with-progress-reporter vec 5 (format "Sending script `%s'" name) + ;; The script could contain a call of Perl. This is masked with `%s'. + (tramp-barf-unless-okay + vec + (format "%s () {\n%s\n}" name + (format script (tramp-get-remote-perl vec))) + "Script %s sending failed" name) + (tramp-set-connection-property p "scripts" (cons name scripts)))))) + +(defun tramp-set-auto-save () + (when (and ;; ange-ftp has its own auto-save mechanism + (eq (tramp-find-foreign-file-name-handler (buffer-file-name)) + 'tramp-sh-file-name-handler) + auto-save-default) + (auto-save-mode 1))) +(add-hook 'find-file-hooks 'tramp-set-auto-save t) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'find-file-hooks 'tramp-set-auto-save))) + +(defun tramp-run-test (switch filename) + "Run `test' on the remote system, given a SWITCH and a FILENAME. +Returns the exit code of the `test' program." + (with-parsed-tramp-file-name filename nil + (tramp-send-command-and-check + v + (format + "%s %s %s" + (tramp-get-test-command v) + switch + (tramp-shell-quote-argument localname))))) + +(defun tramp-run-test2 (format-string file1 file2) + "Run `test'-like program on the remote system, given FILE1, FILE2. +FORMAT-STRING contains the program name, switches, and place holders. +Returns the exit code of the `test' program. Barfs if the methods, +hosts, or files, disagree." + (unless (tramp-equal-remote file1 file2) + (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil + (tramp-error + v 'file-error + "tramp-run-test2 only implemented for same method, user, host"))) + (with-parsed-tramp-file-name file1 v1 + (with-parsed-tramp-file-name file1 v2 + (tramp-send-command-and-check + v1 + (format format-string + (tramp-shell-quote-argument v1-localname) + (tramp-shell-quote-argument v2-localname)))))) + +(defun tramp-find-executable + (vec progname dirlist &optional ignore-tilde ignore-path) + "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST. +First arg VEC specifies the connection, PROGNAME is the program +to search for, and DIRLIST gives the list of directories to +search. If IGNORE-TILDE is non-nil, directory names starting +with `~' will be ignored. If IGNORE-PATH is non-nil, searches +only in DIRLIST. + +Returns the absolute file name of PROGNAME, if found, and nil otherwise. + +This function expects to be in the right *tramp* buffer." + (with-current-buffer (tramp-get-connection-buffer vec) + (let (result) + ;; Check whether the executable is in $PATH. "which(1)" does not + ;; report always a correct error code; therefore we check the + ;; number of words it returns. + (unless ignore-path + (tramp-send-command vec (format "which \\%s | wc -w" progname)) + (goto-char (point-min)) + (if (looking-at "^\\s-*1$") + (setq result (concat "\\" progname)))) + (unless result + (when ignore-tilde + ;; Remove all ~/foo directories from dirlist. In XEmacs, + ;; `remove' is in CL, and we want to avoid CL dependencies. + (let (newdl d) + (while dirlist + (setq d (car dirlist)) + (setq dirlist (cdr dirlist)) + (unless (char-equal ?~ (aref d 0)) + (setq newdl (cons d newdl)))) + (setq dirlist (nreverse newdl)))) + (tramp-send-command + vec + (format (concat "while read d; " + "do if test -x $d/%s -a -f $d/%s; " + "then echo tramp_executable $d/%s; " + "break; fi; done <<'EOF'\n" + "%s\nEOF") + progname progname progname (mapconcat 'identity dirlist "\n"))) + (goto-char (point-max)) + (when (search-backward "tramp_executable " nil t) + (skip-chars-forward "^ ") + (skip-chars-forward " ") + (setq result (buffer-substring + (point) (tramp-compat-line-end-position))))) + result))) + +(defun tramp-set-remote-path (vec) + "Sets the remote environment PATH to existing directories. +I.e., for each directory in `tramp-remote-path', it is tested +whether it exists and if so, it is added to the environment +variable PATH." + (tramp-message vec 5 (format "Setting $PATH environment variable")) + (tramp-send-command + vec (format "PATH=%s; export PATH" + (mapconcat 'identity (tramp-get-remote-path vec) ":")))) + +;; ------------------------------------------------------------ +;; -- Communication with external shell -- +;; ------------------------------------------------------------ + +(defun tramp-find-file-exists-command (vec) + "Find a command on the remote host for checking if a file exists. +Here, we are looking for a command which has zero exit status if the +file exists and nonzero exit status otherwise." + (let ((existing "/") + (nonexisting + (tramp-shell-quote-argument "/ this file does not exist ")) + result) + ;; The algorithm is as follows: we try a list of several commands. + ;; For each command, we first run `$cmd /' -- this should return + ;; true, as the root directory always exists. And then we run + ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed + ;; does not exist. This should return false. We use the first + ;; command we find that seems to work. + ;; The list of commands to try is as follows: + ;; `ls -d' This works on most systems, but NetBSD 1.4 + ;; has a bug: `ls' always returns zero exit + ;; status, even for files which don't exist. + ;; `test -e' Some Bourne shells have a `test' builtin + ;; which does not know the `-e' option. + ;; `/bin/test -e' For those, the `test' binary on disk normally + ;; provides the option. Alas, the binary + ;; is sometimes `/bin/test' and sometimes it's + ;; `/usr/bin/test'. + ;; `/usr/bin/test -e' In case `/bin/test' does not exist. + (unless (or + (and (setq result (format "%s -e" (tramp-get-test-command vec))) + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexisting)))) + (and (setq result "/bin/test -e") + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexisting)))) + (and (setq result "/usr/bin/test -e") + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexisting)))) + (and (setq result (format "%s -d" (tramp-get-ls-command vec))) + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexisting))))) + (tramp-error + vec 'file-error "Couldn't find command to check if file exists")) + result)) + +(defun tramp-open-shell (vec shell) + "Opens shell SHELL." + (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell) + ;; Find arguments for this shell. + (let ((tramp-end-of-output tramp-initial-end-of-output) + (alist tramp-sh-extra-args) + item extra-args) + (while (and alist (null extra-args)) + (setq item (pop alist)) + (when (string-match (car item) shell) + (setq extra-args (cdr item)))) + (when extra-args (setq shell (concat shell " " extra-args))) + (tramp-send-command + vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s" + (shell-quote-argument tramp-end-of-output) shell) + t)) + ;; Setting prompts. + (tramp-send-command + vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) + (tramp-send-command vec "PS2=''" t) + (tramp-send-command vec "PS3=''" t) + (tramp-send-command vec "PROMPT_COMMAND=''" t))) + +(defun tramp-find-shell (vec) + "Opens a shell on the remote host which groks tilde expansion." + (unless (tramp-get-connection-property vec "remote-shell" nil) + (let (shell) + (with-current-buffer (tramp-get-buffer vec) + (tramp-send-command vec "echo ~root" t) + (cond + ((or (string-match "^~root$" (buffer-string)) + ;; The default shell (ksh93) of OpenSolaris is buggy. + (string-equal (tramp-get-connection-property vec "uname" "") + "SunOS 5.11")) + (setq shell + (or (tramp-find-executable + vec "bash" (tramp-get-remote-path vec) t t) + (tramp-find-executable + vec "ksh" (tramp-get-remote-path vec) t t))) + (unless shell + (tramp-error + vec 'file-error + "Couldn't find a shell which groks tilde expansion")) + (tramp-message + vec 5 "Starting remote shell `%s' for tilde expansion" shell) + (tramp-open-shell vec shell)) + + (t (tramp-message + vec 5 "Remote `%s' groks tilde expansion, good" + (tramp-set-connection-property + vec "remote-shell" + (tramp-get-method-parameter + (tramp-file-name-method vec) 'tramp-remote-sh))))))))) + +;; Utility functions. + +(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args) + "Wait for shell prompt and barf if none appears. +Looks at process PROC to see if a shell prompt appears in TIMEOUT +seconds. If not, it produces an error message with the given ERROR-ARGS." + (unless + (tramp-wait-for-regexp + proc timeout + (format + "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) + +(defun tramp-open-connection-setup-interactive-shell (proc vec) + "Set up an interactive shell. +Mainly sets the prompt and the echo correctly. PROC is the shell +process to set up. VEC specifies the connection." + (let ((tramp-end-of-output tramp-initial-end-of-output)) + ;; It is useful to set the prompt in the following command because + ;; some people have a setting for $PS1 which /bin/sh doesn't know + ;; about and thus /bin/sh will display a strange prompt. For + ;; example, if $PS1 has "${CWD}" in the value, then ksh will + ;; display the current working directory but /bin/sh will display + ;; a dollar sign. The following command line sets $PS1 to a sane + ;; value, and works under Bourne-ish shells as well as csh-like + ;; shells. Daniel Pittman reports that the unusual positioning of + ;; the single quotes makes it work under `rc', too. We also unset + ;; the variable $ENV because that is read by some sh + ;; implementations (eg, bash when called as sh) on startup; this + ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND + ;; is another way to set the prompt in /bin/bash, it must be + ;; discarded as well. + (tramp-open-shell + vec + (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh)) + + ;; Disable echo. + (tramp-message vec 5 "Setting up remote shell environment") + (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t) + ;; Check whether the echo has really been disabled. Some + ;; implementations, like busybox of embedded GNU/Linux, don't + ;; support disabling. + (tramp-send-command vec "echo foo" t) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (when (looking-at "echo foo") + (tramp-set-connection-property proc "remote-echo" t) + (tramp-message vec 5 "Remote echo still on. Ok.") + ;; Make sure backspaces and their echo are enabled and no line + ;; width magic interferes with them. + (tramp-send-command vec "stty icanon erase ^H cols 32767" t)))) + + (tramp-message vec 5 "Setting shell prompt") + (tramp-send-command + vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) + (tramp-send-command vec "PS2=''" t) + (tramp-send-command vec "PS3=''" t) + (tramp-send-command vec "PROMPT_COMMAND=''" t) + + ;; Try to set up the coding system correctly. + ;; CCC this can't be the right way to do it. Hm. + (tramp-message vec 5 "Determining coding system") + (tramp-send-command vec "echo foo ; echo bar" t) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (if (featurep 'mule) + ;; Use MULE to select the right EOL convention for communicating + ;; with the process. + (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc) + (cons 'undecided 'undecided))) + cs-decode cs-encode) + (when (symbolp cs) (setq cs (cons cs cs))) + (setq cs-decode (car cs)) + (setq cs-encode (cdr cs)) + (unless cs-decode (setq cs-decode 'undecided)) + (unless cs-encode (setq cs-encode 'undecided)) + (setq cs-encode (tramp-coding-system-change-eol-conversion + cs-encode 'unix)) + (when (search-forward "\r" nil t) + (setq cs-decode (tramp-coding-system-change-eol-conversion + cs-decode 'dos))) + (tramp-compat-funcall + 'set-buffer-process-coding-system cs-decode cs-encode) + (tramp-message + vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)) + ;; Look for ^M and do something useful if found. + (when (search-forward "\r" nil t) + ;; We have found a ^M but cannot frob the process coding system + ;; because we're running on a non-MULE Emacs. Let's try + ;; stty, instead. + (tramp-send-command vec "stty -onlcr" t)))) + ;; Dump stty settings in the traces. + (when (>= tramp-verbose 9) + (tramp-send-command vec "stty -a" t)) + (tramp-send-command vec "set +o vi +o emacs" t) + + ;; Check whether the output of "uname -sr" has been changed. If + ;; yes, this is a strong indication that we must expire all + ;; connection properties. We start again with + ;; `tramp-maybe-open-connection', it will be catched there. + (tramp-message vec 5 "Checking system information") + (let ((old-uname (tramp-get-connection-property vec "uname" nil)) + (new-uname + (tramp-set-connection-property + vec "uname" + (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) + (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) + (with-current-buffer (tramp-get-debug-buffer vec) + ;; Keep the debug buffer. + (rename-buffer + (generate-new-buffer-name tramp-temp-buffer-name) 'unique) + (tramp-compat-funcall 'tramp-cleanup-connection vec) + (if (= (point-min) (point-max)) + (kill-buffer nil) + (rename-buffer (tramp-debug-buffer-name vec) 'unique)) + ;; We call `tramp-get-buffer' in order to keep the debug buffer. + (tramp-get-buffer vec) + (tramp-message + vec 3 + "Connection reset, because remote host changed from `%s' to `%s'" + old-uname new-uname) + (throw 'uname-changed (tramp-maybe-open-connection vec))))) + + ;; Check whether the remote host suffers from buggy + ;; `send-process-string'. This is known for FreeBSD (see comment in + ;; `send_process', file process.c). I've tested sending 624 bytes + ;; successfully, sending 625 bytes failed. Emacs makes a hack when + ;; this host type is detected locally. It cannot handle remote + ;; hosts, though. + (with-connection-property proc "chunksize" + (cond + ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) + tramp-chunksize) + (t + (tramp-message + vec 5 "Checking remote host type for `send-process-string' bug") + (if (string-match + "^FreeBSD" (tramp-get-connection-property vec "uname" "")) + 500 0)))) + + ;; Set remote PATH variable. + (tramp-set-remote-path vec) + + ;; Search for a good shell before searching for a command which + ;; checks if a file exists. This is done because Tramp wants to use + ;; "test foo; echo $?" to check if various conditions hold, and + ;; there are buggy /bin/sh implementations which don't execute the + ;; "echo $?" part if the "test" part has an error. In particular, + ;; the OpenSolaris /bin/sh is a problem. There are also other + ;; problems with /bin/sh of OpenSolaris, like redirection of stderr + ;; in function declarations, or changing HISTFILE in place. + ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when + ;; detected. + (tramp-find-shell vec) + + ;; Disable unexpected output. + (tramp-send-command vec "mesg n; biff n" t) + + ;; IRIX64 bash expands "!" even when in single quotes. This + ;; destroys our shell functions, we must disable it. See + ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. + (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" "")) + (tramp-send-command vec "set +H" t)) + + ;; Set `remote-tty' process property. + (ignore-errors + (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""))) + (unless (zerop (length tty)) + (tramp-compat-process-put proc 'remote-tty tty)))) + + ;; Set the environment. + (tramp-message vec 5 "Setting default environment") + + (let ((env (copy-sequence tramp-remote-process-environment)) + unset item) + (while env + (setq item (tramp-compat-split-string (car env) "=")) + (setcdr item (mapconcat 'identity (cdr item) "=")) + (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) + (tramp-send-command + vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t) + (push (car item) unset)) + (setq env (cdr env))) + (when unset + (tramp-send-command + vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) + +;; CCC: We should either implement a Perl version of base64 encoding +;; and decoding. Then we just use that in the last item. The other +;; alternative is to use the Perl version of UU encoding. But then +;; we need a Lisp version of uuencode. +;; +;; Old text from documentation of tramp-methods: +;; Using a uuencode/uudecode inline method is discouraged, please use one +;; of the base64 methods instead since base64 encoding is much more +;; reliable and the commands are more standardized between the different +;; Unix versions. But if you can't use base64 for some reason, please +;; note that the default uudecode command does not work well for some +;; Unices, in particular AIX and Irix. For AIX, you might want to use +;; the following command for uudecode: +;; +;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1 +;; +;; For Irix, no solution is known yet. + +(autoload 'uudecode-decode-region "uudecode") + +(defconst tramp-local-coding-commands + '((b64 base64-encode-region base64-decode-region) + (uu tramp-uuencode-region uudecode-decode-region) + (pack + "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" + "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) + "List of local coding commands for inline transfer. +Each item is a list that looks like this: + +\(FORMAT ENCODING DECODING\) + +FORMAT is symbol describing the encoding/decoding format. It can be +`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. + +ENCODING and DECODING can be strings, giving commands, or symbols, +giving functions. If they are strings, then they can contain +the \"%s\" format specifier. If that specifier is present, the input +filename will be put into the command line at that spot. If the +specifier is not present, the input should be read from standard +input. + +If they are functions, they will be called with two arguments, start +and end of region, and are expected to replace the region contents +with the encoded or decoded results, respectively.") + +(defconst tramp-remote-coding-commands + '((b64 "base64" "base64 -d") + (b64 "mimencode -b" "mimencode -u -b") + (b64 "mmencode -b" "mmencode -u -b") + (b64 "recode data..base64" "recode base64..data") + (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module) + (b64 tramp-perl-encode tramp-perl-decode) + (uu "uuencode xxx" "uudecode -o /dev/stdout") + (uu "uuencode xxx" "uudecode -o -") + (uu "uuencode xxx" "uudecode -p") + (uu "uuencode xxx" tramp-uudecode) + (pack + "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" + "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) + "List of remote coding commands for inline transfer. +Each item is a list that looks like this: + +\(FORMAT ENCODING DECODING\) + +FORMAT is symbol describing the encoding/decoding format. It can be +`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. + +ENCODING and DECODING can be strings, giving commands, or symbols, +giving variables. If they are strings, then they can contain +the \"%s\" format specifier. If that specifier is present, the input +filename will be put into the command line at that spot. If the +specifier is not present, the input should be read from standard +input. + +If they are variables, this variable is a string containing a Perl +implementation for this functionality. This Perl program will be transferred +to the remote host, and it is available as shell function with the same name.") + +(defun tramp-find-inline-encoding (vec) + "Find an inline transfer encoding that works. +Goes through the list `tramp-local-coding-commands' and +`tramp-remote-coding-commands'." + (save-excursion + (let ((local-commands tramp-local-coding-commands) + (magic "xyzzy") + loc-enc loc-dec rem-enc rem-dec litem ritem found) + (while (and local-commands (not found)) + (setq litem (pop local-commands)) + (catch 'wont-work-local + (let ((format (nth 0 litem)) + (remote-commands tramp-remote-coding-commands)) + (setq loc-enc (nth 1 litem)) + (setq loc-dec (nth 2 litem)) + ;; If the local encoder or decoder is a string, the + ;; corresponding command has to work locally. + (if (not (stringp loc-enc)) + (tramp-message + vec 5 "Checking local encoding function `%s'" loc-enc) + (tramp-message + vec 5 "Checking local encoding command `%s' for sanity" loc-enc) + (unless (zerop (tramp-call-local-coding-command + loc-enc nil nil)) + (throw 'wont-work-local nil))) + (if (not (stringp loc-dec)) + (tramp-message + vec 5 "Checking local decoding function `%s'" loc-dec) + (tramp-message + vec 5 "Checking local decoding command `%s' for sanity" loc-dec) + (unless (zerop (tramp-call-local-coding-command + loc-dec nil nil)) + (throw 'wont-work-local nil))) + ;; Search for remote coding commands with the same format + (while (and remote-commands (not found)) + (setq ritem (pop remote-commands)) + (catch 'wont-work-remote + (when (equal format (nth 0 ritem)) + (setq rem-enc (nth 1 ritem)) + (setq rem-dec (nth 2 ritem)) + ;; Check if remote encoding and decoding commands can be + ;; called remotely with null input and output. This makes + ;; sure there are no syntax errors and the command is really + ;; found. Note that we do not redirect stdout to /dev/null, + ;; for two reasons: when checking the decoding command, we + ;; actually check the output it gives. And also, when + ;; redirecting "mimencode" output to /dev/null, then as root + ;; it might change the permissions of /dev/null! + (when (not (stringp rem-enc)) + (let ((name (symbol-name rem-enc))) + (while (string-match (regexp-quote "-") name) + (setq name (replace-match "_" nil t name))) + (tramp-maybe-send-script vec (symbol-value rem-enc) name) + (setq rem-enc name))) + (tramp-message + vec 5 + "Checking remote encoding command `%s' for sanity" rem-enc) + (unless (tramp-send-command-and-check + vec (format "%s </dev/null" rem-enc) t) + (throw 'wont-work-remote nil)) + + (when (not (stringp rem-dec)) + (let ((name (symbol-name rem-dec))) + (while (string-match (regexp-quote "-") name) + (setq name (replace-match "_" nil t name))) + (tramp-maybe-send-script vec (symbol-value rem-dec) name) + (setq rem-dec name))) + (tramp-message + vec 5 + "Checking remote decoding command `%s' for sanity" rem-dec) + (unless (tramp-send-command-and-check + vec + (format "echo %s | %s | %s" magic rem-enc rem-dec) + t) + (throw 'wont-work-remote nil)) + + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (unless (looking-at (regexp-quote magic)) + (throw 'wont-work-remote nil))) + + ;; `rem-enc' and `rem-dec' could be a string meanwhile. + (setq rem-enc (nth 1 ritem)) + (setq rem-dec (nth 2 ritem)) + (setq found t))))))) + + ;; Did we find something? + (unless found + (tramp-error + vec 'file-error "Couldn't find an inline transfer encoding")) + + ;; Set connection properties. + (tramp-message vec 5 "Using local encoding `%s'" loc-enc) + (tramp-set-connection-property vec "local-encoding" loc-enc) + (tramp-message vec 5 "Using local decoding `%s'" loc-dec) + (tramp-set-connection-property vec "local-decoding" loc-dec) + (tramp-message vec 5 "Using remote encoding `%s'" rem-enc) + (tramp-set-connection-property vec "remote-encoding" rem-enc) + (tramp-message vec 5 "Using remote decoding `%s'" rem-dec) + (tramp-set-connection-property vec "remote-decoding" rem-dec)))) + +(defun tramp-call-local-coding-command (cmd input output) + "Call the local encoding or decoding command. +If CMD contains \"%s\", provide input file INPUT there in command. +Otherwise, INPUT is passed via standard input. +INPUT can also be nil which means `/dev/null'. +OUTPUT can be a string (which specifies a filename), or t (which +means standard output and thus the current buffer), or nil (which +means discard it)." + (tramp-compat-call-process + tramp-encoding-shell + (when (and input (not (string-match "%s" cmd))) input) + (if (eq output t) t nil) + nil + tramp-encoding-command-switch + (concat + (if (string-match "%s" cmd) (format cmd input) cmd) + (if (stringp output) (concat "> " output) "")))) + +(defconst tramp-inline-compress-commands + '(("gzip" "gzip -d") + ("bzip2" "bzip2 -d") + ("compress" "compress -d")) + "List of compress and decompress commands for inline transfer. +Each item is a list that looks like this: + +\(COMPRESS DECOMPRESS\) + +COMPRESS or DECOMPRESS are strings with the respective commands.") + +(defun tramp-find-inline-compress (vec) + "Find an inline transfer compress command that works. +Goes through the list `tramp-inline-compress-commands'." + (save-excursion + (let ((commands tramp-inline-compress-commands) + (magic "xyzzy") + item compress decompress + found) + (while (and commands (not found)) + (catch 'next + (setq item (pop commands) + compress (nth 0 item) + decompress (nth 1 item)) + (tramp-message + vec 5 + "Checking local compress command `%s', `%s' for sanity" + compress decompress) + (unless (zerop (tramp-call-local-coding-command + (format "echo %s | %s | %s" + magic compress decompress) nil nil)) + (throw 'next nil)) + (tramp-message + vec 5 + "Checking remote compress command `%s', `%s' for sanity" + compress decompress) + (unless (tramp-send-command-and-check + vec (format "echo %s | %s | %s" magic compress decompress) t) + (throw 'next nil)) + (setq found t))) + + ;; Did we find something? + (if found + (progn + ;; Set connection properties. + (tramp-message + vec 5 "Using inline transfer compress command `%s'" compress) + (tramp-set-connection-property vec "inline-compress" compress) + (tramp-message + vec 5 "Using inline transfer decompress command `%s'" decompress) + (tramp-set-connection-property vec "inline-decompress" decompress)) + + (tramp-set-connection-property vec "inline-compress" nil) + (tramp-set-connection-property vec "inline-decompress" nil) + (tramp-message + vec 2 "Couldn't find an inline transfer compress command"))))) + +(defun tramp-compute-multi-hops (vec) + "Expands VEC according to `tramp-default-proxies-alist'. +Gateway hops are already opened." + (let ((target-alist `(,vec)) + (choices tramp-default-proxies-alist) + item proxy) + + ;; Look for proxy hosts to be passed. + (while choices + (setq item (pop choices) + proxy (eval (nth 2 item))) + (when (and + ;; host + (string-match (or (eval (nth 0 item)) "") + (or (tramp-file-name-host (car target-alist)) "")) + ;; user + (string-match (or (eval (nth 1 item)) "") + (or (tramp-file-name-user (car target-alist)) ""))) + (if (null proxy) + ;; No more hops needed. + (setq choices nil) + ;; Replace placeholders. + (setq proxy + (format-spec + proxy + (format-spec-make + ?u (or (tramp-file-name-user (car target-alist)) "") + ?h (or (tramp-file-name-host (car target-alist)) "")))) + (with-parsed-tramp-file-name proxy l + ;; Add the hop. + (add-to-list 'target-alist l) + ;; Start next search. + (setq choices tramp-default-proxies-alist))))) + + ;; Handle gateways. + (when (string-match + (format + "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) + (tramp-file-name-method (car target-alist))) + (let ((gw (pop target-alist)) + (hop (pop target-alist))) + ;; Is the method prepared for gateways? + (unless (tramp-get-method-parameter + (tramp-file-name-method hop) 'tramp-default-port) + (tramp-error + vec 'file-error + "Method `%s' is not supported for gateway access." + (tramp-file-name-method hop))) + ;; Add default port if needed. + (unless + (string-match + tramp-host-with-port-regexp (tramp-file-name-host hop)) + (aset hop 2 + (concat + (tramp-file-name-host hop) tramp-prefix-port-format + (number-to-string + (tramp-get-method-parameter + (tramp-file-name-method hop) 'tramp-default-port))))) + ;; Open the gateway connection. + (add-to-list + 'target-alist + (vector + (tramp-file-name-method hop) (tramp-file-name-user hop) + (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil)) + ;; For the password prompt, we need the correct values. + ;; Therefore, we must remember the gateway vector. But we + ;; cannot do it as connection property, because it shouldn't + ;; be persistent. And we have no started process yet either. + (tramp-set-file-property (car target-alist) "" "gateway" hop))) + + ;; Foreign and out-of-band methods are not supported for multi-hops. + (when (cdr target-alist) + (setq choices target-alist) + (while choices + (setq item (pop choices)) + (when + (or + (not + (tramp-get-method-parameter + (tramp-file-name-method item) 'tramp-login-program)) + (tramp-get-method-parameter + (tramp-file-name-method item) 'tramp-copy-program)) + (tramp-error + vec 'file-error + "Method `%s' is not supported for multi-hops." + (tramp-file-name-method item))))) + + ;; In case the host name is not used for the remote shell + ;; command, the user could be misguided by applying a random + ;; hostname. + (let* ((v (car target-alist)) + (method (tramp-file-name-method v)) + (host (tramp-file-name-host v))) + (unless + (or + ;; There are multi-hops. + (cdr target-alist) + ;; The host name is used for the remote shell command. + (member + '("%h") (tramp-get-method-parameter method 'tramp-login-args)) + ;; The host is local. We cannot use `tramp-local-host-p' + ;; here, because it opens a connection as well. + (string-match tramp-local-host-regexp host)) + (tramp-error + v 'file-error + "Host `%s' looks like a remote host, `%s' can only use the local host" + host method))) + + ;; Result. + target-alist)) + +(defun tramp-maybe-open-connection (vec) + "Maybe open a connection VEC. +Does not do anything if a connection is already open, but re-opens the +connection if a previous connection has died for some reason." + (catch 'uname-changed + (let ((p (tramp-get-connection-process vec)) + (process-name (tramp-get-connection-property vec "process-name" nil)) + (process-environment (copy-sequence process-environment))) + + ;; If too much time has passed since last command was sent, look + ;; whether process is still alive. If it isn't, kill it. When + ;; using ssh, it can sometimes happen that the remote end has + ;; hung up but the local ssh client doesn't recognize this until + ;; it tries to send some data to the remote end. So that's why + ;; we try to send a command from time to time, then look again + ;; whether the process is really alive. + (condition-case nil + (when (and (> (tramp-time-diff + (current-time) + (tramp-get-connection-property + p "last-cmd-time" '(0 0 0))) + 60) + p (processp p) (memq (process-status p) '(run open))) + (tramp-send-command vec "echo are you awake" t t) + (unless (and (memq (process-status p) '(run open)) + (tramp-wait-for-output p 10)) + ;; The error will be catched locally. + (tramp-error vec 'file-error "Awake did fail"))) + (file-error + (tramp-flush-connection-property vec) + (tramp-flush-connection-property p) + (delete-process p) + (setq p nil))) + + ;; New connection must be opened. + (unless (and p (processp p) (memq (process-status p) '(run open))) + + ;; We call `tramp-get-buffer' in order to get a debug buffer for + ;; messages from the beginning. + (tramp-get-buffer vec) + (with-progress-reporter + vec 3 + (if (zerop (length (tramp-file-name-user vec))) + (format "Opening connection for %s using %s" + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection for %s@%s using %s" + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + + ;; Start new process. + (when (and p (processp p)) + (delete-process p)) + (setenv "TERM" tramp-terminal-type) + (setenv "LC_ALL" "C") + (setenv "PROMPT_COMMAND") + (setenv "PS1" tramp-initial-end-of-output) + (let* ((target-alist (tramp-compute-multi-hops vec)) + (process-connection-type tramp-process-connection-type) + (process-adaptive-read-buffering nil) + (coding-system-for-read nil) + ;; This must be done in order to avoid our file name handler. + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (start-process + (or process-name (tramp-buffer-name vec)) + (tramp-get-connection-buffer vec) + tramp-encoding-shell)))) + + (tramp-message + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + + ;; Check whether process is alive. + (tramp-set-process-query-on-exit-flag p nil) + (tramp-barf-if-no-shell-prompt + p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell) + + ;; Now do all the connections as specified. + (while target-alist + (let* ((hop (car target-alist)) + (l-method (tramp-file-name-method hop)) + (l-user (tramp-file-name-user hop)) + (l-host (tramp-file-name-host hop)) + (l-port nil) + (login-program + (tramp-get-method-parameter + l-method 'tramp-login-program)) + (login-args + (tramp-get-method-parameter l-method 'tramp-login-args)) + (async-args + (tramp-get-method-parameter l-method 'tramp-async-args)) + (gw-args + (tramp-get-method-parameter l-method 'tramp-gw-args)) + (gw (tramp-get-file-property hop "" "gateway" nil)) + (g-method (and gw (tramp-file-name-method gw))) + (g-user (and gw (tramp-file-name-user gw))) + (g-host (and gw (tramp-file-name-host gw))) + (command login-program) + ;; We don't create the temporary file. In fact, + ;; it is just a prefix for the ControlPath option + ;; of ssh; the real temporary file has another + ;; name, and it is created and protected by ssh. + ;; It is also removed by ssh, when the connection + ;; is closed. + (tmpfile + (tramp-set-connection-property + p "temp-file" + (make-temp-name + (expand-file-name + tramp-temp-name-prefix + (tramp-compat-temporary-file-directory))))) + spec) + + ;; Add arguments for asynchrononous processes. + (when (and process-name async-args) + (setq login-args (append async-args login-args))) + + ;; Add gateway arguments if necessary. + (when (and gw gw-args) + (setq login-args (append gw-args login-args))) + + ;; Check for port number. Until now, there's no need + ;; for handling like method, user, host. + (when (string-match tramp-host-with-port-regexp l-host) + (setq l-port (match-string 2 l-host) + l-host (match-string 1 l-host))) + + ;; Set variables for computing the prompt for reading + ;; password. They can also be derived from a gateway. + (setq tramp-current-method (or g-method l-method) + tramp-current-user (or g-user l-user) + tramp-current-host (or g-host l-host)) + + ;; Replace login-args place holders. + (setq + l-host (or l-host "") + l-user (or l-user "") + l-port (or l-port "") + spec (format-spec-make + ?h l-host ?u l-user ?p l-port ?t tmpfile) + command + (concat + ;; We do not want to see the trailing local prompt in + ;; `start-file-process'. + (unless (memq system-type '(windows-nt)) "exec ") + command " " + (mapconcat + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) (mapconcat 'identity x " "))) + login-args " ") + ;; Local shell could be a Windows COMSPEC. It + ;; doesn't know the ";" syntax, but we must exit + ;; always for `start-file-process'. "exec" does not + ;; work either. + (if (memq system-type '(windows-nt)) " && exit || exit"))) + + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-send-command vec command t t) + (tramp-process-actions p vec tramp-actions-before-shell 60) + (tramp-message + vec 3 "Found remote shell prompt on `%s'" l-host)) + ;; Next hop. + (setq target-alist (cdr target-alist))) + + ;; Make initial shell settings. + (tramp-open-connection-setup-interactive-shell p vec))))))) + +(defun tramp-send-command (vec command &optional neveropen nooutput) + "Send the COMMAND to connection VEC. +Erases temporary buffer before sending the command. If optional +arg NEVEROPEN is non-nil, never try to open the connection. This +is meant to be used from `tramp-maybe-open-connection' only. The +function waits for output unless NOOUTPUT is set." + (unless neveropen (tramp-maybe-open-connection vec)) + (let ((p (tramp-get-connection-process vec))) + (when (tramp-get-connection-property p "remote-echo" nil) + ;; We mark the command string that it can be erased in the output buffer. + (tramp-set-connection-property p "check-remote-echo" t) + (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark))) + (tramp-message vec 6 "%s" command) + (tramp-send-string vec command) + (unless nooutput (tramp-wait-for-output p)))) + +(defun tramp-wait-for-output (proc &optional timeout) + "Wait for output from remote command." + (unless (buffer-live-p (process-buffer proc)) + (delete-process proc) + (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) + (with-current-buffer (process-buffer proc) + (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might + ;; be leading escape sequences, which must be ignored. + (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) + ;; Sometimes, the commands do not return a newline but a + ;; null byte before the shell prompt, for example "git + ;; ls-files -c -z ...". + (regexp1 (format "\\(^\\|\000\\)%s" regexp)) + (found (tramp-wait-for-regexp proc timeout regexp1))) + (if found + (let (buffer-read-only) + ;; A simple-minded busybox has sent " ^H" sequences. + ;; Delete them. + (goto-char (point-min)) + (when (re-search-forward + "^\\(.\b\\)+$" (tramp-compat-line-end-position) t) + (forward-line 1) + (delete-region (point-min) (point))) + ;; Delete the prompt. + (goto-char (point-max)) + (re-search-backward regexp nil t) + (delete-region (point) (point-max))) + (if timeout + (tramp-error + proc 'file-error + "[[Remote prompt `%s' not found in %d secs]]" + tramp-end-of-output timeout) + (tramp-error + proc 'file-error + "[[Remote prompt `%s' not found]]" tramp-end-of-output))) + ;; Return value is whether end-of-output sentinel was found. + found))) + +(defun tramp-send-command-and-check + (vec command &optional subshell dont-suppress-err) + "Run COMMAND and check its exit status. +Sends `echo $?' along with the COMMAND for checking the exit status. If +COMMAND is nil, just sends `echo $?'. Returns the exit status found. + +If the optional argument SUBSHELL is non-nil, the command is +executed in a subshell, ie surrounded by parentheses. If +DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null." + (tramp-send-command + vec + (concat (if subshell "( " "") + command + (if command (if dont-suppress-err "; " " 2>/dev/null; ") "") + "echo tramp_exit_status $?" + (if subshell " )" ""))) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-max)) + (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) + (tramp-error + vec 'file-error "Couldn't find exit status of `%s'" command)) + (skip-chars-forward "^ ") + (prog1 + (zerop (read (current-buffer))) + (let (buffer-read-only) + (delete-region (match-beginning 0) (point-max)))))) + +(defun tramp-barf-unless-okay (vec command fmt &rest args) + "Run COMMAND, check exit status, throw error if exit status not okay. +Similar to `tramp-send-command-and-check' but accepts two more arguments +FMT and ARGS which are passed to `error'." + (unless (tramp-send-command-and-check vec command) + (apply 'tramp-error vec 'file-error fmt args))) + +(defun tramp-send-command-and-read (vec command) + "Run COMMAND and return the output, which must be a Lisp expression. +In case there is no valid Lisp expression, it raises an error" + (tramp-barf-unless-okay vec command "`%s' returns with error" command) + (with-current-buffer (tramp-get-connection-buffer vec) + ;; Read the expression. + (goto-char (point-min)) + (condition-case nil + (prog1 (read (current-buffer)) + ;; Error handling. + (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t) + (error nil))) + (error (tramp-error + vec 'file-error + "`%s' does not return a valid Lisp expression: `%s'" + command (buffer-string)))))) + +(defun tramp-mode-string-to-int (mode-string) + "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits." + (let* (case-fold-search + (mode-chars (string-to-vector mode-string)) + (owner-read (aref mode-chars 1)) + (owner-write (aref mode-chars 2)) + (owner-execute-or-setid (aref mode-chars 3)) + (group-read (aref mode-chars 4)) + (group-write (aref mode-chars 5)) + (group-execute-or-setid (aref mode-chars 6)) + (other-read (aref mode-chars 7)) + (other-write (aref mode-chars 8)) + (other-execute-or-sticky (aref mode-chars 9))) + (save-match-data + (logior + (cond + ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400")) + ((char-equal owner-read ?-) 0) + (t (error "Second char `%c' must be one of `r-'" owner-read))) + (cond + ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200")) + ((char-equal owner-write ?-) 0) + (t (error "Third char `%c' must be one of `w-'" owner-write))) + (cond + ((char-equal owner-execute-or-setid ?x) + (tramp-compat-octal-to-decimal "00100")) + ((char-equal owner-execute-or-setid ?S) + (tramp-compat-octal-to-decimal "04000")) + ((char-equal owner-execute-or-setid ?s) + (tramp-compat-octal-to-decimal "04100")) + ((char-equal owner-execute-or-setid ?-) 0) + (t (error "Fourth char `%c' must be one of `xsS-'" + owner-execute-or-setid))) + (cond + ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040")) + ((char-equal group-read ?-) 0) + (t (error "Fifth char `%c' must be one of `r-'" group-read))) + (cond + ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020")) + ((char-equal group-write ?-) 0) + (t (error "Sixth char `%c' must be one of `w-'" group-write))) + (cond + ((char-equal group-execute-or-setid ?x) + (tramp-compat-octal-to-decimal "00010")) + ((char-equal group-execute-or-setid ?S) + (tramp-compat-octal-to-decimal "02000")) + ((char-equal group-execute-or-setid ?s) + (tramp-compat-octal-to-decimal "02010")) + ((char-equal group-execute-or-setid ?-) 0) + (t (error "Seventh char `%c' must be one of `xsS-'" + group-execute-or-setid))) + (cond + ((char-equal other-read ?r) + (tramp-compat-octal-to-decimal "00004")) + ((char-equal other-read ?-) 0) + (t (error "Eighth char `%c' must be one of `r-'" other-read))) + (cond + ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002")) + ((char-equal other-write ?-) 0) + (t (error "Nineth char `%c' must be one of `w-'" other-write))) + (cond + ((char-equal other-execute-or-sticky ?x) + (tramp-compat-octal-to-decimal "00001")) + ((char-equal other-execute-or-sticky ?T) + (tramp-compat-octal-to-decimal "01000")) + ((char-equal other-execute-or-sticky ?t) + (tramp-compat-octal-to-decimal "01001")) + ((char-equal other-execute-or-sticky ?-) 0) + (t (error "Tenth char `%c' must be one of `xtT-'" + other-execute-or-sticky))))))) + +(defun tramp-convert-file-attributes (vec attr) + "Convert file-attributes ATTR generated by perl script, stat or ls. +Convert file mode bits to string and set virtual device number. +Return ATTR." + (when attr + ;; Convert last access time. + (unless (listp (nth 4 attr)) + (setcar (nthcdr 4 attr) + (list (floor (nth 4 attr) 65536) + (floor (mod (nth 4 attr) 65536))))) + ;; Convert last modification time. + (unless (listp (nth 5 attr)) + (setcar (nthcdr 5 attr) + (list (floor (nth 5 attr) 65536) + (floor (mod (nth 5 attr) 65536))))) + ;; Convert last status change time. + (unless (listp (nth 6 attr)) + (setcar (nthcdr 6 attr) + (list (floor (nth 6 attr) 65536) + (floor (mod (nth 6 attr) 65536))))) + ;; Convert file size. + (when (< (nth 7 attr) 0) + (setcar (nthcdr 7 attr) -1)) + (when (and (floatp (nth 7 attr)) + (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) + (setcar (nthcdr 7 attr) (round (nth 7 attr)))) + ;; Convert file mode bits to string. + (unless (stringp (nth 8 attr)) + (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) + (when (stringp (car attr)) + (aset (nth 8 attr) 0 ?l))) + ;; Convert directory indication bit. + (when (string-match "^d" (nth 8 attr)) + (setcar attr t)) + ;; Convert symlink from `tramp-do-file-attributes-with-stat'. + (when (consp (car attr)) + (if (and (stringp (caar attr)) + (string-match ".+ -> .\\(.+\\)." (caar attr))) + (setcar attr (match-string 1 (caar attr))) + (setcar attr nil))) + ;; Set file's gid change bit. + (setcar (nthcdr 9 attr) + (if (numberp (nth 3 attr)) + (not (= (nth 3 attr) + (tramp-get-remote-gid vec 'integer))) + (not (string-equal + (nth 3 attr) + (tramp-get-remote-gid vec 'string))))) + ;; Convert inode. + (unless (listp (nth 10 attr)) + (setcar (nthcdr 10 attr) + (condition-case nil + (cons (floor (nth 10 attr) 65536) + (floor (mod (nth 10 attr) 65536))) + ;; Inodes can be incredible huge. We must hide this. + (error (tramp-get-inode vec))))) + ;; Set virtual device number. + (setcar (nthcdr 11 attr) + (tramp-get-device vec)) + attr)) + +(defun tramp-check-cached-permissions (vec access) + "Check `file-attributes' caches for VEC. +Return t if according to the cache access type ACCESS is known to +be granted." + (let ((result nil) + (offset (cond + ((eq ?r access) 1) + ((eq ?w access) 2) + ((eq ?x access) 3)))) + (dolist (suffix '("string" "integer") result) + (setq + result + (or + result + (let ((file-attr + (tramp-get-file-property + vec (tramp-file-name-localname vec) + (concat "file-attributes-" suffix) nil)) + (remote-uid + (tramp-get-connection-property + vec (concat "uid-" suffix) nil)) + (remote-gid + (tramp-get-connection-property + vec (concat "gid-" suffix) nil))) + (and + file-attr + (or + ;; Not a symlink + (eq t (car file-attr)) + (null (car file-attr))) + (or + ;; World accessible. + (eq access (aref (nth 8 file-attr) (+ offset 6))) + ;; User accessible and owned by user. + (and + (eq access (aref (nth 8 file-attr) offset)) + (equal remote-uid (nth 2 file-attr))) + ;; Group accessible and owned by user's + ;; principal group. + (and + (eq access (aref (nth 8 file-attr) (+ offset 3))) + (equal remote-gid (nth 3 file-attr))))))))))) + +(defun tramp-file-mode-from-int (mode) + "Turn an integer representing a file mode into an ls(1)-like string." + (let ((type (cdr + (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) + (user (logand (lsh mode -6) 7)) + (group (logand (lsh mode -3) 7)) + (other (logand (lsh mode -0) 7)) + (suid (> (logand (lsh mode -9) 4) 0)) + (sgid (> (logand (lsh mode -9) 2) 0)) + (sticky (> (logand (lsh mode -9) 1) 0))) + (setq user (tramp-file-mode-permissions user suid "s")) + (setq group (tramp-file-mode-permissions group sgid "s")) + (setq other (tramp-file-mode-permissions other sticky "t")) + (concat type user group other))) + +(defun tramp-file-mode-permissions (perm suid suid-text) + "Convert a permission bitset into a string. +This is used internally by `tramp-file-mode-from-int'." + (let ((r (> (logand perm 4) 0)) + (w (> (logand perm 2) 0)) + (x (> (logand perm 1) 0))) + (concat (or (and r "r") "-") + (or (and w "w") "-") + (or (and suid x suid-text) ; suid, execute + (and suid (upcase suid-text)) ; suid, !execute + (and x "x") "-")))) ; !suid + +(defun tramp-shell-case-fold (string) + "Converts STRING to shell glob pattern which ignores case." + (mapconcat + (lambda (c) + (if (equal (downcase c) (upcase c)) + (vector c) + (format "[%c%c]" (downcase c) (upcase c)))) + string + "")) + +(defun tramp-make-copy-program-file-name (vec) + "Create a file name suitable to be passed to `rcp' and workalikes." + (let ((user (tramp-file-name-user vec)) + (host (tramp-file-name-real-host vec)) + (localname (tramp-shell-quote-argument + (tramp-file-name-localname vec)))) + (if (not (zerop (length user))) + (format "%s@%s:%s" user host localname) + (format "%s:%s" host localname)))) + +(defun tramp-method-out-of-band-p (vec size) + "Return t if this is an out-of-band method, nil otherwise." + (and + ;; It shall be an out-of-band method. + (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program) + ;; Either the file size is large enough, or (in rare cases) there + ;; does not exist a remote encoding. + (or (null tramp-copy-size-limit) + (> size tramp-copy-size-limit) + (null (tramp-get-inline-coding vec "remote-encoding" size))))) + +(defun tramp-local-host-p (vec) + "Return t if this points to the local host, nil otherwise." + ;; We cannot use `tramp-file-name-real-host'. A port is an + ;; indication for an ssh tunnel or alike. + (let ((host (tramp-file-name-host vec))) + (and + (stringp host) + (string-match tramp-local-host-regexp host) + ;; The method shall be applied to one of the shell file name + ;; handler. `tramp-local-host-p' is also called for "smb" and + ;; alike, where it must fail. + (tramp-get-method-parameter + (tramp-file-name-method vec) 'tramp-login-program) + ;; The local temp directory must be writable for the other user. + (file-writable-p + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + host + (tramp-compat-temporary-file-directory))) + ;; On some systems, chown runs only for root. + (or (zerop (user-uid)) + (zerop (tramp-get-remote-uid vec 'integer)))))) + +;; Variables local to connection. + +(defun tramp-get-remote-path (vec) + (with-connection-property + ;; When `tramp-own-remote-path' is in `tramp-remote-path', we + ;; cache the result for the session only. Otherwise, the result + ;; is cached persistently. + (if (memq 'tramp-own-remote-path tramp-remote-path) + (tramp-get-connection-process vec) + vec) + "remote-path" + (let* ((remote-path (copy-tree tramp-remote-path)) + (elt1 (memq 'tramp-default-remote-path remote-path)) + (elt2 (memq 'tramp-own-remote-path remote-path)) + (default-remote-path + (when elt1 + (condition-case nil + (tramp-send-command-and-read + vec "echo \\\"`getconf PATH`\\\"") + ;; Default if "getconf" is not available. + (error + (tramp-message + vec 3 + "`getconf PATH' not successful, using default value \"%s\"." + "/bin:/usr/bin") + "/bin:/usr/bin")))) + (own-remote-path + (when elt2 + (condition-case nil + (tramp-send-command-and-read vec "echo \\\"$PATH\\\"") + ;; Default if "getconf" is not available. + (error + (tramp-message + vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.") + nil))))) + + ;; Replace place holder `tramp-default-remote-path'. + (when elt1 + (setcdr elt1 + (append + (tramp-compat-split-string default-remote-path ":") + (cdr elt1))) + (setq remote-path (delq 'tramp-default-remote-path remote-path))) + + ;; Replace place holder `tramp-own-remote-path'. + (when elt2 + (setcdr elt2 + (append + (tramp-compat-split-string own-remote-path ":") + (cdr elt2))) + (setq remote-path (delq 'tramp-own-remote-path remote-path))) + + ;; Remove double entries. + (setq elt1 remote-path) + (while (consp elt1) + (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1)))) + (setcar elt2 nil)) + (setq elt1 (cdr elt1))) + + ;; Remove non-existing directories. + (delq + nil + (mapcar + (lambda (x) + (and + (stringp x) + (file-directory-p + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + x)) + x)) + remote-path))))) + +(defun tramp-get-remote-tmpdir (vec) + (with-connection-property vec "tmp-directory" + (let ((dir (tramp-shell-quote-argument "/tmp"))) + (if (and (tramp-send-command-and-check + vec (format "%s -d %s" (tramp-get-test-command vec) dir)) + (tramp-send-command-and-check + vec (format "%s -w %s" (tramp-get-test-command vec) dir))) + dir + (tramp-error vec 'file-error "Directory %s not accessible" dir))))) + +(defun tramp-make-tramp-temp-file (vec) + "Create a temporary file on the remote host identified by VEC. +Return the local name of the temporary file." + (let ((prefix + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-drop-volume-letter + (expand-file-name + tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))) + result) + (while (not result) + ;; `make-temp-file' would be the natural choice for + ;; implementation. But it calls `write-region' internally, + ;; which also needs a temporary file - we would end in an + ;; infinite loop. + (setq result (make-temp-name prefix)) + (if (file-exists-p result) + (setq result nil) + ;; This creates the file by side effect. + (set-file-times result) + (set-file-modes result (tramp-compat-octal-to-decimal "0700")))) + + ;; Return the local part. + (with-parsed-tramp-file-name result nil localname))) + +(defun tramp-get-ls-command (vec) + (with-connection-property vec "ls" + (tramp-message vec 5 "Finding a suitable `ls' command") + (or + (catch 'ls-found + (dolist (cmd '("ls" "gnuls" "gls")) + (let ((dl (tramp-get-remote-path vec)) + result) + (while (and dl (setq result (tramp-find-executable vec cmd dl t t))) + ;; Check parameters. On busybox, "ls" output coloring is + ;; enabled by default sometimes. So we try to disable it + ;; when possible. $LS_COLORING is not supported there. + ;; Some "ls" versions are sensible wrt the order of + ;; arguments, they fail when "-al" is after the + ;; "--color=never" argument (for example on FreeBSD). + (when (tramp-send-command-and-check + vec (format "%s -lnd /" result)) + (when (tramp-send-command-and-check + vec (format + "%s --color=never -al /dev/null" result)) + (setq result (concat result " --color=never"))) + (throw 'ls-found result)) + (setq dl (cdr dl)))))) + (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) + +(defun tramp-get-ls-command-with-dired (vec) + (save-match-data + (with-connection-property vec "ls-dired" + (tramp-message vec 5 "Checking, whether `ls --dired' works") + ;; Some "ls" versions are sensible wrt the order of arguments, + ;; they fail when "-al" is after the "--dired" argument (for + ;; example on FreeBSD). + (tramp-send-command-and-check + vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec)))))) + +(defun tramp-get-test-command (vec) + (with-connection-property vec "test" + (tramp-message vec 5 "Finding a suitable `test' command") + (if (tramp-send-command-and-check vec "test 0") + "test" + (tramp-find-executable vec "test" (tramp-get-remote-path vec))))) + +(defun tramp-get-test-nt-command (vec) + ;; Does `test A -nt B' work? Use abominable `find' construct if it + ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, + ;; for otherwise the shell crashes. + (with-connection-property vec "test-nt" + (or + (progn + (tramp-send-command + vec (format "( %s / -nt / )" (tramp-get-test-command vec))) + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (when (looking-at (regexp-quote tramp-end-of-output)) + (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) + (progn + (tramp-send-command + vec + (format + "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}" + (tramp-get-test-command vec))) + "tramp_test_nt %s %s")))) + +(defun tramp-get-file-exists-command (vec) + (with-connection-property vec "file-exists" + (tramp-message vec 5 "Finding command to check if file exists") + (tramp-find-file-exists-command vec))) + +(defun tramp-get-remote-ln (vec) + (with-connection-property vec "ln" + (tramp-message vec 5 "Finding a suitable `ln' command") + (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) + +(defun tramp-get-remote-perl (vec) + (with-connection-property vec "perl" + (tramp-message vec 5 "Finding a suitable `perl' command") + (let ((result + (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) + (tramp-find-executable + vec "perl" (tramp-get-remote-path vec))))) + ;; We must check also for some Perl modules. + (when result + (with-connection-property vec "perl-file-spec" + (tramp-send-command-and-check + vec (format "%s -e 'use File::Spec;'" result))) + (with-connection-property vec "perl-cwd-realpath" + (tramp-send-command-and-check + vec (format "%s -e 'use Cwd \"realpath\";'" result)))) + result))) + +(defun tramp-get-remote-stat (vec) + (with-connection-property vec "stat" + (tramp-message vec 5 "Finding a suitable `stat' command") + (let ((result (tramp-find-executable + vec "stat" (tramp-get-remote-path vec))) + tmp) + ;; Check whether stat(1) returns usable syntax. %s does not + ;; work on older AIX systems. + (when result + (setq tmp + ;; We don't want to display an error message. + (tramp-compat-with-temp-message (or (current-message) "") + (ignore-errors + (tramp-send-command-and-read + vec (format "%s -c '(\"%%N\" %%s)' /" result))))) + (unless (and (listp tmp) (stringp (car tmp)) + (string-match "^./.$" (car tmp)) + (integerp (cadr tmp))) + (setq result nil))) + result))) + +(defun tramp-get-remote-readlink (vec) + (with-connection-property vec "readlink" + (tramp-message vec 5 "Finding a suitable `readlink' command") + (let ((result (tramp-find-executable + vec "readlink" (tramp-get-remote-path vec)))) + (when (and result + ;; We don't want to display an error message. + (tramp-compat-with-temp-message (or (current-message) "") + (ignore-errors + (tramp-send-command-and-check + vec (format "%s --canonicalize-missing /" result))))) + result)))) + +(defun tramp-get-remote-trash (vec) + (with-connection-property vec "trash" + (tramp-message vec 5 "Finding a suitable `trash' command") + (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) + +(defun tramp-get-remote-id (vec) + (with-connection-property vec "id" + (tramp-message vec 5 "Finding POSIX `id' command") + (or + (catch 'id-found + (let ((dl (tramp-get-remote-path vec)) + result) + (while (and dl (setq result (tramp-find-executable vec "id" dl t t))) + ;; Check POSIX parameter. + (when (tramp-send-command-and-check vec (format "%s -u" result)) + (throw 'id-found result)) + (setq dl (cdr dl))))) + (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))) + +(defun tramp-get-remote-uid (vec id-format) + (with-connection-property vec (format "uid-%s" id-format) + (let ((res (tramp-send-command-and-read + vec + (format "%s -u%s %s" + (tramp-get-remote-id vec) + (if (equal id-format 'integer) "" "n") + (if (equal id-format 'integer) + "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/"))))) + ;; The command might not always return a number. + (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) + +(defun tramp-get-remote-gid (vec id-format) + (with-connection-property vec (format "gid-%s" id-format) + (let ((res (tramp-send-command-and-read + vec + (format "%s -g%s %s" + (tramp-get-remote-id vec) + (if (equal id-format 'integer) "" "n") + (if (equal id-format 'integer) + "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/"))))) + ;; The command might not always return a number. + (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) + +(defun tramp-get-local-uid (id-format) + (if (equal id-format 'integer) (user-uid) (user-login-name))) + +(defun tramp-get-local-gid (id-format) + (nth 3 (tramp-compat-file-attributes "~/" id-format))) + +;; Some predefined connection properties. +(defun tramp-get-inline-compress (vec prop size) + "Return the compress command related to PROP. +PROP is either `inline-compress' or `inline-decompress'. SIZE is +the length of the file to be compressed. + +If no corresponding command is found, nil is returned." + (when (and (integerp tramp-inline-compress-start-size) + (> size tramp-inline-compress-start-size)) + (with-connection-property vec prop + (tramp-find-inline-compress vec) + (tramp-get-connection-property vec prop nil)))) + +(defun tramp-get-inline-coding (vec prop size) + "Return the coding command related to PROP. +PROP is either `remote-encoding', `remode-decoding', +`local-encoding' or `local-decoding'. + +SIZE is the length of the file to be coded. Depending on SIZE, +compression might be applied. + +If no corresponding command is found, nil is returned. +Otherwise, either a string is returned which contains a `%s' mark +to be used for the respective input or output file; or a Lisp +function cell is returned to be applied on a buffer." + (let ((coding + (with-connection-property vec prop + (tramp-find-inline-encoding vec) + (tramp-get-connection-property vec prop nil))) + (prop1 (if (string-match "encoding" prop) + "inline-compress" "inline-decompress")) + compress) + ;; The connection property might have been cached. So we must send + ;; the script to the remote side - maybe. + (when (and coding (symbolp coding) (string-match "remote" prop)) + (let ((name (symbol-name coding))) + (while (string-match (regexp-quote "-") name) + (setq name (replace-match "_" nil t name))) + (tramp-maybe-send-script vec (symbol-value coding) name) + (setq coding name))) + (when coding + ;; Check for the `compress' command. + (setq compress (tramp-get-inline-compress vec prop1 size)) + ;; Return the value. + (cond + ((and compress (symbolp coding)) + (if (string-match "decompress" prop1) + `(lambda (beg end) + (,coding beg end) + (let ((coding-system-for-write 'binary) + (coding-system-for-read 'binary)) + (apply + 'call-process-region (point-min) (point-max) + (car (split-string ,compress)) t t nil + (cdr (split-string ,compress))))) + `(lambda (beg end) + (let ((coding-system-for-write 'binary) + (coding-system-for-read 'binary)) + (apply + 'call-process-region beg end + (car (split-string ,compress)) t t nil + (cdr (split-string ,compress)))) + (,coding (point-min) (point-max))))) + ((symbolp coding) + coding) + ((and compress (string-match "decoding" prop)) + (format "(%s | %s >%%s)" coding compress)) + (compress + (format "(%s <%%s | %s)" compress coding)) + ((string-match "decoding" prop) + (format "%s >%%s" coding)) + (t + (format "%s <%%s" coding)))))) + +;;; Integration of eshell.el: + +(eval-when-compile + (defvar eshell-path-env)) + +;; eshell.el keeps the path in `eshell-path-env'. We must change it +;; when `default-directory' points to another host. +(defun tramp-eshell-directory-change () + "Set `eshell-path-env' to $PATH of the host related to `default-directory'." + (setq eshell-path-env + (if (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (mapconcat + 'identity + (tramp-get-remote-path v) + ":")) + (getenv "PATH")))) + +(eval-after-load "esh-util" + '(progn + (tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change) + (add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change))))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-sh 'force))) + +(provide 'tramp-sh) + +;;; TODO: + +;; * Don't use globbing for directories with many files, as this is +;; likely to produce long command lines, and some shells choke on +;; long command lines. +;; * Make it work for different encodings, and for different file name +;; encodings, too. (Daniel Pittman) +;; * Don't search for perl5 and perl. Instead, only search for perl and +;; then look if it's the right version (with `perl -v'). +;; * When editing a remote CVS controlled file as a different user, VC +;; gets confused about the file locking status. Try to find out why +;; the workaround doesn't work. +;; * Allow out-of-band methods as _last_ multi-hop. Open a connection +;; until the last but one hop via `start-file-process'. Apply it +;; also for ftp and smb. +;; * WIBNI if we had a command "trampclient"? If I was editing in +;; some shell with root priviledges, it would be nice if I could +;; just call +;; trampclient filename.c +;; as an editor, and the _current_ shell would connect to an Emacs +;; server and would be used in an existing non-priviledged Emacs +;; session for doing the editing in question. +;; That way, I need not tell Emacs my password again and be afraid +;; that it makes it into core dumps or other ugly stuff (I had Emacs +;; once display a just typed password in the context of a keyboard +;; sequence prompt for a question immediately following in a shell +;; script run within Emacs -- nasty). +;; And if I have some ssh session running to a different computer, +;; having the possibility of passing a local file there to a local +;; Emacs session (in case I can arrange for a connection back) would +;; be nice. +;; Likely the corresponding Tramp server should not allow the +;; equivalent of the emacsclient -eval option in order to make this +;; reasonably unproblematic. And maybe trampclient should have some +;; way of passing credentials, like by using an SSL socket or +;; something. (David Kastrup) +;; * Reconnect directly to a compliant shell without first going +;; through the user's default shell. (Pete Forman) +;; * How can I interrupt the remote process with a signal +;; (interrupt-process seems not to work)? (Markus Triska) +;; * Avoid the local shell entirely for starting remote processes. If +;; so, I think even a signal, when delivered directly to the local +;; SSH instance, would correctly be propagated to the remote process +;; automatically; possibly SSH would have to be started with +;; "-t". (Markus Triska) +;; * It makes me wonder if tramp couldn't fall back to ssh when scp +;; isn't on the remote host. (Mark A. Hershberger) +;; * Use lsh instead of ssh. (Alfred M. Szmidt) +;; * Optimize out-of-band copying, when both methods are scp-like (not +;; rsync). +;; * Keep a second connection open for out-of-band methods like scp or +;; rsync. +;; * Try telnet+curl as new method. It might be useful for busybox, +;; without built-in uuencode/uudecode. + +;;; tramp-sh.el ends here
--- a/lisp/net/tramp-smb.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-smb.el Thu Sep 16 11:11:13 2010 +0900 @@ -30,17 +30,20 @@ (eval-when-compile (require 'cl)) ; block, return (require 'tramp) -(require 'tramp-cache) -(require 'tramp-compat) + +;; We call several `tramp-handle-*' functions directly. So we must +;; reqire that package as well. +(require 'tramp-sh) ;; Define SMB method ... -(defcustom tramp-smb-method "smb" - "*Method to connect SAMBA and M$ SMB servers." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-smb-method "smb" + "*Method to connect SAMBA and M$ SMB servers.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-smb-method nil)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-methods (cons tramp-smb-method nil))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -205,11 +208,13 @@ "Alist of handler functions for Tramp SMB method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-smb-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-smb-method))) +;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) "Invoke the SMB related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -219,8 +224,10 @@ (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))) ;; File name primitives. @@ -784,7 +791,7 @@ (if (tramp-smb-get-cifs-capabilities v) (format "posix_mkdir \"%s\" %s" - file (tramp-decimal-to-octal (default-file-modes))) + file (tramp-compat-decimal-to-octal (default-file-modes))) (format "mkdir \"%s\"" file))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. @@ -893,7 +900,7 @@ (unless (tramp-smb-send-command v (format "chmod \"%s\" %s" (tramp-smb-get-localname v) - (tramp-decimal-to-octal mode))) + (tramp-compat-decimal-to-octal mode))) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -1397,6 +1404,9 @@ (tramp-message vec 6 "\n%s" (buffer-string)) (not err)))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-smb 'force))) (provide 'tramp-smb)
--- a/lisp/net/tramp-uu.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp-uu.el Thu Sep 16 11:11:13 2010 +0900 @@ -50,6 +50,7 @@ "Return the byte that is encoded as CHAR." (cdr (assq char tramp-uu-b64-char-to-byte))) +;;;###tramp-autoload (defun tramp-uuencode-region (beg end) "UU-encode the region between BEG and END." ;; First we base64 encode the region, then we transmogrify that into @@ -87,6 +88,10 @@ (goto-char beg) (insert "begin 600 xxx\n")))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-uu 'force))) + (provide 'tramp-uu) ;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6
--- a/lisp/net/tramp.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/tramp.el Thu Sep 16 11:11:13 2010 +0900 @@ -3,11 +3,10 @@ ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; (copyright statements below in code to be updated with the above notice) - ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -59,117 +58,7 @@ ;;; Code: -;; Since Emacs 23.1, loading messages have been disabled during -;; autoload. However, loading Tramp takes a while, and it could -;; happen while typing a filename in the minibuffer. Therefore, Tramp -;; shall inform about. -(when (and load-in-progress (null (current-message))) - (message "Loading tramp...")) - -;; The Tramp version number and bug report address, as prepared by configure. -(require 'trampver) -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'trampver) - (unload-feature 'trampver 'force)))) - (require 'tramp-compat) -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-compat) - (unload-feature 'tramp-compat 'force)))) - -(require 'format-spec) -;; As long as password.el is not part of (X)Emacs, it shouldn't -;; be mandatory -(if (featurep 'xemacs) - (load "password" 'noerror) - (or (require 'password-cache nil 'noerror) - (require 'password nil 'noerror))) ; from No Gnus, also in tar ball - -(require 'shell) -(require 'advice) - -(eval-and-compile - (if (featurep 'xemacs) - (load "auth-source" 'noerror) - (require 'auth-source nil 'noerror))) - -;; Requiring 'tramp-cache results in an endless loop. -(autoload 'tramp-get-file-property "tramp-cache") -(autoload 'tramp-set-file-property "tramp-cache") -(autoload 'tramp-flush-file-property "tramp-cache") -(autoload 'tramp-flush-directory-property "tramp-cache") -(autoload 'tramp-get-connection-property "tramp-cache") -(autoload 'tramp-set-connection-property "tramp-cache") -(autoload 'tramp-flush-connection-property "tramp-cache") -(autoload 'tramp-parse-connection-properties "tramp-cache") -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-cache) - (unload-feature 'tramp-cache 'force)))) - -(autoload 'tramp-uuencode-region "tramp-uu" - "Implementation of `uuencode' in Lisp.") -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-uu) - (unload-feature 'tramp-uu 'force)))) - -(autoload 'uudecode-decode-region "uudecode") - -;; The following Tramp packages must be loaded after tramp.el, because -;; they require it as well. -(eval-after-load "tramp" - '(dolist - (feature - (list - - ;; Tramp interactive commands. - 'tramp-cmds - - ;; Load foreign FTP method. - (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp) - - ;; tramp-smb uses "smbclient" from Samba. Not available - ;; under Cygwin and Windows, because they don't offer - ;; "smbclient". And even not necessary there, because Emacs - ;; supports UNC file names like "//host/share/localname". - (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb) - - ;; Load foreign FISH method. - 'tramp-fish - - ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23 - ;; on some system types. We don't call `dbus-ping', because - ;; this would load dbus.el. - (when (and (featurep 'dbusbind) - (condition-case nil - (tramp-compat-funcall 'dbus-get-unique-name :session) - (error nil)) - (tramp-compat-process-running-p "gvfs-fuse-daemon")) - 'tramp-gvfs) - - ;; Load gateways. It needs `make-network-process' from Emacs 22. - (when (functionp 'make-network-process) 'tramp-gw) - - ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash - ;; (from Emacs 23.2). - (when (and (locate-library "epa") (locate-library "imap-hash")) - 'tramp-imap))) - - (when feature - ;; We have used just some basic tests, whether a package shall - ;; be added. There might still be other errors during loading, - ;; which we will catch here. - (catch 'tramp-loading - (require feature) - (add-hook 'tramp-unload-hook - `(lambda () - (when (featurep (quote ,feature)) - (unload-feature (quote ,feature) 'force))))) - (unless (featurep feature) - (message "Loading %s failed, ignoring this package" feature))))) ;;; User Customizable Internal Variables: @@ -286,379 +175,8 @@ :group 'tramp :type 'string) -(defcustom tramp-inline-compress-start-size 4096 - "*The minimum size of compressing where inline transfer. -When inline transfer, compress transfered data of file -whose size is this value or above (up to `tramp-copy-size-limit'). -If it is nil, no compression at all will be applied." - :group 'tramp - :type '(choice (const nil) integer)) - -(defcustom tramp-copy-size-limit 10240 - "*The maximum file size where inline copying is preferred over an out-of-the-band copy. -If it is nil, inline out-of-the-band copy will be used without a check." - :group 'tramp - :type '(choice (const nil) integer)) - -(defcustom tramp-terminal-type "dumb" - "*Value of TERM environment variable for logging in to remote host. -Because Tramp wants to parse the output of the remote shell, it is easily -confused by ANSI color escape sequences and suchlike. Often, shell init -files conditionalize this setup based on the TERM environment variable." - :group 'tramp - :type 'string) - -;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for -;; root users. It uses the `$' character for other users. In order -;; to guarantee a proper prompt, we use "#$" for the prompt. - -(defvar tramp-end-of-output - (format - "///%s#$" - (md5 (concat (prin1-to-string process-environment) (current-time-string)))) - "String used to recognize end of output. -The '$' character at the end is quoted; the string cannot be -detected as prompt when being sent on echoing hosts, therefore.") - -(defconst tramp-initial-end-of-output "#$ " - "Prompt when establishing a connection.") - -(defvar tramp-methods - `(("rcp" (tramp-login-program "rsh") - (tramp-login-args (("%h") ("-l" "%u"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "rcp") - (tramp-copy-args (("-p" "%k") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil)) - ("scp" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("scp1" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-1") ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp") - (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("scp2" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-2") ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp") - (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("scp1_old" - (tramp-login-program "ssh1") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp1") - (tramp-copy-args (("-p" "%k") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil)) - ("scp2_old" - (tramp-login-program "ssh2") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp2") - (tramp-copy-args (("-p" "%k") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil)) - ("sftp" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "sftp") - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("rsync" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "rsync") - (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-keep-tmpfile t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil)) - ("rsyncc" - (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-o" "ControlPath=%t.%%r@%%h:%%p") - ("-o" "ControlMaster=yes") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "rsync") - (tramp-copy-args (("-t" "%k") ("-r"))) - (tramp-copy-env (("RSYNC_RSH") - (,(concat - "ssh" - " -o ControlPath=%t.%%r@%%h:%%p" - " -o ControlMaster=auto")))) - (tramp-copy-keep-date t) - (tramp-copy-keep-tmpfile t) - (tramp-copy-recursive t) - (tramp-password-end-of-line nil)) - ("remcp" (tramp-login-program "remsh") - (tramp-login-args (("%h") ("-l" "%u"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "rcp") - (tramp-copy-args (("-p" "%k"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line nil)) - ("rsh" (tramp-login-program "rsh") - (tramp-login-args (("%h") ("-l" "%u"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("ssh" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("ssh1" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-1") ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("ssh2" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-2") ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("ssh1_old" - (tramp-login-program "ssh1") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("ssh2_old" - (tramp-login-program "ssh2") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("remsh" (tramp-login-program "remsh") - (tramp-login-args (("%h") ("-l" "%u"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("telnet" - (tramp-login-program "telnet") - (tramp-login-args (("%h") ("%p"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil) - (tramp-default-port 23)) - ("su" (tramp-login-program "su") - (tramp-login-args (("-") ("%u"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("sudo" (tramp-login-program "sudo") - (tramp-login-args (("-u" "%u") - ("-s") ("-H") ("-p" "Password:"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("scpc" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-o" "ControlPath=%t.%%r@%%h:%%p") - ("-o" "ControlMaster=yes") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") - ("-o" "ControlPath=%t.%%r@%%h:%%p") - ("-o" "ControlMaster=auto"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("scpx" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("-t" "-t") - ("%h") ("/bin/sh"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "scp") - (tramp-copy-args (("-p" "%k"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("sshx" (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") - ("-e" "none") ("-t" "-t") - ("%h") ("/bin/sh"))) - (tramp-async-args (("-q"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil) - (tramp-gw-args (("-o" - "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22)) - ("krlogin" - (tramp-login-program "krlogin") - (tramp-login-args (("%h") ("-l" "%u") ("-x"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("plink" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") - ("-ssh") ("%h"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line "xy") ;see docstring for "xy" - (tramp-default-port 22)) - ("plink1" - (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") - ("-1" "-ssh") ("%h"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line "xy") ;see docstring for "xy" - (tramp-default-port 22)) - ("plinkx" - (tramp-login-program "plink") - ;; ("%h") must be a single element, see - ;; `tramp-compute-multi-hops'. - (tramp-login-args (("-load") ("%h") ("-t") - (,(format - "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" - tramp-terminal-type - tramp-initial-end-of-output)) - ("/bin/sh"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program nil) - (tramp-copy-args nil) - (tramp-copy-keep-date nil) - (tramp-password-end-of-line nil)) - ("pscp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") - ("-ssh") ("%h"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "pscp") - (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line "xy") ;see docstring for "xy" - (tramp-default-port 22)) - ("psftp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") - ("-ssh") ("%h"))) - (tramp-remote-sh "/bin/sh") - (tramp-copy-program "pscp") - (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line "xy")) ;see docstring for "xy" - ("fcp" (tramp-login-program "fsh") - (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) - (tramp-remote-sh "/bin/sh -i") - (tramp-copy-program "fcp") - (tramp-copy-args (("-p" "%k"))) - (tramp-copy-keep-date t) - (tramp-password-end-of-line nil))) +;;;###tramp-autoload +(defvar tramp-methods nil "*Alist of methods for remote files. This is a list of entries of the form (NAME PARAM1 PARAM2 ...). Each NAME stands for a remote access method. Each PARAM is a @@ -800,8 +318,7 @@ :group 'tramp :type 'string) -(defcustom tramp-default-method-alist - '(("\\`localhost\\'" "\\`root\\'" "su")) +(defcustom tramp-default-method-alist nil "*Default method to use for specific host/user pairs. This is an alist of items (HOST USER METHOD). The first matching item specifies the method to use for a file name which does not specify a @@ -818,8 +335,7 @@ (regexp :tag "User regexp") (string :tag "Method")))) -(defcustom tramp-default-user - nil +(defcustom tramp-default-user nil "*Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'. @@ -828,10 +344,7 @@ :group 'tramp :type '(choice (const nil) string)) -(defcustom tramp-default-user-alist - `(("\\`su\\(do\\)?\\'" nil "root") - ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'" - nil ,(user-login-name))) +(defcustom tramp-default-user-alist nil "*Default user to use for specific method/host pairs. This is an alist of items (METHOD HOST USER). The first matching item specifies the user to use for a file name which does not specify a @@ -846,8 +359,7 @@ (regexp :tag "Host regexp") (string :tag "User")))) -(defcustom tramp-default-host - (system-name) +(defcustom tramp-default-host (system-name) "*Default host to use for transferring files. Useful for su and sudo methods mostly." :group 'tramp @@ -877,39 +389,6 @@ "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$") "*Host names which are regarded as local host.") -(defconst tramp-completion-function-alist-rsh - '((tramp-parse-rhosts "/etc/hosts.equiv") - (tramp-parse-rhosts "~/.rhosts")) - "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.") - -(defconst tramp-completion-function-alist-ssh - '((tramp-parse-rhosts "/etc/hosts.equiv") - (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-shostkeys "/etc/ssh2/hostkeys") - (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") - (tramp-parse-rhosts "~/.rhosts") - (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config") - (tramp-parse-shostkeys "~/.ssh2/hostkeys") - (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) - "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") - -(defconst tramp-completion-function-alist-telnet - '((tramp-parse-hosts "/etc/hosts")) - "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.") - -(defconst tramp-completion-function-alist-su - '((tramp-parse-passwd "/etc/passwd")) - "Default list of (FUNCTION FILE) pairs to be examined for su methods.") - -(defconst tramp-completion-function-alist-putty - '((tramp-parse-putty - "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions")) - "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.") - (defvar tramp-completion-function-alist nil "*Alist of methods for remote files. This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\). @@ -930,63 +409,6 @@ FUNCTION can also be a customer defined function. For more details see the info pages.") -(eval-after-load "tramp" - '(progn - (tramp-set-completion-function - "rcp" tramp-completion-function-alist-rsh) - (tramp-set-completion-function - "scp" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "scp1" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "scp2" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "scp1_old" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "scp2_old" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "rsync" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "rsyncc" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "remcp" tramp-completion-function-alist-rsh) - (tramp-set-completion-function - "rsh" tramp-completion-function-alist-rsh) - (tramp-set-completion-function - "ssh" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "ssh1" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "ssh2" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "ssh1_old" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "ssh2_old" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "remsh" tramp-completion-function-alist-rsh) - (tramp-set-completion-function - "telnet" tramp-completion-function-alist-telnet) - (tramp-set-completion-function - "su" tramp-completion-function-alist-su) - (tramp-set-completion-function - "sudo" tramp-completion-function-alist-su) - (tramp-set-completion-function - "scpx" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "sshx" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "krlogin" tramp-completion-function-alist-rsh) - (tramp-set-completion-function - "plink" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "plink1" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "plinkx" tramp-completion-function-alist-putty) - (tramp-set-completion-function - "pscp" tramp-completion-function-alist-ssh) - (tramp-set-completion-function - "fcp" tramp-completion-function-alist-ssh))) - (defconst tramp-echo-mark-marker "_echo" "String marker to surround echoed commands.") @@ -1035,55 +457,6 @@ :group 'tramp :type 'string) -;; "getconf PATH" yields: -;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin -;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin -;; GNU/Linux (Debian, Suse): /bin:/usr/bin -;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! -;; IRIX64: /usr/bin -(defcustom tramp-remote-path - '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin" - "/local/bin" "/local/freeware/bin" "/local/gnu/bin" - "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin") - "*List of directories to search for executables on remote host. -For every remote host, this variable will be set buffer local, -keeping the list of existing directories on that host. - -You can use `~' in this list, but when searching for a shell which groks -tilde expansion, all directory names starting with `~' will be ignored. - -`Default Directories' represent the list of directories given by -the command \"getconf PATH\". It is recommended to use this -entry on top of this list, because these are the default -directories for POSIX compatible commands. - -`Private Directories' are the settings of the $PATH environment, -as given in your `~/.profile'." - :group 'tramp - :type '(repeat (choice - (const :tag "Default Directories" tramp-default-remote-path) - (const :tag "Private Directories" tramp-own-remote-path) - (string :tag "Directory")))) - -(defcustom tramp-remote-process-environment - `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" - ,(format "TERM=%s" tramp-terminal-type) - "EMACS=t" ;; Deprecated. - ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) - "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" - "autocorrect=" "correct=") - - "*List of environment variables to be set on the remote host. - -Each element should be a string of the form ENVVARNAME=VALUE. An -entry ENVVARNAME= diables the corresponding environment variable, -which might have been set in the init files like ~/.profile. - -Special handling is applied to the PATH environment, which should -not be set here. Instead of, it should be set via `tramp-remote-path'." - :group 'tramp - :type '(repeat string)) - (defcustom tramp-login-prompt-regexp ".*ogin\\( .*\\)?: *" "*Regexp matching login-like prompts. @@ -1211,15 +584,13 @@ :group 'tramp :type 'regexp) -(defcustom tramp-temp-name-prefix "tramp." +(defconst tramp-temp-name-prefix "tramp." "*Prefix to use for temporary files. If this is a relative file name (such as \"tramp.\"), it is considered relative to the directory name returned by the function `tramp-compat-temporary-file-directory' (which see). It may also be an absolute file name; don't forget to include a prefix for the filename -part, though." - :group 'tramp - :type 'string) +part, though.") (defconst tramp-temp-buffer-name " *tramp temp*" "Buffer name for a temporary buffer. @@ -1230,22 +601,6 @@ Useful for \"rsync\" like methods.") (make-variable-buffer-local 'tramp-temp-buffer-file-name) -(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) - "*Alist specifying extra arguments to pass to the remote shell. -Entries are (REGEXP . ARGS) where REGEXP is a regular expression -matching the shell file name and ARGS is a string specifying the -arguments. - -This variable is only used when Tramp needs to start up another shell -for tilde expansion. The extra arguments should typically prevent the -shell from reading its init file." - :group 'tramp - ;; This might be the wrong way to test whether the widget type - ;; `alist' is available. Who knows the right way to test it? - :type (if (get 'alist 'widget-type) - '(alist :key-type string :value-type string) - '(repeat (cons string string)))) - ;; XEmacs is distributed with few Lisp packages. Further packages are ;; installed using EFS. If we use a unified filename format, then ;; Tramp is required in addition to EFS. (But why can't Tramp just @@ -1304,8 +659,7 @@ "*Regexp matching delimeter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp - "[^:/ \t]+" +(defconst tramp-user-regexp "[^:/ \t]+" "*Regexp matching user names.") (defconst tramp-prefix-domain-format "%" @@ -1316,8 +670,7 @@ "*Regexp matching delimeter between user and domain names. Derived from `tramp-prefix-domain-format'.") -(defconst tramp-domain-regexp - "[-a-zA-Z0-9_.]+" +(defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+" "*Regexp matching domain names.") (defconst tramp-user-with-domain-regexp @@ -1326,8 +679,7 @@ "\\(" tramp-domain-regexp "\\)") "*Regexp matching user names with domain names.") -(defconst tramp-postfix-user-format - "@" +(defconst tramp-postfix-user-format "@" "*String matching delimeter between user and host names. Used in `tramp-make-tramp-file-name'.") @@ -1336,8 +688,7 @@ "*Regexp matching delimeter between user and host names. Derived from `tramp-postfix-user-format'.") -(defconst tramp-host-regexp - "[a-zA-Z0-9_.-]+" +(defconst tramp-host-regexp "[a-zA-Z0-9_.-]+" "*Regexp matching host names.") (defconst tramp-prefix-ipv6-format @@ -1385,8 +736,7 @@ "*Regexp matching delimeter between host names and port numbers. Derived from `tramp-prefix-port-format'.") -(defconst tramp-port-regexp - "[0-9]+" +(defconst tramp-port-regexp "[0-9]+" "*Regexp matching port numbers.") (defconst tramp-host-with-port-regexp @@ -1408,8 +758,7 @@ "*Regexp matching delimeter between host names and localnames. Derived from `tramp-postfix-host-format'.") -(defconst tramp-localname-regexp - ".*$" +(defconst tramp-localname-regexp ".*$" "*Regexp matching localnames.") ;; File name format. @@ -1457,15 +806,13 @@ On W32 systems, the volume letter must be ignored.") ;;;###autoload -(defconst tramp-file-name-regexp-separate - "\\`/\\[.*\\]" +(defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "Value for `tramp-file-name-regexp' for separate remoting. XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") ;;;###autoload -(defconst tramp-file-name-regexp-url - "\\`/[^/:]+://" +(defconst tramp-file-name-regexp-url "\\`/[^/:]+://" "Value for `tramp-file-name-regexp' for URL-like remoting. See `tramp-file-name-structure' for more explanations.") @@ -1539,38 +886,6 @@ Also see `tramp-file-name-structure'.") -(defconst tramp-actions-before-shell - '((tramp-login-prompt-regexp tramp-action-login) - (tramp-password-prompt-regexp tramp-action-password) - (tramp-wrong-passwd-regexp tramp-action-permission-denied) - (shell-prompt-pattern tramp-action-succeed) - (tramp-shell-prompt-pattern tramp-action-succeed) - (tramp-yesno-prompt-regexp tramp-action-yesno) - (tramp-yn-prompt-regexp tramp-action-yn) - (tramp-terminal-prompt-regexp tramp-action-terminal) - (tramp-process-alive-regexp tramp-action-process-alive)) - "List of pattern/action pairs. -Whenever a pattern matches, the corresponding action is performed. -Each item looks like (PATTERN ACTION). - -The PATTERN should be a symbol, a variable. The value of this -variable gives the regular expression to search for. Note that the -regexp must match at the end of the buffer, \"\\'\" is implicitly -appended to it. - -The ACTION should also be a symbol, but a function. When the -corresponding PATTERN matches, the ACTION function is called.") - -(defconst tramp-actions-copy-out-of-band - '((tramp-password-prompt-regexp tramp-action-password) - (tramp-wrong-passwd-regexp tramp-action-permission-denied) - (tramp-copy-failed-regexp tramp-action-permission-denied) - (tramp-process-alive-regexp tramp-action-out-of-band)) - "List of pattern/action pairs. -This list is used for copying/renaming with out-of-band methods. - -See `tramp-actions-before-shell' for more info.") - ;; Chunked sending kludge. We set this to 500 for black-listed constellations ;; known to have a bug in `process-send-string'; some ssh connections appear ;; to drop bytes when data is sent too quickly. There is also a connection @@ -1676,437 +991,273 @@ (defvar tramp-current-host nil "Remote host for this *tramp* buffer.") -(defconst tramp-uudecode - "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode -cat /tmp/tramp.$$ -rm -f /tmp/tramp.$$" - "Shell function to implement `uudecode' to standard output. -Many systems support `uudecode -o /dev/stdout' or `uudecode -o -' -for this or `uudecode -p', but some systems don't, and for them -we have this shell function.") - -(defconst tramp-perl-file-truename - "%s -e ' -use File::Spec; -use Cwd \"realpath\"; - -sub recursive { - my ($volume, @dirs) = @_; - my $real = realpath(File::Spec->catpath( - $volume, File::Spec->catdir(@dirs), \"\")); - if ($real) { - my ($vol, $dir) = File::Spec->splitpath($real, 1); - return ($vol, File::Spec->splitdir($dir)); - } - else { - my $last = pop(@dirs); - ($volume, @dirs) = recursive($volume, @dirs); - push(@dirs, $last); - return ($volume, @dirs); - } -} - -$result = realpath($ARGV[0]); -if (!$result) { - my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1); - ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir)); - - $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\"); -} - -if ($ARGV[0] =~ /\\/$/) { - $result = $result . \"/\"; -} - -print \"\\\"$result\\\"\\n\"; -' \"$1\" 2>/dev/null" - "Perl script to produce output suitable for use with `file-truename' -on the remote file system. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled.") - -(defconst tramp-perl-file-name-all-completions - "%s -e 'sub case { - my $str = shift; - if ($ARGV[2]) { - return lc($str); - } - else { - return $str; - } -} -opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); -@files = readdir(d); closedir(d); -foreach $f (@files) { - if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { - if (-d \"$ARGV[0]/$f\") { - print \"$f/\\n\"; - } - else { - print \"$f\\n\"; - } - } -} -print \"ok\\n\" -' \"$1\" \"$2\" \"$3\" 2>/dev/null" - "Perl script to produce output suitable for use with -`file-name-all-completions' on the remote file system. Escape -sequence %s is replaced with name of Perl binary. This string is -passed to `format', so percent characters need to be doubled.") - -;; Perl script to implement `file-attributes' in a Lisp `read'able -;; output. If you are hacking on this, note that you get *no* output -;; unless this spits out a complete line, including the '\n' at the -;; end. -;; The device number is returned as "-1", because there will be a virtual -;; device number set in `tramp-handle-file-attributes'. -(defconst tramp-perl-file-attributes - "%s -e ' -@stat = lstat($ARGV[0]); -if (!@stat) { - print \"nil\\n\"; - exit 0; -} -if (($stat[2] & 0170000) == 0120000) -{ - $type = readlink($ARGV[0]); - $type = \"\\\"$type\\\"\"; -} -elsif (($stat[2] & 0170000) == 040000) -{ - $type = \"t\"; -} -else -{ - $type = \"nil\" -}; -$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; -$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; -printf( - \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\", - $type, - $stat[3], - $uid, - $gid, - $stat[8] >> 16 & 0xffff, - $stat[8] & 0xffff, - $stat[9] >> 16 & 0xffff, - $stat[9] & 0xffff, - $stat[10] >> 16 & 0xffff, - $stat[10] & 0xffff, - $stat[7], - $stat[2], - $stat[1] >> 16 & 0xffff, - $stat[1] & 0xffff -);' \"$1\" \"$2\" 2>/dev/null" - "Perl script to produce output suitable for use with `file-attributes' -on the remote file system. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled.") - -(defconst tramp-perl-directory-files-and-attributes - "%s -e ' -chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit(); -opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit(); -@list = readdir(DIR); -closedir(DIR); -$n = scalar(@list); -printf(\"(\\n\"); -for($i = 0; $i < $n; $i++) -{ - $filename = $list[$i]; - @stat = lstat($filename); - if (($stat[2] & 0170000) == 0120000) - { - $type = readlink($filename); - $type = \"\\\"$type\\\"\"; - } - elsif (($stat[2] & 0170000) == 040000) - { - $type = \"t\"; - } - else - { - $type = \"nil\" - }; - $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; - $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; - printf( - \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\", - $filename, - $type, - $stat[3], - $uid, - $gid, - $stat[8] >> 16 & 0xffff, - $stat[8] & 0xffff, - $stat[9] >> 16 & 0xffff, - $stat[9] & 0xffff, - $stat[10] >> 16 & 0xffff, - $stat[10] & 0xffff, - $stat[7], - $stat[2], - $stat[1] >> 16 & 0xffff, - $stat[1] & 0xffff, - $stat[0] >> 16 & 0xffff, - $stat[0] & 0xffff); -} -printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null" - "Perl script implementing `directory-files-attributes' as Lisp `read'able -output. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled.") - -;; ;; These two use uu encoding. -;; (defvar tramp-perl-encode "%s -e'\ -;; print qq(begin 644 xxx\n); -;; my $s = q(); -;; my $res = q(); -;; while (read(STDIN, $s, 45)) { -;; print pack(q(u), $s); -;; } -;; print qq(`\n); -;; print qq(end\n); -;; '" -;; "Perl program to use for encoding a file. -;; Escape sequence %s is replaced with name of Perl binary.") - -;; (defvar tramp-perl-decode "%s -ne ' -;; print unpack q(u), $_; -;; '" -;; "Perl program to use for decoding a file. -;; Escape sequence %s is replaced with name of Perl binary.") - -;; These two use base64 encoding. -(defconst tramp-perl-encode-with-module - "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null" - "Perl program to use for encoding a file. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled. -This implementation requires the MIME::Base64 Perl module to be installed -on the remote host.") - -(defconst tramp-perl-decode-with-module - "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null" - "Perl program to use for decoding a file. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled. -This implementation requires the MIME::Base64 Perl module to be installed -on the remote host.") - -(defconst tramp-perl-encode - "%s -e ' -# This script contributed by Juanma Barranquero <lektu@terra.es>. -# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -# Free Software Foundation, Inc. -use strict; - -my %%trans = do { - my $i = 0; - map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)} - split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/); -}; - -binmode(\\*STDIN); - -# We read in chunks of 54 bytes, to generate output lines -# of 72 chars (plus end of line) -$/ = \\54; - -while (my $data = <STDIN>) { - my $pad = q(); - - # Only for the last chunk, and only if did not fill the last three-byte packet - if (eof) { - my $mod = length($data) %% 3; - $pad = q(=) x (3 - $mod) if $mod; - } - - # Not the fastest method, but it is simple: unpack to binary string, split - # by groups of 6 bits and convert back from binary to byte; then map into - # the translation table - print - join q(), - map($trans{$_}, - (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), - $pad, - qq(\\n); -}' 2>/dev/null" - "Perl program to use for encoding a file. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled.") - -(defconst tramp-perl-decode - "%s -e ' -# This script contributed by Juanma Barranquero <lektu@terra.es>. -# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -# Free Software Foundation, Inc. -use strict; - -my %%trans = do { - my $i = 0; - map {($_, substr(unpack(q(B8), chr $i++), 2, 6))} - split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/) -}; - -my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255; - -binmode(\\*STDOUT); - -# We are going to accumulate into $pending to accept any line length -# (we do not check they are <= 76 chars as the RFC says) -my $pending = q(); - -while (my $data = <STDIN>) { - chomp $data; - - # If we find one or two =, we have reached the end and - # any following data is to be discarded - my $finished = $data =~ s/(==?).*/$1/; - $pending .= $data; - - my $len = length($pending); - my $chunk = substr($pending, 0, $len & ~3); - $pending = substr($pending, $len & ~3 + 1); - - # Easy method: translate from chars to (pregenerated) six-bit packets, join, - # split in 8-bit chunks and convert back to char. - print join q(), - map $bytes{$_}, - ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); - - last if $finished; -}' 2>/dev/null" - "Perl program to use for decoding a file. -Escape sequence %s is replaced with name of Perl binary. -This string is passed to `format', so percent characters need to be doubled.") - -(defconst tramp-vc-registered-read-file-names - "echo \"(\" -while read file; do - if %s \"$file\"; then - echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\" - else - echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\" - fi - if %s \"$file\"; then - echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\" - else - echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\" - fi -done -echo \")\"" - "Script to check existence of VC related files. -It must be send formatted with two strings; the tests for file -existence, and file readability. Input shall be read via -here-document, otherwise the command could exceed maximum length -of command line.") - -(defconst tramp-file-mode-type-map - '((0 . "-") ; Normal file (SVID-v2 and XPG2) - (1 . "p") ; fifo - (2 . "c") ; character device - (3 . "m") ; multiplexed character device (v7) - (4 . "d") ; directory - (5 . "?") ; Named special file (XENIX) - (6 . "b") ; block device - (7 . "?") ; multiplexed block device (v7) - (8 . "-") ; regular file - (9 . "n") ; network special file (HP-UX) - (10 . "l") ; symlink - (11 . "?") ; ACL shadow inode (Solaris, not userspace) - (12 . "s") ; socket - (13 . "D") ; door special (Solaris) - (14 . "w")) ; whiteout (BSD) - "A list of file types returned from the `stat' system call. -This is used to map a mode number to a permission string.") - -;; New handlers should be added here. The following operations can be -;; handled using the normal primitives: file-name-sans-versions, -;; get-file-buffer. -(defconst tramp-file-name-handler-alist - '((load . tramp-handle-load) - (make-symbolic-link . tramp-handle-make-symbolic-link) - (file-name-as-directory . tramp-handle-file-name-as-directory) - (file-name-directory . tramp-handle-file-name-directory) - (file-name-nondirectory . tramp-handle-file-name-nondirectory) - (file-truename . tramp-handle-file-truename) - (file-exists-p . tramp-handle-file-exists-p) - (file-directory-p . tramp-handle-file-directory-p) - (file-executable-p . tramp-handle-file-executable-p) - (file-readable-p . tramp-handle-file-readable-p) - (file-regular-p . tramp-handle-file-regular-p) - (file-symlink-p . tramp-handle-file-symlink-p) - (file-writable-p . tramp-handle-file-writable-p) - (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p) - (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-attributes . tramp-handle-file-attributes) - (file-modes . tramp-handle-file-modes) - (directory-files . tramp-handle-directory-files) - (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) - (file-name-all-completions . tramp-handle-file-name-all-completions) - (file-name-completion . tramp-handle-file-name-completion) - (add-name-to-file . tramp-handle-add-name-to-file) - (copy-file . tramp-handle-copy-file) - (copy-directory . tramp-handle-copy-directory) - (rename-file . tramp-handle-rename-file) - (set-file-modes . tramp-handle-set-file-modes) - (set-file-times . tramp-handle-set-file-times) - (make-directory . tramp-handle-make-directory) - (delete-directory . tramp-handle-delete-directory) - (delete-file . tramp-handle-delete-file) - (directory-file-name . tramp-handle-directory-file-name) - ;; `executable-find' is not official yet. - (executable-find . tramp-handle-executable-find) - (start-file-process . tramp-handle-start-file-process) - (process-file . tramp-handle-process-file) - (shell-command . tramp-handle-shell-command) - (insert-directory . tramp-handle-insert-directory) - (expand-file-name . tramp-handle-expand-file-name) - (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (file-local-copy . tramp-handle-file-local-copy) - (file-remote-p . tramp-handle-file-remote-p) - (insert-file-contents . tramp-handle-insert-file-contents) - (insert-file-contents-literally - . tramp-handle-insert-file-contents-literally) - (write-region . tramp-handle-write-region) - (find-backup-file-name . tramp-handle-find-backup-file-name) - (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) - (dired-compress-file . tramp-handle-dired-compress-file) - (dired-recursive-delete-directory - . tramp-handle-dired-recursive-delete-directory) - (dired-uncache . tramp-handle-dired-uncache) - (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) - (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) - (file-selinux-context . tramp-handle-file-selinux-context) - (set-file-selinux-context . tramp-handle-set-file-selinux-context) - (vc-registered . tramp-handle-vc-registered)) - "Alist of handler functions. -Operations not mentioned here will be handled by the normal Emacs functions.") - -;; Handlers for partial Tramp file names. For Emacs just -;; `file-name-all-completions' is needed. ;;;###autoload (defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "Alist of completion handler functions. -Used for file names matching `tramp-file-name-regexp'. Operations not -mentioned here will be handled by `tramp-file-name-handler-alist' or the -normal Emacs functions.") +Used for file names matching `tramp-file-name-regexp'. Operations +not mentioned here will be handled by Tramp's file name handler +functions, or the normal Emacs functions.") ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here. -(defvar tramp-foreign-file-name-handler-alist - ;; (identity . tramp-sh-file-name-handler) should always be the last - ;; entry, because `identity' always matches. - '((identity . tramp-sh-file-name-handler)) +;;;###tramp-autoload +(defvar tramp-foreign-file-name-handler-alist nil "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially. If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by calling HANDLER.") ;;; Internal functions which must come first: + +;; ------------------------------------------------------------ +;; -- Tramp file names -- +;; ------------------------------------------------------------ +;; Conversion functions between external representation and +;; internal data structure. Convenience functions for internal +;; data structure. + +(defun tramp-file-name-p (vec) + "Check, whether VEC is a Tramp object." + (and (vectorp vec) (= 4 (length vec)))) + +(defun tramp-file-name-method (vec) + "Return method component of VEC." + (and (tramp-file-name-p vec) (aref vec 0))) + +(defun tramp-file-name-user (vec) + "Return user component of VEC." + (and (tramp-file-name-p vec) (aref vec 1))) + +(defun tramp-file-name-host (vec) + "Return host component of VEC." + (and (tramp-file-name-p vec) (aref vec 2))) + +(defun tramp-file-name-localname (vec) + "Return localname component of VEC." + (and (tramp-file-name-p vec) (aref vec 3))) + +;; The user part of a Tramp file name vector can be of kind +;; "user%domain". Sometimes, we must extract these parts. +(defun tramp-file-name-real-user (vec) + "Return the user name of VEC without domain." + (save-match-data + (let ((user (tramp-file-name-user vec))) + (if (and (stringp user) + (string-match tramp-user-with-domain-regexp user)) + (match-string 1 user) + user)))) + +(defun tramp-file-name-domain (vec) + "Return the domain name of VEC." + (save-match-data + (let ((user (tramp-file-name-user vec))) + (and (stringp user) + (string-match tramp-user-with-domain-regexp user) + (match-string 2 user))))) + +;; The host part of a Tramp file name vector can be of kind +;; "host#port". Sometimes, we must extract these parts. +(defun tramp-file-name-real-host (vec) + "Return the host name of VEC without port." + (save-match-data + (let ((host (tramp-file-name-host vec))) + (if (and (stringp host) + (string-match tramp-host-with-port-regexp host)) + (match-string 1 host) + host)))) + +(defun tramp-file-name-port (vec) + "Return the port number of VEC." + (save-match-data + (let ((host (tramp-file-name-host vec))) + (and (stringp host) + (string-match tramp-host-with-port-regexp host) + (string-to-number (match-string 2 host)))))) + +;;;###tramp-autoload +(defun tramp-tramp-file-p (name) + "Return t if NAME is a string with Tramp file name syntax." + (save-match-data + (and (stringp name) (string-match tramp-file-name-regexp name)))) + +(defun tramp-find-method (method user host) + "Return the right method string to use. +This is METHOD, if non-nil. Otherwise, do a lookup in +`tramp-default-method-alist'." + (or method + (let ((choices tramp-default-method-alist) + lmethod item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or host "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lmethod (nth 2 item)) + (setq choices nil))) + lmethod) + tramp-default-method)) + +(defun tramp-find-user (method user host) + "Return the right user string to use. +This is USER, if non-nil. Otherwise, do a lookup in +`tramp-default-user-alist'." + (or user + (let ((choices tramp-default-user-alist) + luser item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or method "")) + (string-match (or (nth 1 item) "") (or host ""))) + (setq luser (nth 2 item)) + (setq choices nil))) + luser) + tramp-default-user)) + +(defun tramp-find-host (method user host) + "Return the right host string to use. +This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." + (or (and (> (length host) 0) host) + tramp-default-host)) + +(defun tramp-dissect-file-name (name &optional nodefault) + "Return a `tramp-file-name' structure. +The structure consists of remote method, remote user, remote host +and localname (file name on remote host). If NODEFAULT is +non-nil, the file name parts are not expanded to their default +values." + (save-match-data + (let ((match (string-match (nth 0 tramp-file-name-structure) name))) + (unless match (error "Not a Tramp file name: %s" name)) + (let ((method (match-string (nth 1 tramp-file-name-structure) name)) + (user (match-string (nth 2 tramp-file-name-structure) name)) + (host (match-string (nth 3 tramp-file-name-structure) name)) + (localname (match-string (nth 4 tramp-file-name-structure) name))) + (when host + (when (string-match tramp-prefix-ipv6-regexp host) + (setq host (replace-match "" nil t host))) + (when (string-match tramp-postfix-ipv6-regexp host) + (setq host (replace-match "" nil t host)))) + (if nodefault + (vector method user host localname) + (vector + (tramp-find-method method user host) + (tramp-find-user method user host) + (tramp-find-host method user host) + localname)))))) + +(defun tramp-buffer-name (vec) + "A name for the connection buffer VEC." + ;; We must use `tramp-file-name-real-host', because for gateway + ;; methods the default port will be expanded later on, which would + ;; tamper the name. + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-real-host vec))) + (if (not (zerop (length user))) + (format "*tramp/%s %s@%s*" method user host) + (format "*tramp/%s %s*" method host)))) + +(defun tramp-make-tramp-file-name (method user host localname) + "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME." + (concat tramp-prefix-format + (when (not (zerop (length method))) + (concat method tramp-postfix-method-format)) + (when (not (zerop (length user))) + (concat user tramp-postfix-user-format)) + (when host + (if (string-match tramp-ipv6-regexp host) + (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) + host)) + tramp-postfix-host-format + (when localname localname))) + +(defun tramp-completion-make-tramp-file-name (method user host localname) + "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. +It must not be a complete Tramp file name, but as long as there are +necessary only. This function will be used in file name completion." + (concat tramp-prefix-format + (when (not (zerop (length method))) + (concat method tramp-postfix-method-format)) + (when (not (zerop (length user))) + (concat user tramp-postfix-user-format)) + (when (not (zerop (length host))) + (concat + (if (string-match tramp-ipv6-regexp host) + (concat + tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) + host) + tramp-postfix-host-format)) + (when localname localname))) + +(defun tramp-get-buffer (vec) + "Get the connection buffer to be used for VEC." + (or (get-buffer (tramp-buffer-name vec)) + (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + (setq buffer-undo-list t) + (setq default-directory + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + "/")) + (current-buffer)))) + +(defun tramp-get-connection-buffer (vec) + "Get the connection buffer to be used for VEC. +In case a second asynchronous communication has been started, it is different +from `tramp-get-buffer'." + (or (tramp-get-connection-property vec "process-buffer" nil) + (tramp-get-buffer vec))) + +(defun tramp-get-connection-process (vec) + "Get the connection process to be used for VEC. +In case a second asynchronous communication has been started, it is different +from the default one." + (get-process + (or (tramp-get-connection-property vec "process-name" nil) + (tramp-buffer-name vec)))) + +(defun tramp-debug-buffer-name (vec) + "A name for the debug buffer for VEC." + ;; We must use `tramp-file-name-real-host', because for gateway + ;; methods the default port will be expanded later on, which would + ;; tamper the name. + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-real-host vec))) + (if (not (zerop (length user))) + (format "*debug tramp/%s %s@%s*" method user host) + (format "*debug tramp/%s %s*" method host)))) + +(defconst tramp-debug-outline-regexp + "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #" + "Used for highlighting Tramp debug buffers in `outline-mode'.") + +(defun tramp-debug-outline-level () + "Return the depth to which a statement is nested in the outline. +Point must be at the beginning of a header line. + +The outline level is equal to the verbosity of the Tramp message." + (1+ (string-to-number (match-string 1)))) + +(defun tramp-get-debug-buffer (vec) + "Get the debug buffer for VEC." + (with-current-buffer + (get-buffer-create (tramp-debug-buffer-name vec)) + (when (bobp) + (setq buffer-undo-list t) + ;; Activate `outline-mode'. This runs `text-mode-hook' and + ;; `outline-mode-hook'. We must prevent that local processes + ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". + ;; Furthermore, `outline-regexp' must have the correct value + ;; already, because it is used by `font-lock-compile-keywords'. + (let ((default-directory (tramp-compat-temporary-file-directory)) + (outline-regexp tramp-debug-outline-regexp)) + (outline-mode)) + (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) + (set (make-local-variable 'outline-level) 'tramp-debug-outline-level)) + (current-buffer))) + (defsubst tramp-debug-message (vec fmt-string &rest args) "Append message to debug buffer. Message is formatted with FMT-STRING as control string and the remaining @@ -2173,36 +1324,34 @@ Calls functions `message' and `tramp-debug-message' with FMT-STRING as control string and the remaining ARGS to actually emit the message (if applicable)." - (condition-case nil - (when (<= level tramp-verbose) - ;; Match data must be preserved! - (save-match-data - ;; Display only when there is a minimum level. - (when (and tramp-message-show-message (<= level 3)) - (apply 'message - (concat - (cond - ((= level 0) "") - ((= level 1) "") - ((= level 2) "Warning: ") - (t "Tramp: ")) - fmt-string) - args)) - ;; Log only when there is a minimum level. - (when (>= tramp-verbose 4) - (when (and vec-or-proc - (processp vec-or-proc) - (buffer-name (process-buffer vec-or-proc))) - (with-current-buffer (process-buffer vec-or-proc) - ;; Translate proc to vec. - (setq vec-or-proc (tramp-dissect-file-name default-directory)))) - (when (and vec-or-proc (vectorp vec-or-proc)) - (apply 'tramp-debug-message - vec-or-proc - (concat (format "(%d) # " level) fmt-string) - args))))) - ;; Suppress all errors. - (error nil))) + (ignore-errors + (when (<= level tramp-verbose) + ;; Match data must be preserved! + (save-match-data + ;; Display only when there is a minimum level. + (when (and tramp-message-show-message (<= level 3)) + (apply 'message + (concat + (cond + ((= level 0) "") + ((= level 1) "") + ((= level 2) "Warning: ") + (t "Tramp: ")) + fmt-string) + args)) + ;; Log only when there is a minimum level. + (when (>= tramp-verbose 4) + (when (and vec-or-proc + (processp vec-or-proc) + (buffer-name (process-buffer vec-or-proc))) + (with-current-buffer (process-buffer vec-or-proc) + ;; Translate proc to vec. + (setq vec-or-proc (tramp-dissect-file-name default-directory)))) + (when (and vec-or-proc (vectorp vec-or-proc)) + (apply 'tramp-debug-message + vec-or-proc + (concat (format "(%d) # " level) fmt-string) + args))))))) (defsubst tramp-error (vec-or-proc signal fmt-string &rest args) "Emit an error. @@ -2264,46 +1413,14 @@ (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) - -(defmacro with-file-property (vec file property &rest body) - "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. -FILE must be a local file name on a connection identified via VEC." - `(if (file-name-absolute-p ,file) - (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass @body as parameter to - ;; `tramp-set-file-property' because it mangles our - ;; debug messages. - (setq value (progn ,@body)) - (tramp-set-file-property ,vec ,file ,property value)) - value) - ,@body)) - -(put 'with-file-property 'lisp-indent-function 3) -(put 'with-file-property 'edebug-form-spec t) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>")) - -(defmacro with-connection-property (key property &rest body) - "Check in Tramp for property PROPERTY, otherwise executes BODY and set." - `(let ((value (tramp-get-connection-property ,key ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass ,@body as parameter to - ;; `tramp-set-connection-property' because it mangles our debug - ;; messages. - (setq value (progn ,@body)) - (tramp-set-connection-property ,key ,property value)) - value)) - -(put 'with-connection-property 'lisp-indent-function 2) -(put 'with-connection-property 'edebug-form-spec t) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>")) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) (defun tramp-progress-reporter-update (reporter &optional value) (let* ((parameters (cdr reporter)) (message (aref parameters 3))) (when (string-match message (or (current-message) "")) - (funcall 'progress-reporter-update reporter value)))) + (tramp-compat-funcall 'progress-reporter-update reporter value)))) (defmacro with-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. @@ -2317,11 +1434,10 @@ (when (and tramp-message-show-message ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) - (condition-case nil - (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) - tm (when pr - (run-at-time 3 0.1 'tramp-progress-reporter-update pr))) - (error nil))) + (ignore-errors + (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) + tm (when pr + (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) (unwind-protect ;; Execute the body. Unset `tramp-message-show-message' when ;; the timer object is created, in order to suppress @@ -2335,7 +1451,8 @@ (put 'with-progress-reporter 'lisp-indent-function 3) (put 'with-progress-reporter 'edebug-form-spec t) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>")) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-progress-reporter\\>")) (eval-and-compile ;; Silence compiler. (if (memq system-type '(cygwin windows-nt)) @@ -2352,34 +1469,6 @@ (defalias 'tramp-drop-volume-letter 'identity))) -(defsubst tramp-make-tramp-temp-file (vec) - "Create a temporary file on the remote host identified by VEC. -Return the local name of the temporary file." - (let ((prefix - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - (tramp-drop-volume-letter - (expand-file-name - tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))) - result) - (while (not result) - ;; `make-temp-file' would be the natural choice for - ;; implementation. But it calls `write-region' internally, - ;; which also needs a temporary file - we would end in an - ;; infinite loop. - (setq result (make-temp-name prefix)) - (if (file-exists-p result) - (setq result nil) - ;; This creates the file by side effect. - (set-file-times result) - (set-file-modes result (tramp-octal-to-decimal "0700")))) - - ;; Return the local part. - (with-parsed-tramp-file-name result nil localname))) - - ;;; Config Manipulation Functions: (defun tramp-set-completion-function (method function-list) @@ -2414,7 +1503,7 @@ ;; Windows registry. (and (memq system-type '(cygwin windows-nt)) (zerop - (tramp-local-call-process + (tramp-compat-call-process "reg" nil nil nil "query" (nth 1 (car v))))) ;; Configuration file. (file-exists-p (nth 1 (car v))))) @@ -2502,279 +1591,6 @@ (remove-hook 'rfn-eshadow-update-overlay-hook 'tramp-rfn-eshadow-update-overlay)))) - -;;; Integration of eshell.el: - -(eval-when-compile - (defvar eshell-path-env)) - -;; eshell.el keeps the path in `eshell-path-env'. We must change it -;; when `default-directory' points to another host. -(defun tramp-eshell-directory-change () - "Set `eshell-path-env' to $PATH of the host related to `default-directory'." - (setq eshell-path-env - (if (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory nil - (mapconcat - 'identity - (tramp-get-remote-path v) - ":")) - (getenv "PATH")))) - -(eval-after-load "esh-util" - '(progn - (tramp-eshell-directory-change) - (add-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change))))) - - -;;; File Name Handler Functions: - -(defun tramp-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (with-parsed-tramp-file-name linkname l - (let ((ln (tramp-get-remote-ln l)) - (cwd (tramp-run-real-handler - 'file-name-directory (list l-localname)))) - (unless ln - (tramp-error - l 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - l-localname))))) - (tramp-error - l 'file-already-exists "File %s already exists" l-localname) - (delete-file linkname))) - - ;; If FILENAME is a Tramp name, use just the localname component. - (when (tramp-tramp-file-p filename) - (setq filename - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name filename))))) - - (tramp-flush-file-property l (file-name-directory l-localname)) - (tramp-flush-file-property l l-localname) - - ;; Right, they are on the same host, regardless of user, method, etc. - ;; We now make the link on the remote machine. This will occur as the user - ;; that FILENAME belongs to. - (zerop - (tramp-send-command-and-check - l - (format - "cd %s && %s -sf %s %s" - (tramp-shell-quote-argument cwd) - ln - (tramp-shell-quote-argument filename) - (tramp-shell-quote-argument l-localname)) - t))))) - -(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) - "Like `load' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name file) nil - (unless nosuffix - (cond ((file-exists-p (concat file ".elc")) - (setq file (concat file ".elc"))) - ((file-exists-p (concat file ".el")) - (setq file (concat file ".el"))))) - (when must-suffix - ;; The first condition is always true for absolute file names. - ;; Included for safety's sake. - (unless (or (file-name-directory file) - (string-match "\\.elc?\\'" file)) - (tramp-error - v 'file-error - "File `%s' does not include a `.el' or `.elc' suffix" file))) - (unless noerror - (when (not (file-exists-p file)) - (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file))) - (if (not (file-exists-p file)) - nil - (let ((tramp-message-show-message (not nomessage))) - (with-progress-reporter v 0 (format "Loading %s" file) - (let ((local-copy (file-local-copy file))) - ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. - (unwind-protect - (load local-copy noerror t t) - (delete-file local-copy))))) - t))) - -;; Localname manipulation functions that grok Tramp localnames... -(defun tramp-handle-file-name-as-directory (file) - "Like `file-name-as-directory' but aware of Tramp files." - ;; `file-name-as-directory' would be sufficient except localname is - ;; the empty string. - (let ((v (tramp-dissect-file-name file t))) - ;; Run the command on the localname portion only. - (tramp-make-tramp-file-name - (tramp-file-name-method v) - (tramp-file-name-user v) - (tramp-file-name-host v) - (tramp-run-real-handler - 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))))) - -(defun tramp-handle-file-name-directory (file) - "Like `file-name-directory' but aware of Tramp files." - ;; Everything except the last filename thing is the directory. We - ;; cannot apply `with-parsed-tramp-file-name', because this expands - ;; the remote file name parts. This is a problem when we are in - ;; file name completion. - (let ((v (tramp-dissect-file-name file t))) - ;; Run the command on the localname portion only. - (tramp-make-tramp-file-name - (tramp-file-name-method v) - (tramp-file-name-user v) - (tramp-file-name-host v) - (tramp-run-real-handler - 'file-name-directory (list (or (tramp-file-name-localname v) "")))))) - -(defun tramp-handle-file-name-nondirectory (file) - "Like `file-name-nondirectory' but aware of Tramp files." - (with-parsed-tramp-file-name file nil - (tramp-run-real-handler 'file-name-nondirectory (list localname)))) - -(defun tramp-handle-file-truename (filename &optional counter prev-dirs) - "Like `file-truename' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order - (tramp-message v 4 "Finding true name for `%s'" filename) - (cond - ;; Use GNU readlink --canonicalize-missing where available. - ((tramp-get-remote-readlink v) - (setq result - (tramp-send-command-and-read - v - (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\"" - (tramp-get-remote-readlink v) - (tramp-shell-quote-argument localname))))) - - ;; Use Perl implementation. - ((and (tramp-get-remote-perl v) - (tramp-get-connection-property v "perl-file-spec" nil) - (tramp-get-connection-property v "perl-cwd-realpath" nil)) - (tramp-maybe-send-script - v tramp-perl-file-truename "tramp_perl_file_truename") - (setq result - (tramp-send-command-and-read - v - (format "tramp_perl_file_truename %s" - (tramp-shell-quote-argument localname))))) - - ;; Do it yourself. We bind `directory-sep-char' here for - ;; XEmacs on Windows, which would otherwise use backslash. - (t (let* ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) - (localnamedir (tramp-run-real-handler - 'file-name-as-directory (list localname))) - (is-dir (string= localname localnamedir)) - (thisstep nil) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in a - ;; timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) - (while (and steps (< numchase numchase-limit)) - (setq thisstep (pop steps)) - (tramp-message - v 5 "Check %s" - (mapconcat 'identity - (append '("") (reverse result) (list thisstep)) - "/")) - (setq symlink-target - (nth 0 (file-attributes - (tramp-make-tramp-file-name - method user host - (mapconcat 'identity - (append '("") - (reverse result) - (list thisstep)) - "/"))))) - (cond ((string= "." thisstep) - (tramp-message v 5 "Ignoring step `.'")) - ((string= ".." thisstep) - (tramp-message v 5 "Processing step `..'") - (pop result)) - ((stringp symlink-target) - ;; It's a symlink, follow it. - (tramp-message v 5 "Follow symlink to %s" symlink-target) - (setq numchase (1+ numchase)) - (when (file-name-absolute-p symlink-target) - (setq result nil)) - ;; If the symlink was absolute, we'll get a string like - ;; "/user@host:/some/target"; extract the - ;; "/some/target" part from it. - (when (tramp-tramp-file-p symlink-target) - (unless (tramp-equal-remote filename symlink-target) - (tramp-error - v 'file-error - "Symlink target `%s' on wrong host" symlink-target)) - (setq symlink-target localname)) - (setq steps - (append (tramp-compat-split-string - symlink-target "/") - steps))) - (t - ;; It's a file. - (setq result (cons thisstep result))))) - (when (>= numchase numchase-limit) - (tramp-error - v 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit)) - (setq result (reverse result)) - ;; Combine list to form string. - (setq result - (if result - (mapconcat 'identity (cons "" result) "/") - "/")) - (when (and is-dir (or (string= "" result) - (not (string= (substring result -1) "/")))) - (setq result (concat result "/")))))) - - (tramp-message v 4 "True name of `%s' is `%s'" filename result) - (tramp-make-tramp-file-name method user host result))))) - -;; Basic functions. - -(defun tramp-handle-file-exists-p (filename) - "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-exists-p" - (or (not (null (tramp-get-file-property - v localname "file-attributes-integer" nil))) - (not (null (tramp-get-file-property - v localname "file-attributes-string" nil))) - (zerop (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname)))))))) - ;; Inodes don't exist for some file systems. Therefore we must ;; generate virtual ones. Used in `find-buffer-visiting'. The method ;; applied might be not so efficient (Ange-FTP uses hashes). But @@ -2791,1638 +1607,12 @@ (defvar tramp-devices nil "Keeps virtual device numbers.") -;; CCC: This should check for an error condition and signal failure -;; when something goes wrong. -;; Daniel Pittman <daniel@danann.net> -(defun tramp-handle-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp files." - (unless id-format (setq id-format 'integer)) - ;; Don't modify `last-coding-system-used' by accident. - (let ((last-coding-system-used last-coding-system-used)) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname (format "file-attributes-%s" id-format) - (save-excursion - (tramp-convert-file-attributes - v - (cond - ((tramp-get-remote-stat v) - (tramp-do-file-attributes-with-stat v localname id-format)) - ((tramp-get-remote-perl v) - (tramp-do-file-attributes-with-perl v localname id-format)) - (t - (tramp-do-file-attributes-with-ls v localname id-format))))))))) - -(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) - "Implement `file-attributes' for Tramp files using the ls(1) command." - (let (symlinkp dirp - res-inode res-filemodes res-numlinks - res-uid res-gid res-size res-symlink-target) - (tramp-message vec 5 "file attributes with ls: %s" localname) - (tramp-send-command - vec - (format "(%s %s || %s -h %s) && %s %s %s" - (tramp-get-file-exists-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-test-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-ls-command vec) - (if (eq id-format 'integer) "-ildn" "-ild") - (tramp-shell-quote-argument localname))) - ;; parse `ls -l' output ... - (with-current-buffer (tramp-get-buffer vec) - (when (> (buffer-size) 0) - (goto-char (point-min)) - ;; ... inode - (setq res-inode - (condition-case err - (read (current-buffer)) - (invalid-read-syntax - (when (and (equal (cadr err) - "Integer constant overflow in reader") - (string-match - "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" - (car (cddr err)))) - (let* ((big (read (substring (car (cddr err)) 0 - (match-beginning 1)))) - (small (read (match-string 1 (car (cddr err))))) - (twiddle (/ small 65536))) - (cons (+ big twiddle) - (- small (* twiddle 65536)))))))) - ;; ... file mode flags - (setq res-filemodes (symbol-name (read (current-buffer)))) - ;; ... number links - (setq res-numlinks (read (current-buffer))) - ;; ... uid and gid - (setq res-uid (read (current-buffer))) - (setq res-gid (read (current-buffer))) - (if (eq id-format 'integer) - (progn - (unless (numberp res-uid) (setq res-uid -1)) - (unless (numberp res-gid) (setq res-gid -1))) - (progn - (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) - (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) - ;; ... size - (setq res-size (read (current-buffer))) - ;; From the file modes, figure out other stuff. - (setq symlinkp (eq ?l (aref res-filemodes 0))) - (setq dirp (eq ?d (aref res-filemodes 0))) - ;; if symlink, find out file name pointed to - (when symlinkp - (search-forward "-> ") - (setq res-symlink-target - (buffer-substring (point) (tramp-compat-line-end-position)))) - ;; return data gathered - (list - ;; 0. t for directory, string (name linked to) for symbolic - ;; link, or nil. - (or dirp res-symlink-target) - ;; 1. Number of links to file. - res-numlinks - ;; 2. File uid. - res-uid - ;; 3. File gid. - res-gid - ;; 4. Last access time, as a list of two integers. First - ;; integer has high-order 16 bits of time, second has low 16 - ;; bits. - ;; 5. Last modification time, likewise. - ;; 6. Last status change time, likewise. - '(0 0) '(0 0) '(0 0) ;CCC how to find out? - ;; 7. Size in bytes (-1, if number is out of range). - res-size - ;; 8. File modes, as a string of ten letters or dashes as in ls -l. - res-filemodes - ;; 9. t if file's gid would change if file were deleted and - ;; recreated. Will be set in `tramp-convert-file-attributes' - t - ;; 10. inode number. - res-inode - ;; 11. Device number. Will be replaced by a virtual device number. - -1 - ))))) - -(defun tramp-do-file-attributes-with-perl - (vec localname &optional id-format) - "Implement `file-attributes' for Tramp files using a Perl script." - (tramp-message vec 5 "file attributes with perl: %s" localname) - (tramp-maybe-send-script - vec tramp-perl-file-attributes "tramp_perl_file_attributes") - (tramp-send-command-and-read - vec - (format "tramp_perl_file_attributes %s %s" - (tramp-shell-quote-argument localname) id-format))) - -(defun tramp-do-file-attributes-with-stat - (vec localname &optional id-format) - "Implement `file-attributes' for Tramp files using stat(1) command." - (tramp-message vec 5 "file attributes with stat: %s" localname) - (tramp-send-command-and-read - vec - (format - ;; On Opsware, pdksh (which is the true name of ksh there) doesn't - ;; parse correctly the sequence "((". Therefore, we add a space. - "( (%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)" - (tramp-get-file-exists-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-test-command vec) - (tramp-shell-quote-argument localname) - (tramp-get-remote-stat vec) - (if (eq id-format 'integer) "%u" "\"%U\"") - (if (eq id-format 'integer) "%g" "\"%G\"") - (tramp-shell-quote-argument localname)))) - -(defun tramp-handle-set-visited-file-modtime (&optional time-list) - "Like `set-visited-file-modtime' for Tramp files." - (unless (buffer-file-name) - (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" - (buffer-name))) - (if time-list - (tramp-run-real-handler 'set-visited-file-modtime (list time-list)) - (let ((f (buffer-file-name)) - coding-system-used) - (with-parsed-tramp-file-name f nil - (let* ((attr (file-attributes f)) - ;; '(-1 65535) means file doesn't exists yet. - (modtime (or (nth 5 attr) '(-1 65535)))) - (when (boundp 'last-coding-system-used) - (setq coding-system-used (symbol-value 'last-coding-system-used))) - ;; We use '(0 0) as a don't-know value. See also - ;; `tramp-do-file-attributes-with-ls'. - (if (not (equal modtime '(0 0))) - (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) - (progn - (tramp-send-command - v - (format "%s -ild %s" - (tramp-get-ls-command v) - (tramp-shell-quote-argument localname))) - (setq attr (buffer-substring (point) - (progn (end-of-line) (point))))) - (tramp-set-file-property - v localname "visited-file-modtime-ild" attr)) - (when (boundp 'last-coding-system-used) - (set 'last-coding-system-used coding-system-used)) - nil))))) - -;; This function makes the same assumption as -;; `tramp-handle-set-visited-file-modtime'. -(defun tramp-handle-verify-visited-file-modtime (buf) - "Like `verify-visited-file-modtime' for Tramp files. -At the time `verify-visited-file-modtime' calls this function, we -already know that the buffer is visiting a file and that -`visited-file-modtime' does not return 0. Do not call this -function directly, unless those two cases are already taken care -of." - (with-current-buffer buf - (let ((f (buffer-file-name))) - ;; There is no file visiting the buffer, or the buffer has no - ;; recorded last modification time, or there is no established - ;; connection. - (if (or (not f) - (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) - t - (with-parsed-tramp-file-name f nil - (tramp-flush-file-property v localname) - (let* ((attr (file-attributes f)) - (modtime (nth 5 attr)) - (mt (visited-file-modtime))) - - (cond - ;; File exists, and has a known modtime. - ((and attr (not (equal modtime '(0 0)))) - (< (abs (tramp-time-diff - modtime - ;; For compatibility, deal with both the old - ;; (HIGH . LOW) and the new (HIGH LOW) return - ;; values of `visited-file-modtime'. - (if (atom (cdr mt)) - (list (car mt) (cdr mt)) - mt))) - 2)) - ;; Modtime has the don't know value. - (attr - (tramp-send-command - v - (format "%s -ild %s" - (tramp-get-ls-command v) - (tramp-shell-quote-argument localname))) - (with-current-buffer (tramp-get-buffer v) - (setq attr (buffer-substring - (point) (progn (end-of-line) (point))))) - (equal - attr - (tramp-get-file-property - v localname "visited-file-modtime-ild" ""))) - ;; If file does not exist, say it is not modified if and - ;; only if that agrees with the buffer's record. - (t (equal mt '(-1 65535)))))))))) - -(defun tramp-handle-set-file-modes (filename mode) - "Like `set-file-modes' for Tramp files." - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v localname) - (unless (zerop (tramp-send-command-and-check - v - (format "chmod %s %s" - (tramp-decimal-to-octal mode) - (tramp-shell-quote-argument localname)))) - ;; FIXME: extract the proper text from chmod's stderr. - (tramp-error - v 'file-error "Error while changing file's mode %s" filename)))) - -(defun tramp-handle-set-file-times (filename &optional time) - "Like `set-file-times' for Tramp files." - (zerop - (if (file-remote-p filename) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v localname) - (let ((time (if (or (null time) (equal time '(0 0))) - (current-time) - time)) - ;; With GNU Emacs, `format-time-string' has an optional - ;; parameter UNIVERSAL. This is preferred, because we - ;; could handle the case when the remote host is - ;; located in a different time zone as the local host. - (utc (not (featurep 'xemacs)))) - (tramp-send-command-and-check - v (format "%s touch -t %s %s" - (if utc "TZ=UTC; export TZ;" "") - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time)) - (tramp-shell-quote-argument localname))))) - - ;; We handle also the local part, because in older Emacsen, - ;; without `set-file-times', this function is an alias for this. - ;; We are local, so we don't need the UTC settings. - (tramp-local-call-process - "touch" nil nil nil "-t" - (format-time-string "%Y%m%d%H%M.%S" time) - (tramp-shell-quote-argument filename))))) - -(defun tramp-set-file-uid-gid (filename &optional uid gid) - "Set the ownership for FILENAME. -If UID and GID are provided, these values are used; otherwise uid -and gid of the corresponding user is taken. Both parameters must be integers." - ;; Modern Unices allow chown only for root. So we might need - ;; another implementation, see `dired-do-chown'. OTOH, it is mostly - ;; working with su(do)? when it is needed, so it shall succeed in - ;; the majority of cases. - ;; Don't modify `last-coding-system-used' by accident. - (let ((last-coding-system-used last-coding-system-used)) - (if (file-remote-p filename) - (with-parsed-tramp-file-name filename nil - (if (and (zerop (user-uid)) (tramp-local-host-p v)) - ;; If we are root on the local host, we can do it directly. - (tramp-set-file-uid-gid localname uid gid) - (let ((uid (or (and (integerp uid) uid) - (tramp-get-remote-uid v 'integer))) - (gid (or (and (integerp gid) gid) - (tramp-get-remote-gid v 'integer)))) - (tramp-send-command - v (format - "chown %d:%d %s" uid gid - (tramp-shell-quote-argument localname)))))) - - ;; We handle also the local part, because there doesn't exist - ;; `set-file-uid-gid'. On W32 "chown" might not work. - (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer))) - (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))) - (tramp-local-call-process - "chown" nil nil nil - (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) - -(defun tramp-remote-selinux-p (vec) - "Check, whether SELINUX is enabled on the remote host." - (with-connection-property (tramp-get-connection-process vec) "selinux-p" - (let ((result (tramp-find-executable - vec "getenforce" (tramp-get-remote-path vec) t t))) - (and result - (string-equal - (tramp-send-command-and-read - vec (format "echo \\\"`%S`\\\"" result)) - "Enforcing"))))) - -(defun tramp-handle-file-selinux-context (filename) - "Like `file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-selinux-context" - (let ((context '(nil nil nil nil)) - (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" - "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))) - (when (and (tramp-remote-selinux-p v) - (zerop (tramp-send-command-and-check - v (format - "%s -d -Z %s" - (tramp-get-ls-command v) - (tramp-shell-quote-argument localname))))) - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (when (re-search-forward regexp (tramp-compat-line-end-position) t) - (setq context (list (match-string 1) (match-string 2) - (match-string 3) (match-string 4)))))) - ;; Return the context. - context)))) - -(defun tramp-handle-set-file-selinux-context (filename context) - "Like `set-file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil - (if (and (consp context) - (tramp-remote-selinux-p v) - (zerop (tramp-send-command-and-check - v (format "chcon %s %s %s %s %s" - (if (stringp (nth 0 context)) - (format "--user=%s" (nth 0 context)) "") - (if (stringp (nth 1 context)) - (format "--role=%s" (nth 1 context)) "") - (if (stringp (nth 2 context)) - (format "--type=%s" (nth 2 context)) "") - (if (stringp (nth 3 context)) - (format "--range=%s" (nth 3 context)) "") - (tramp-shell-quote-argument localname))))) - (tramp-set-file-property v localname "file-selinux-context" context) - (tramp-set-file-property v localname "file-selinux-context" 'undef))) - ;; We always return nil. - nil) - -;; Simple functions using the `test' command. - -(defun tramp-handle-file-executable-p (filename) - "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-executable-p" - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (or (tramp-check-cached-permissions v ?x) - (zerop (tramp-run-test "-x" filename)))))) - -(defun tramp-handle-file-readable-p (filename) - "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-readable-p" - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (or (tramp-check-cached-permissions v ?r) - (zerop (tramp-run-test "-r" filename)))))) - -;; When the remote shell is started, it looks for a shell which groks -;; tilde expansion. Here, we assume that all shells which grok tilde -;; expansion will also provide a `test' command which groks `-nt' (for -;; newer than). If this breaks, tell me about it and I'll try to do -;; something smarter about it. -(defun tramp-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond ((not (file-exists-p file1)) - nil) - ((not (file-exists-p file2)) - t) - ;; We are sure both files exist at this point. - (t - (save-excursion - ;; We try to get the mtime of both files. If they are not - ;; equal to the "dont-know" value, then we subtract the times - ;; and obtain the result. - (let ((fa1 (file-attributes file1)) - (fa2 (file-attributes file2))) - (if (and (not (equal (nth 5 fa1) '(0 0))) - (not (equal (nth 5 fa2) '(0 0)))) - (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1))) - ;; If one of them is the dont-know value, then we can - ;; still try to run a shell command on the remote host. - ;; However, this only works if both files are Tramp - ;; files and both have the same method, same user, same - ;; host. - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "Files %s and %s must have same method, user, host" - file1 file2))) - (with-parsed-tramp-file-name file1 nil - (zerop (tramp-run-test2 - (tramp-get-test-nt-command v) file1 file2))))))))) - -;; Functions implemented using the basic functions above. - -(defun tramp-handle-file-modes (filename) - "Like `file-modes' for Tramp files." - (let ((truename (or (file-truename filename) filename))) - (when (file-exists-p truename) - (tramp-mode-string-to-int (nth 8 (file-attributes truename)))))) - (defun tramp-default-file-modes (filename) "Return file modes of FILENAME as integer. If the file modes of FILENAME cannot be determined, return the value of `default-file-modes', without execute permissions." (or (file-modes filename) - (logand (default-file-modes) (tramp-octal-to-decimal "0666")))) - -(defun tramp-handle-file-directory-p (filename) - "Like `file-directory-p' for Tramp files." - ;; Care must be taken that this function returns `t' for symlinks - ;; pointing to directories. Surely the most obvious implementation - ;; would be `test -d', but that returns false for such symlinks. - ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And - ;; I now think he's right. So we could be using `test -d', couldn't - ;; we? - ;; - ;; Alternatives: `cd %s', `test -d %s' - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-directory-p" - (zerop (tramp-run-test "-d" filename))))) - -(defun tramp-handle-file-regular-p (filename) - "Like `file-regular-p' for Tramp files." - (and (file-exists-p filename) - (eq ?- (aref (nth 8 (file-attributes filename)) 0)))) - -(defun tramp-handle-file-symlink-p (filename) - "Like `file-symlink-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (let ((x (car (file-attributes filename)))) - (when (stringp x) - ;; When Tramp is running on VMS, then `file-name-absolute-p' - ;; might do weird things. - (if (file-name-absolute-p x) - (tramp-make-tramp-file-name method user host x) - x))))) - -(defun tramp-handle-file-writable-p (filename) - "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-writable-p" - (if (file-exists-p filename) - ;; Examine `file-attributes' cache to see if request can be - ;; satisfied without remote operation. - (or (tramp-check-cached-permissions v ?w) - (zerop (tramp-run-test "-w" filename))) - ;; If file doesn't exist, check if directory is writable. - (and (zerop (tramp-run-test - "-d" (file-name-directory filename))) - (zerop (tramp-run-test - "-w" (file-name-directory filename)))))))) - -(defun tramp-handle-file-ownership-preserved-p (filename) - "Like `file-ownership-preserved-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-ownership-preserved-p" - (let ((attributes (file-attributes filename))) - ;; Return t if the file doesn't exist, since it's true that no - ;; information would be lost by an (attempted) delete and create. - (or (null attributes) - (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))))))) - -;; Other file name ops. - -(defun tramp-handle-directory-file-name (directory) - "Like `directory-file-name' for Tramp files." - ;; If localname component of filename is "/", leave it unchanged. - ;; Otherwise, remove any trailing slash from localname component. - ;; Method, host, etc, are unchanged. Does it make sense to try - ;; to avoid parsing the filename? - (with-parsed-tramp-file-name directory nil - (if (and (not (zerop (length localname))) - (eq (aref localname (1- (length localname))) ?/) - (not (string= localname "/"))) - (substring directory 0 -1) - directory))) - -;; Directory listings. - -(defun tramp-handle-directory-files - (directory &optional full match nosort files-only) - "Like `directory-files' for Tramp files." - ;; FILES-ONLY is valid for XEmacs only. - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - result item) - - (while temp - (setq item (directory-file-name (pop temp))) - (when (and (or (null match) (string-match match item)) - (or (null files-only) - ;; Files only. - (and (equal files-only t) (file-regular-p item)) - ;; Directories only. - (file-directory-p item))) - (push (if full (concat directory item) item) - result))) - (if nosort result (sort result 'string<))))) - -(defun tramp-handle-directory-files-and-attributes - (directory &optional full match nosort id-format) - "Like `directory-files-and-attributes' for Tramp files." - (unless id-format (setq id-format 'integer)) - (when (file-directory-p directory) - (setq directory (expand-file-name directory)) - (let* ((temp - (copy-tree - (with-parsed-tramp-file-name directory nil - (with-file-property - v localname - (format "directory-files-and-attributes-%s" id-format) - (save-excursion - (mapcar - (lambda (x) - (cons (car x) - (tramp-convert-file-attributes v (cdr x)))) - (cond - ((tramp-get-remote-stat v) - (tramp-do-directory-files-and-attributes-with-stat - v localname id-format)) - ((tramp-get-remote-perl v) - (tramp-do-directory-files-and-attributes-with-perl - v localname id-format))))))))) - result item) - - (while temp - (setq item (pop temp)) - (when (or (null match) (string-match match (car item))) - (when full - (setcar item (expand-file-name (car item) directory))) - (push item result))) - - (if nosort - result - (sort result (lambda (x y) (string< (car x) (car y)))))))) - -(defun tramp-do-directory-files-and-attributes-with-perl - (vec localname &optional id-format) - "Implement `directory-files-and-attributes' for Tramp files using a Perl script." - (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname) - (tramp-maybe-send-script - vec tramp-perl-directory-files-and-attributes - "tramp_perl_directory_files_and_attributes") - (let ((object - (tramp-send-command-and-read - vec - (format "tramp_perl_directory_files_and_attributes %s %s" - (tramp-shell-quote-argument localname) id-format)))) - (when (stringp object) (tramp-error vec 'file-error object)) - object)) - -(defun tramp-do-directory-files-and-attributes-with-stat - (vec localname &optional id-format) - "Implement `directory-files-and-attributes' for Tramp files using stat(1) command." - (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname) - (tramp-send-command-and-read - vec - (format - (concat - ;; We must care about filenames with spaces, or starting with - ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, - ;; but it does not work on all remote systems. Therefore, we - ;; quote the filenames via sed. - "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs " - "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); " - "echo \")\"") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command vec) - (tramp-get-remote-stat vec) - (if (eq id-format 'integer) "%u" "\"%U\"") - (if (eq id-format 'integer) "%g" "\"%G\"")))) - -;; This function should return "foo/" for directories and "bar" for -;; files. -(defun tramp-handle-file-name-all-completions (filename directory) - "Like `file-name-all-completions' for Tramp files." - (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil - - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache first - (and - ;; Ignore if expired - (or (not (integerp tramp-completion-reread-directory-timeout)) - (<= (tramp-time-diff - (current-time) - (tramp-get-file-property - v localname "last-completion" '(0 0 0))) - tramp-completion-reread-directory-timeout)) - - ;; Try cache entries for filename, filename with last - ;; character removed, filename with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name - - ;; This is inefficient for very long filenames, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - (tramp-compat-number-sequence (length filename) 0 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing '/'. Because I - ;; rock. --daniel@danann.net - - ;; Changed to perform `cd' in the same remote op and only - ;; get entries starting with `filename'. Capture any `cd' - ;; error messages. Ensure any `cd' and `echo' aliases are - ;; ignored. - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s %s %d" - (tramp-shell-quote-argument localname) - (tramp-shell-quote-argument filename) - (if (symbol-value - ;; `read-file-name-completion-ignore-case' - ;; is introduced with Emacs 22.1. - (if (boundp - 'read-file-name-completion-ignore-case) - 'read-file-name-completion-ignore-case - 'completion-ignore-case)) - 1 0))) - - (format (concat - "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null" - ;; `ls' with wildcard might fail with `Argument - ;; list too long' error in some corner cases; if - ;; `ls' fails after `cd' succeeded, chances are - ;; that's the case, so let's retry without - ;; wildcard. This will return "too many" entries - ;; but that isn't harmful. - " || %s -a 2>/dev/null)" - " | while read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - ;; When `filename' is empty, just `ls' without - ;; filename argument is more efficient than `ls *' - ;; for very large directories and might avoid the - ;; `Argument list too long' error. - ;; - ;; With and only with wildcard, we need to add - ;; `-d' to prevent `ls' from descending into - ;; sub-directories. - (if (zerop (length filename)) - "." - (concat (tramp-shell-quote-argument filename) "* -d")) - (tramp-get-ls-command v) - (tramp-get-test-command v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output - (forward-line -1) - (if (looking-at "^fail$") - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1') - (forward-line -1) - (tramp-error - v 'file-error - "tramp-handle-file-name-all-completions: %s" - (buffer-substring - (point) (tramp-compat-line-end-position)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at "^ok$") - (tramp-error - v 'file-error - "\ -tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'" - (tramp-shell-quote-argument localname) (buffer-string)))) - - (while (zerop (forward-line -1)) - (push (buffer-substring - (point) (tramp-compat-line-end-position)) - result))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists - (tramp-set-file-property - v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - (tramp-set-file-property - v localname "last-completion" (current-time)) - - ;; Store result in the cache - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" - result)))))))) - -(defun tramp-handle-file-name-completion - (filename directory &optional predicate) - "Like `file-name-completion' for Tramp files." - (unless (tramp-tramp-file-p directory) - (error - "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" - directory)) - (try-completion - filename - (mapcar 'list (file-name-all-completions filename directory)) - (when predicate - (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) - -;; cp, mv and ln - -(defun tramp-handle-add-name-to-file - (filename newname &optional ok-if-already-exists) - "Like `add-name-to-file' for Tramp files." - (unless (tramp-equal-remote filename newname) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-error - v 'file-error - "add-name-to-file: %s" - "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (let ((ln (when v1 (tramp-get-remote-ln v1)))) - (when (and (not ok-if-already-exists) - (file-exists-p newname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error - v2 'file-error - "add-name-to-file: file %s already exists" newname)) - (tramp-flush-file-property v2 (file-name-directory v2-localname)) - (tramp-flush-file-property v2 v2-localname) - (tramp-barf-unless-okay - v1 - (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname)) - "error with add-name-to-file, see buffer `%s' for details" - (buffer-name)))))) - -(defun tramp-handle-copy-file - (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) - "Like `copy-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) - (cond - ;; At least one file a Tramp file? - ((or (tramp-tramp-file-p filename) - (tramp-tramp-file-p newname)) - (tramp-do-copy-or-rename-file - 'copy filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context)) - ;; Compat section. - (preserve-selinux-context - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) - (t - (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) - -(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents) - "Like `copy-directory' for Tramp files." - (let ((t1 (tramp-tramp-file-p dirname)) - (t2 (tramp-tramp-file-p newname))) - (with-parsed-tramp-file-name (if t1 dirname newname) nil - (if (and (tramp-get-method-parameter method 'tramp-copy-recursive) - ;; When DIRNAME and NEWNAME are remote, they must have - ;; the same method. - (or (null t1) (null t2) - (string-equal - (tramp-file-name-method (tramp-dissect-file-name dirname)) - (tramp-file-name-method (tramp-dissect-file-name newname))))) - ;; scp or rsync DTRT. - (progn - (setq dirname (directory-file-name (expand-file-name dirname)) - newname (directory-file-name (expand-file-name newname))) - (if (and (file-directory-p newname) - (not (string-equal (file-name-nondirectory dirname) - (file-name-nondirectory newname)))) - (setq newname - (expand-file-name - (file-name-nondirectory dirname) newname))) - (if (not (file-directory-p (file-name-directory newname))) - (make-directory (file-name-directory newname) parents)) - (tramp-do-copy-or-rename-file-out-of-band - 'copy dirname newname keep-date)) - ;; We must do it file-wise. - (tramp-run-real-handler - 'copy-directory (list dirname newname keep-date parents))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname)))))) - -(defun tramp-handle-rename-file - (filename newname &optional ok-if-already-exists) - "Like `rename-file' for Tramp files." - ;; Check if both files are local -- invoke normal rename-file. - ;; Otherwise, use Tramp from local system. - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) - ;; At least one file a Tramp file? - (if (or (tramp-tramp-file-p filename) - (tramp-tramp-file-p newname)) - (tramp-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) - (tramp-run-real-handler - 'rename-file (list filename newname ok-if-already-exists)))) - -(defun tramp-do-copy-or-rename-file - (op filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) - "Copy or rename a remote file. -OP must be `copy' or `rename' and indicates the operation to perform. -FILENAME specifies the file to copy or rename, NEWNAME is the name of -the new file (for copy) or the new name of the file (for rename). -OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. -KEEP-DATE means to make sure that NEWNAME has the same timestamp -as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep -the uid and gid if both files are on the same host. -PRESERVE-SELINUX-CONTEXT activates selinux commands. - -This function is invoked by `tramp-handle-copy-file' and -`tramp-handle-rename-file'. It is an error if OP is neither of `copy' -and `rename'. FILENAME and NEWNAME must be absolute file names." - (unless (memq op '(copy rename)) - (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (context (and preserve-selinux-context - (apply 'file-selinux-context (list filename)))) - pr tm) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error - v 'file-already-exists "File %s already exists" newname)) - - (with-progress-reporter - v 0 (format "%s %s to %s" - (if (eq op 'copy) "Copying" "Renaming") - filename newname) - - (cond - ;; Both are Tramp files. - ((and t1 t2) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - (cond - ;; Shortcut: if method, host, user are the same for - ;; both files, we invoke `cp' or `mv' on the remote - ;; host directly. - ((tramp-equal-remote filename newname) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; Try out-of-band operation. - ((tramp-method-out-of-band-p - v1 (nth 7 (file-attributes filename))) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname keep-date)) - - ;; No shortcut was possible. So we copy the file - ;; first. If the operation was `rename', we go back - ;; and delete the original file (if the copy was - ;; successful). The approach is simple-minded: we - ;; create a new buffer, insert the contents of the - ;; source file into it, then write out the buffer to - ;; the target file. The advantage is that it doesn't - ;; matter which filename handlers are used for the - ;; source and target file. - (t - (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))))) - - ;; One file is a Tramp file, the other one is local. - ((or t1 t2) - (cond - ;; Fast track on local machine. - ((tramp-local-host-p v) - (tramp-do-copy-or-rename-file-directly - op filename newname - ok-if-already-exists keep-date preserve-uid-gid)) - - ;; If the Tramp file has an out-of-band method, the - ;; corresponding copy-program can be invoked. - ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) - (tramp-do-copy-or-rename-file-out-of-band - op filename newname keep-date)) - - ;; Use the inline method via a Tramp buffer. - (t (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))) - - (t - ;; One of them must be a Tramp file. - (error "Tramp implementation says this cannot happen"))) - - ;; Handle `preserve-selinux-context'. - (when context (apply 'set-file-selinux-context (list newname context))) - - ;; In case of `rename', we must flush the cache of the source file. - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-property v1 (file-name-directory localname)) - (tramp-flush-file-property v1 localname))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-property v2 (file-name-directory localname)) - (tramp-flush-file-property v2 localname))))))) - -(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date) - "Use an Emacs buffer to copy or rename a file. -First arg OP is either `copy' or `rename' and indicates the operation. -FILENAME is the source file, NEWNAME the target file. -KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." - (with-temp-buffer - ;; We must disable multibyte, because binary data shall not be - ;; converted. - (set-buffer-multibyte nil) - (let ((coding-system-for-read 'binary) - (jka-compr-inhibit t)) - (insert-file-contents-literally filename)) - ;; We don't want the target file to be compressed, so we let-bind - ;; `jka-compr-inhibit' to t. - (let ((coding-system-for-write 'binary) - (jka-compr-inhibit t)) - (write-region (point-min) (point-max) newname))) - ;; KEEP-DATE handling. - (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))) - ;; Set the mode. - (set-file-modes newname (tramp-default-file-modes filename)) - ;; If the operation was `rename', delete the original file. - (unless (eq op 'copy) (delete-file filename))) - -(defun tramp-do-copy-or-rename-file-directly - (op filename newname ok-if-already-exists keep-date preserve-uid-gid) - "Invokes `cp' or `mv' on the remote system. -OP must be one of `copy' or `rename', indicating `cp' or `mv', -respectively. FILENAME specifies the file to copy or rename, -NEWNAME is the name of the new file (for copy) or the new name of -the file (for rename). Both files must reside on the same host. -KEEP-DATE means to make sure that NEWNAME has the same timestamp -as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep -the uid and gid from FILENAME." - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (file-times (nth 5 (file-attributes filename))) - (file-modes (tramp-default-file-modes filename))) - (with-parsed-tramp-file-name (if t1 filename newname) nil - (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") - ((eq op 'copy) "cp -f") - ((eq op 'rename) "mv -f") - (t (tramp-error - v 'file-error - "Unknown operation `%s', must be `copy' or `rename'" - op)))) - (localname1 - (if t1 - (tramp-file-name-handler 'file-remote-p filename 'localname) - filename)) - (localname2 - (if t2 - (tramp-file-name-handler 'file-remote-p newname 'localname) - newname)) - (prefix (file-remote-p (if t1 filename newname))) - cmd-result) - - (cond - ;; Both files are on a remote host, with same user. - ((and t1 t2) - (setq cmd-result - (tramp-send-command-and-check - v - (format "%s %s %s" cmd - (tramp-shell-quote-argument localname1) - (tramp-shell-quote-argument localname2)))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (unless - (or - (and keep-date - ;; Mask cp -f error. - (re-search-forward - tramp-operation-not-permitted-regexp nil t)) - (zerop cmd-result)) - (tramp-error-with-buffer - nil v 'file-error - "Copying directly failed, see buffer `%s' for details." - (buffer-name))))) - - ;; We are on the local host. - ((or t1 t2) - (cond - ;; We can do it directly. - ((let (file-name-handler-alist) - (and (file-readable-p localname1) - (file-writable-p (file-name-directory localname2)) - (or (file-directory-p localname2) - (file-writable-p localname2)))) - (if (eq op 'copy) - (tramp-compat-copy-file - localname1 localname2 ok-if-already-exists - keep-date preserve-uid-gid) - (tramp-run-real-handler - 'rename-file (list localname1 localname2 ok-if-already-exists)))) - - ;; We can do it directly with `tramp-send-command' - ((and (file-readable-p (concat prefix localname1)) - (file-writable-p - (file-name-directory (concat prefix localname2))) - (or (file-directory-p (concat prefix localname2)) - (file-writable-p (concat prefix localname2)))) - (tramp-do-copy-or-rename-file-directly - op (concat prefix localname1) (concat prefix localname2) - ok-if-already-exists keep-date t) - ;; We must change the ownership to the local user. - (tramp-set-file-uid-gid - (concat prefix localname2) - (tramp-get-local-uid 'integer) - (tramp-get-local-gid 'integer))) - - ;; We need a temporary file in between. - (t - ;; Create the temporary file. - (let ((tmpfile (tramp-compat-make-temp-file localname1))) - (unwind-protect - (progn - (cond - (t1 - (or - (zerop - (tramp-send-command-and-check - v (format - "%s %s %s" cmd - (tramp-shell-quote-argument localname1) - (tramp-shell-quote-argument tmpfile)))) - (tramp-error-with-buffer - nil v 'file-error - "Copying directly failed, see buffer `%s' for details." - (tramp-get-buffer v))) - ;; We must change the ownership as remote user. - ;; Since this does not work reliable, we also - ;; give read permissions. - (set-file-modes - (concat prefix tmpfile) (tramp-octal-to-decimal "0777")) - (tramp-set-file-uid-gid - (concat prefix tmpfile) - (tramp-get-local-uid 'integer) - (tramp-get-local-gid 'integer))) - (t2 - (if (eq op 'copy) - (tramp-compat-copy-file - localname1 tmpfile t - keep-date preserve-uid-gid) - (tramp-run-real-handler - 'rename-file - (list localname1 tmpfile t))) - ;; We must change the ownership as local user. - ;; Since this does not work reliable, we also - ;; give read permissions. - (set-file-modes tmpfile (tramp-octal-to-decimal "0777")) - (tramp-set-file-uid-gid - tmpfile - (tramp-get-remote-uid v 'integer) - (tramp-get-remote-gid v 'integer)))) - - ;; Move the temporary file to its destination. - (cond - (t2 - (or - (zerop - (tramp-send-command-and-check - v (format - "cp -f -p %s %s" - (tramp-shell-quote-argument tmpfile) - (tramp-shell-quote-argument localname2)))) - (tramp-error-with-buffer - nil v 'file-error - "Copying directly failed, see buffer `%s' for details." - (tramp-get-buffer v)))) - (t1 - (tramp-run-real-handler - 'rename-file - (list tmpfile localname2 ok-if-already-exists))))) - - ;; Save exit. - (condition-case nil - (delete-file tmpfile) - (error))))))))) - - ;; Set the time and mode. Mask possible errors. - (condition-case nil - (when keep-date - (set-file-times newname file-times) - (set-file-modes newname file-modes)) - (error))))) - -(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) - "Invoke rcp program to copy. -The method used must be an out-of-band method." - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - copy-program copy-args copy-env copy-keep-date port spec - source target) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (if (and t1 t2) - - ;; Both are Tramp files. We shall optimize it, when the - ;; methods for filename and newname are the same. - (let* ((dir-flag (file-directory-p filename)) - (tmpfile (tramp-compat-make-temp-file localname dir-flag))) - (if dir-flag - (setq tmpfile - (expand-file-name - (file-name-nondirectory newname) tmpfile))) - (unwind-protect - (progn - (tramp-do-copy-or-rename-file-out-of-band - op filename tmpfile keep-date) - (tramp-do-copy-or-rename-file-out-of-band - 'rename tmpfile newname keep-date)) - ;; Save exit. - (condition-case nil - (if dir-flag - (tramp-compat-delete-directory - (expand-file-name ".." tmpfile) 'recursive) - (delete-file tmpfile)) - (error)))) - - ;; Expand hops. Might be necessary for gateway methods. - (setq v (car (tramp-compute-multi-hops v))) - (aset v 3 localname) - - ;; Check which ones of source and target are Tramp files. - (setq source (if t1 (tramp-make-copy-program-file-name v) filename) - target (funcall - (if (and (file-directory-p filename) - (string-equal - (file-name-nondirectory filename) - (file-name-nondirectory newname))) - 'file-name-directory - 'identity) - (if t2 (tramp-make-copy-program-file-name v) newname))) - - ;; Check for port number. Until now, there's no need for handling - ;; like method, user, host. - (setq host (tramp-file-name-real-host v) - port (tramp-file-name-port v) - port (or (and port (number-to-string port)) "")) - - ;; Compose copy command. - (setq spec (format-spec-make - ?h host ?u user ?p port - ?t (tramp-get-connection-property - (tramp-get-connection-process v) "temp-file" "") - ?k (if keep-date " " "")) - copy-program (tramp-get-method-parameter - method 'tramp-copy-program) - copy-keep-date (tramp-get-method-parameter - method 'tramp-copy-keep-date) - copy-args - (delq - nil - (mapcar - (lambda (x) - (setq - x - ;; " " is indication for keep-date argument. - (delete " " (mapcar (lambda (y) (format-spec y spec)) x))) - (unless (member "" x) (mapconcat 'identity x " "))) - (tramp-get-method-parameter method 'tramp-copy-args))) - copy-env - (delq - nil - (mapcar - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (mapconcat 'identity x " "))) - (tramp-get-method-parameter method 'tramp-copy-env)))) - - ;; Check for program. - (when (and (fboundp 'executable-find) - (not (let ((default-directory - (tramp-compat-temporary-file-directory))) - (executable-find copy-program)))) - (tramp-error - v 'file-error "Cannot find copy program: %s" copy-program)) - - ;; Set variables for computing the prompt for reading - ;; password. - (setq tramp-current-method (tramp-file-name-method v) - tramp-current-user (tramp-file-name-user v) - tramp-current-host (tramp-file-name-host v)) - - (unwind-protect - (with-temp-buffer - ;; The default directory must be remote. - (let ((default-directory - (file-name-directory (if t1 filename newname))) - (process-environment (copy-sequence process-environment))) - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - (while copy-env - (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env)) - (setenv (pop copy-env) (pop copy-env))) - - ;; Use an asynchronous process. By this, password can - ;; be handled. The default directory must be local, in - ;; order to apply the correct `copy-program'. We don't - ;; set a timeout, because the copying of large files can - ;; last longer than 60 secs. - (let ((p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (apply 'start-process - (tramp-get-connection-property - v "process-name" nil) - (tramp-get-connection-property - v "process-buffer" nil) - copy-program - (append copy-args (list source target)))))) - (tramp-message - v 6 "%s" (mapconcat 'identity (process-command p) " ")) - (tramp-set-process-query-on-exit-flag p nil) - (tramp-process-actions p v tramp-actions-copy-out-of-band)))) - - ;; Reset the transfer process properties. - (tramp-set-connection-property v "process-name" nil) - (tramp-set-connection-property v "process-buffer" nil)) - - ;; Handle KEEP-DATE argument. - (when (and keep-date (not copy-keep-date)) - (set-file-times newname (nth 5 (file-attributes filename)))) - - ;; Set the mode. - (unless (and keep-date copy-keep-date) - (ignore-errors - (set-file-modes newname (tramp-default-file-modes filename))))) - - ;; If the operation was `rename', delete the original file. - (unless (eq op 'copy) - (if (file-regular-p filename) - (delete-file filename) - (tramp-compat-delete-directory filename 'recursive)))))) - -(defun tramp-handle-make-directory (dir &optional parents) - "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (tramp-flush-directory-property v (file-name-directory localname)) - (save-excursion - (tramp-barf-unless-okay - v - (format "%s %s" - (if parents "mkdir -p" "mkdir") - (tramp-shell-quote-argument localname)) - "Couldn't make directory %s" dir)))) - -(defun tramp-handle-delete-directory (directory &optional recursive) - "Like `delete-directory' for Tramp files." - (setq directory (expand-file-name directory)) - (with-parsed-tramp-file-name directory nil - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) - (unless (zerop (tramp-send-command-and-check - v - (format - "%s %s" - (if recursive "rm -rf" "rmdir") - (tramp-shell-quote-argument localname)))) - (tramp-error v 'file-error "Couldn't delete %s" directory)))) - -(defun tramp-handle-delete-file (filename &optional trash) - "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (unless - (zerop - (tramp-send-command-and-check - v (format "%s %s" - (or (and trash (tramp-get-remote-trash v)) "rm -f") - (tramp-shell-quote-argument localname)))) - (tramp-error v 'file-error "Couldn't delete %s" filename)))) - -;; Dired. - -;; CCC: This does not seem to be enough. Something dies when -;; we try and delete two directories under Tramp :/ -(defun tramp-handle-dired-recursive-delete-directory (filename) - "Recursively delete the directory given. -This is like `dired-recursive-delete-directory' for Tramp files." - (with-parsed-tramp-file-name filename nil - ;; Run a shell command 'rm -r <localname>' - ;; Code shamelessly stolen from the dired implementation and, um, hacked :) - (unless (file-exists-p filename) - (tramp-error v 'file-error "No such directory: %s" filename)) - ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>) - (tramp-send-command - v - (format "rm -rf %s" (tramp-shell-quote-argument localname)) - ;; Don't read the output, do it explicitely. - nil t) - ;; Wait for the remote system to return to us... - ;; This might take a while, allow it plenty of time. - (tramp-wait-for-output (tramp-get-connection-process v) 120) - ;; Make sure that it worked... - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) - (and (file-exists-p filename) - (tramp-error - v 'file-error "Failed to recursively delete %s" filename)))) - -(defun tramp-handle-dired-compress-file (file &rest ok-flag) - "Like `dired-compress-file' for Tramp files." - ;; OK-FLAG is valid for XEmacs only, but not implemented. - ;; Code stolen mainly from dired-aux.el. - (with-parsed-tramp-file-name file nil - (tramp-flush-file-property v localname) - (save-excursion - (let ((suffixes - (if (not (featurep 'xemacs)) - ;; Emacs case - (symbol-value 'dired-compress-file-suffixes) - ;; XEmacs has `dired-compression-method-alist', which is - ;; transformed into `dired-compress-file-suffixes' structure. - (mapcar - (lambda (x) - (list (concat (regexp-quote (nth 1 x)) "\\'") - nil - (mapconcat 'identity (nth 3 x) " "))) - (symbol-value 'dired-compression-method-alist)))) - suffix) - ;; See if any suffix rule matches this file name. - (while suffixes - (let (case-fold-search) - (if (string-match (car (car suffixes)) localname) - (setq suffix (car suffixes) suffixes nil)) - (setq suffixes (cdr suffixes)))) - - (cond ((file-symlink-p file) - nil) - ((and suffix (nth 2 suffix)) - ;; We found an uncompression rule. - (with-progress-reporter v 0 (format "Uncompressing %s" file) - (when (zerop - (tramp-send-command-and-check - v (concat (nth 2 suffix) " " - (tramp-shell-quote-argument localname)))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) - (string-match (car suffix) file) - (concat (substring file 0 (match-beginning 0)))))) - (t - ;; We don't recognize the file as compressed, so compress it. - ;; Try gzip. - (with-progress-reporter v 0 (format "Compressing %s" file) - (when (zerop - (tramp-send-command-and-check - v (concat "gzip -f " - (tramp-shell-quote-argument localname)))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) - (cond ((file-exists-p (concat file ".gz")) - (concat file ".gz")) - ((file-exists-p (concat file ".z")) - (concat file ".z")) - (t nil)))))))))) - -(defun tramp-handle-dired-uncache (dir &optional dir-p) - "Like `dired-uncache' for Tramp files." - ;; DIR-P is valid for XEmacs only. - (with-parsed-tramp-file-name - (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil - (tramp-flush-directory-property v localname))) - -;; Pacify byte-compiler. The function is needed on XEmacs only. I'm -;; not sure at all that this is the right way to do it, but let's hope -;; it works for now, and wait for a guru to point out the Right Way to -;; achieve this. -;;(eval-when-compile -;; (unless (fboundp 'dired-insert-set-properties) -;; (fset 'dired-insert-set-properties 'ignore))) -;; Gerd suggests this: -(eval-when-compile (require 'dired)) -;; Note that dired is required at run-time, too, when it is needed. -;; It is only needed on XEmacs for the function -;; `dired-insert-set-properties'. - -(defun tramp-handle-insert-directory - (filename switches &optional wildcard full-directory-p) - "Like `insert-directory' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (if (and (featurep 'ls-lisp) - (not (symbol-value 'ls-lisp-use-insert-directory-program))) - (tramp-run-real-handler - 'insert-directory (list filename switches wildcard full-directory-p)) - (when (stringp switches) - (setq switches (split-string switches))) - (when (and (member "--dired" switches) - (not (tramp-get-ls-command-with-dired v))) - (setq switches (delete "--dired" switches))) - (when wildcard - (setq wildcard (tramp-run-real-handler - 'file-name-nondirectory (list localname))) - (setq localname (tramp-run-real-handler - 'file-name-directory (list localname)))) - (unless full-directory-p - (setq switches (add-to-list 'switches "-d" 'append))) - (setq switches (mapconcat 'tramp-shell-quote-argument switches " ")) - (when wildcard - (setq switches (concat switches " " wildcard))) - (tramp-message - v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" - switches filename (if wildcard "yes" "no") - (if full-directory-p "yes" "no")) - ;; If `full-directory-p', we just say `ls -l FILENAME'. - ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. - (if full-directory-p - (tramp-send-command - v - (format "%s %s %s 2>/dev/null" - (tramp-get-ls-command v) - switches - (if wildcard - localname - (tramp-shell-quote-argument (concat localname "."))))) - (tramp-barf-unless-okay - v - (format "cd %s" (tramp-shell-quote-argument - (tramp-run-real-handler - 'file-name-directory (list localname)))) - "Couldn't `cd %s'" - (tramp-shell-quote-argument - (tramp-run-real-handler 'file-name-directory (list localname)))) - (tramp-send-command - v - (format "%s %s %s" - (tramp-get-ls-command v) - switches - (if (or wildcard - (zerop (length - (tramp-run-real-handler - 'file-name-nondirectory (list localname))))) - "" - (tramp-shell-quote-argument - (tramp-run-real-handler - 'file-name-nondirectory (list localname))))))) - (let ((beg (point))) - ;; We cannot use `insert-buffer-substring' because the Tramp - ;; buffer changes its contents before insertion due to calling - ;; `expand-file' and alike. - (insert - (with-current-buffer (tramp-get-buffer v) - (buffer-string))) - - ;; Check for "--dired" output. - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (when (looking-at "//DIRED//\\s-+") - (let ((databeg (match-end 0)) - (end (tramp-compat-line-end-position))) - ;; Now read the numeric positions of file names. - (goto-char databeg) - (while (< (point) end) - (let ((start (+ beg (read (current-buffer)))) - (end (+ beg (read (current-buffer))))) - (if (memq (char-after end) '(?\n ?\ )) - ;; End is followed by \n or by " -> ". - (put-text-property start end 'dired-filename t)))))) - ;; Remove trailing lines. - (goto-char (tramp-compat-line-beginning-position)) - (while (looking-at "//") - (forward-line 1) - (delete-region (match-beginning 0) (point))) - - ;; The inserted file could be from somewhere else. - (when (and (not wildcard) (not full-directory-p)) - (goto-char (point-max)) - (when (file-symlink-p filename) - (goto-char (search-backward "->" beg 'noerror))) - (search-backward - (if (zerop (length (file-name-nondirectory filename))) - "." - (file-name-nondirectory filename)) - beg 'noerror) - (replace-match (file-relative-name filename) t)) - - (goto-char (point-max)))))) - -(defun tramp-handle-unhandled-file-name-directory (filename) - "Like `unhandled-file-name-directory' for Tramp files." - ;; With Emacs 23, we could simply return `nil'. But we must keep it - ;; for backward compatibility. - (expand-file-name "~/")) - -;; Canonicalization of file names. - -(defun tramp-handle-expand-file-name (name &optional dir) - "Like `expand-file-name' for Tramp files. -If the localname part of the given filename starts with \"/../\" then -the result will be a local, non-Tramp, filename." - ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". - (setq dir (or dir default-directory "/")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler. - (if (not (tramp-connectable-p name)) - (tramp-run-real-handler 'expand-file-name (list name nil)) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) - (setq localname (concat "~/" localname))) - ;; Tilde expansion if necessary. This needs a shell which - ;; groks tilde expansion! The function `tramp-find-shell' is - ;; supposed to find such a shell on the remote host. Please - ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - ;; We cannot simply apply "~/", because under sudo "~/" is - ;; expanded to the local user home directory but to the - ;; root home directory. On the other hand, using always - ;; the default user name for tilde expansion is not - ;; appropriate either, because ssh and companions might - ;; use a user name from the config file. - (when (and (string-equal uname "~") - (string-match "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-connection-property v uname - (tramp-send-command - v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring - (point) (tramp-compat-line-end-position))))) - (setq localname (concat uname fname)))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). We bind - ;; `directory-sep-char' here for XEmacs on Windows, which would - ;; otherwise use backslash. `default-directory' is bound, - ;; because on Windows there would be problems with UNC shares or - ;; Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - method user host - (tramp-drop-volume-letter - (tramp-run-real-handler - 'expand-file-name (list localname)))))))) + (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) (defun tramp-replace-environment-variables (filename) "Replace environment variables in FILENAME. @@ -4439,38 +1629,6 @@ t nil filename))) filename))) -(defun tramp-handle-substitute-in-file-name (filename) - "Like `substitute-in-file-name' for Tramp files. -\"//\" and \"/~\" substitute only in the local filename part. -If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at -beginning of local filename are not substituted." - ;; First, we must replace environment variables. - (setq filename (tramp-replace-environment-variables filename)) - (with-parsed-tramp-file-name filename nil - (if (equal tramp-syntax 'url) - ;; We need to check localname only. The other parts cannot contain - ;; "//" or "/~". - (if (and (> (length localname) 1) - (or (string-match "//" localname) - (string-match "/~" localname 1))) - (tramp-run-real-handler 'substitute-in-file-name (list filename)) - (tramp-make-tramp-file-name - (when method (substitute-in-file-name method)) - (when user (substitute-in-file-name user)) - (when host (substitute-in-file-name host)) - (when localname - (tramp-run-real-handler - 'substitute-in-file-name (list localname))))) - ;; Ignore in LOCALNAME everything before "//" or "/~". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) - (setq filename - (concat (file-remote-p filename) - (replace-match "\\1" nil nil localname))) - ;; "/m:h:~" does not work for completion. We use "/m:h:~/". - (when (string-match "~$" filename) - (setq filename (concat filename "/")))) - (tramp-run-real-handler 'substitute-in-file-name (list filename))))) - ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, ;; which calls corresponding functions (see minibuf.el). (when (fboundp 'minibuffer-electric-separator) @@ -4500,406 +1658,9 @@ '(minibuffer-electric-separator minibuffer-electric-tilde))) - -;;; Remote commands: - -(defun tramp-handle-executable-find (command) - "Like `executable-find' for Tramp files." - (with-parsed-tramp-file-name default-directory nil - (tramp-find-executable v command (tramp-get-remote-path v) t))) - -(defun tramp-process-sentinel (proc event) - "Flush file caches." - (unless (memq (process-status proc) '(run open)) - (let ((vec (tramp-get-connection-property proc "vector" nil))) - (when vec - (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event) - (tramp-flush-directory-property vec ""))))) - -;; We use BUFFER also as connection buffer during setup. Because of -;; this, its original contents must be saved, and restored once -;; connection has been setup. -(defun tramp-handle-start-file-process (name buffer program &rest args) - "Like `start-file-process' for Tramp files." - (with-parsed-tramp-file-name default-directory nil - (unwind-protect - ;; When PROGRAM is nil, we just provide a tty. - (let ((command - (when (stringp program) - (format "cd %s; exec %s" - (tramp-shell-quote-argument localname) - (mapconcat 'tramp-shell-quote-argument - (cons program args) " ")))) - (tramp-process-connection-type - (or (null program) tramp-process-connection-type)) - (name1 name) - (i 0)) - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) - (while (get-process name1) - ;; NAME must be unique as process name. - (setq i (1+ i) - name1 (format "%s<%d>" name i))) - (setq name name1) - ;; Set the new process properties. - (tramp-set-connection-property v "process-name" name) - (tramp-set-connection-property v "process-buffer" buffer) - ;; Activate narrowing in order to save BUFFER contents. - ;; Clear also the modification time; otherwise we might be - ;; interrupted by `verify-visited-file-modtime'. - (with-current-buffer (tramp-get-connection-buffer v) - (clear-visited-file-modtime) - (narrow-to-region (point-max) (point-max))) - (if command - ;; Send the command. - (tramp-send-command v command nil t) ; nooutput - ;; Check, whether a pty is associated. - (tramp-maybe-open-connection v) - (unless (process-get (tramp-get-connection-process v) 'remote-tty) - (tramp-error - v 'file-error "pty association is not supported for `%s'" name))) - (let ((p (tramp-get-connection-process v))) - ;; Set sentinel and query flag for this process. - (tramp-set-connection-property p "vector" v) - (set-process-sentinel p 'tramp-process-sentinel) - (tramp-set-process-query-on-exit-flag p t) - ;; Return process. - p)) - ;; Save exit. - (with-current-buffer (tramp-get-connection-buffer v) - (if (string-match tramp-temp-buffer-name (buffer-name)) - (progn - (set-process-buffer (tramp-get-connection-process v) nil) - (kill-buffer (current-buffer))) - (widen) - (goto-char (point-max)))) - (tramp-set-connection-property v "process-name" nil) - (tramp-set-connection-property v "process-buffer" nil)))) - -(defun tramp-handle-process-file - (program &optional infile destination display &rest args) - "Like `process-file' for Tramp files." - ;; The implementation is not complete yet. - (when (and (numberp destination) (zerop destination)) - (error "Implementation does not handle immediate return")) - - (with-parsed-tramp-file-name default-directory nil - (let (command input tmpinput stderr tmpstderr outbuf ret) - ;; Compute command. - (setq command (mapconcat 'tramp-shell-quote-argument - (cons program args) " ")) - ;; Determine input. - (if (null infile) - (setq input "/dev/null") - (setq infile (expand-file-name infile)) - (if (tramp-equal-remote default-directory infile) - ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) - ;; INFILE must be copied to remote host. - (setq input (tramp-make-tramp-temp-file v) - tmpinput (tramp-make-tramp-file-name method user host input)) - (copy-file infile tmpinput t))) - (when input (setq command (format "%s <%s" command input))) - - ;; Determine output. - (cond - ;; Just a buffer. - ((bufferp destination) - (setq outbuf destination)) - ;; A buffer name. - ((stringp destination) - (setq outbuf (get-buffer-create destination))) - ;; (REAL-DESTINATION ERROR-DESTINATION) - ((consp destination) - ;; output. - (cond - ((bufferp (car destination)) - (setq outbuf (car destination))) - ((stringp (car destination)) - (setq outbuf (get-buffer-create (car destination)))) - ((car destination) - (setq outbuf (current-buffer)))) - ;; stderr. - (cond - ((stringp (cadr destination)) - (setcar (cdr destination) (expand-file-name (cadr destination))) - (if (tramp-equal-remote default-directory (cadr destination)) - ;; stderr is on the same remote host. - (setq stderr (with-parsed-tramp-file-name - (cadr destination) nil localname)) - ;; stderr must be copied to remote host. The temporary - ;; file must be deleted after execution. - (setq stderr (tramp-make-tramp-temp-file v) - tmpstderr (tramp-make-tramp-file-name - method user host stderr)))) - ;; stderr to be discarded. - ((null (cadr destination)) - (setq stderr "/dev/null")))) - ;; 't - (destination - (setq outbuf (current-buffer)))) - (when stderr (setq command (format "%s 2>%s" command stderr))) - - ;; Send the command. It might not return in time, so we protect - ;; it. Call it in a subshell, in order to preserve working - ;; directory. - (condition-case nil - (unwind-protect - (setq ret - (tramp-send-command-and-check - v (format "\\cd %s; %s" - (tramp-shell-quote-argument localname) - command) - t t)) - ;; We should show the output anyway. - (when outbuf - (with-current-buffer outbuf - (insert - (with-current-buffer (tramp-get-connection-buffer v) - (buffer-string)))) - (when display (display-buffer outbuf)))) - ;; When the user did interrupt, we should do it also. We use - ;; return code -1 as marker. - (quit - (kill-buffer (tramp-get-connection-buffer v)) - (setq ret -1)) - ;; Handle errors. - (error - (kill-buffer (tramp-get-connection-buffer v)) - (setq ret 1))) - - ;; Provide error file. - (when tmpstderr (rename-file tmpstderr (cadr destination) t)) - - ;; Cleanup. We remove all file cache values for the connection, - ;; because the remote process could have changed them. - (when tmpinput (delete-file tmpinput)) - - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to `nil', no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value 't'. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) - (tramp-flush-directory-property v "")) - - ;; Return exit status. - (if (equal ret -1) - (keyboard-quit) - ret)))) - -(defun tramp-local-call-process - (program &optional infile destination display &rest args) - "Calls `call-process' on the local host. -This is needed because for some Emacs flavors Tramp has -defadviced `call-process' to behave like `process-file'. The -Lisp error raised when PROGRAM is nil is trapped also, returning 1." - (let ((default-directory - (if (file-remote-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory))) - (if (executable-find program) - (apply 'call-process program infile destination display args) - 1))) - -(defun tramp-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Like `call-process-region' for Tramp files." - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - (apply 'call-process program tmpfile buffer display args) - (delete-file tmpfile)))) - -(defun tramp-handle-shell-command - (command &optional output-buffer error-buffer) - "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) - ;; We cannot use `shell-file-name' and `shell-command-switch', - ;; they are variables of the local host. - (args (list - (tramp-get-method-parameter - (tramp-file-name-method - (tramp-dissect-file-name default-directory)) - 'tramp-remote-sh) - "-c" (substring command 0 asynchronous))) - current-buffer-p - (output-buffer - (cond - ((bufferp output-buffer) output-buffer) - ((stringp output-buffer) (get-buffer-create output-buffer)) - (output-buffer - (setq current-buffer-p t) - (current-buffer)) - (t (get-buffer-create - (if asynchronous - "*Async Shell Command*" - "*Shell Command Output*"))))) - (error-buffer - (cond - ((bufferp error-buffer) error-buffer) - ((stringp error-buffer) (get-buffer-create error-buffer)))) - (buffer - (if (and (not asynchronous) error-buffer) - (with-parsed-tramp-file-name default-directory nil - (list output-buffer (tramp-make-tramp-temp-file v))) - output-buffer)) - (p (get-buffer-process output-buffer))) - - ;; Check whether there is another process running. Tramp does not - ;; support 2 (asynchronous) processes in parallel. - (when p - (if (yes-or-no-p "A command is running. Kill it? ") - (condition-case nil - (kill-process p) - (error nil)) - (error "Shell command in progress"))) - - (if current-buffer-p - (progn - (barf-if-buffer-read-only) - (push-mark nil t)) - (with-current-buffer output-buffer - (setq buffer-read-only nil) - (erase-buffer))) - - (if (and (not current-buffer-p) (integerp asynchronous)) - (prog1 - ;; Run the process. - (apply 'start-file-process "*Async Shell*" buffer args) - ;; Display output. - (pop-to-buffer output-buffer) - (setq mode-line-process '(":%s")) - (require 'shell) (shell-mode)) - - (prog1 - ;; Run the process. - (apply 'process-file (car args) nil buffer nil (cdr args)) - ;; Insert error messages if they were separated. - (when (listp buffer) - (with-current-buffer error-buffer - (insert-file-contents (cadr buffer))) - (delete-file (cadr buffer))) - (if current-buffer-p - ;; This is like exchange-point-and-mark, but doesn't - ;; activate the mark. It is cleaner to avoid activation, - ;; even though the command loop would deactivate the mark - ;; because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) - (current-buffer)))) - ;; There's some output, display it. - (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (tramp-compat-funcall 'display-message-or-buffer output-buffer) - (pop-to-buffer output-buffer)))))))) - -;; File Editing. - (defvar tramp-handle-file-local-copy-hook nil "Normal hook to be run at the end of `tramp-handle-file-local-copy'.") -(defun tramp-handle-file-local-copy (filename) - "Like `file-local-copy' for Tramp files." - - (with-parsed-tramp-file-name filename nil - (unless (file-exists-p filename) - (tramp-error - v 'file-error - "Cannot make local copy of non-existing file `%s'" filename)) - - (let* ((size (nth 7 (file-attributes filename))) - (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) - (loc-dec (tramp-get-inline-coding v "local-decoding" size)) - (tmpfile (tramp-compat-make-temp-file filename))) - - (condition-case err - (cond - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (copy-file filename tmpfile t t)) - - ;; Use inline encoding for file transfer. - (rem-enc - (save-excursion - (with-progress-reporter - v 3 (format "Encoding remote file %s" filename) - (tramp-barf-unless-okay - v (format rem-enc (tramp-shell-quote-argument localname)) - "Encoding remote file failed")) - - (if (functionp loc-dec) - ;; If local decoding is a function, we call it. We - ;; must disable multibyte, because - ;; `uudecode-decode-region' doesn't handle it - ;; correctly. - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-buffer-substring (tramp-get-buffer v)) - (with-progress-reporter - v 3 (format "Decoding remote file %s with function %s" - filename loc-dec) - (funcall loc-dec (point-min) (point-max)) - ;; Unset `file-name-handler-alist'. Otherwise, - ;; epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfile)))) - - ;; If tramp-decoding-function is not defined for this - ;; method, we invoke tramp-decoding-command instead. - (let ((tmpfile2 (tramp-compat-make-temp-file filename))) - ;; Unset `file-name-handler-alist'. Otherwise, - ;; epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfile2)) - (with-progress-reporter - v 3 (format "Decoding remote file %s with command %s" - filename loc-dec) - (unwind-protect - (tramp-call-local-coding-command - loc-dec tmpfile2 tmpfile) - (delete-file tmpfile2))))) - - ;; Set proper permissions. - (set-file-modes tmpfile (tramp-default-file-modes filename)) - ;; Set local user ownership. - (tramp-set-file-uid-gid tmpfile))) - - ;; Oops, I don't know what to do. - (t (tramp-error - v 'file-error "Wrong method specification for `%s'" method))) - - ;; Error handling. - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - (run-hooks 'tramp-handle-file-local-copy-hook) - tmpfile))) - -(defun tramp-handle-file-remote-p (filename &optional identification connected) - "Like `file-remote-p' for Tramp files." - (let ((tramp-verbose 3)) - (when (tramp-tramp-file-p filename) - (let* ((v (tramp-dissect-file-name filename)) - (p (tramp-get-connection-process v)) - (c (and p (processp p) (memq (process-status p) '(run open))))) - ;; We expand the file name only, if there is already a connection. - (with-parsed-tramp-file-name - (if c (expand-file-name filename) filename) nil - (and (or (not connected) c) - (cond - ((eq identification 'method) method) - ((eq identification 'user) user) - ((eq identification 'host) host) - ((eq identification 'localname) localname) - (t (tramp-make-tramp-file-name method user host ""))))))))) - (defun tramp-find-file-name-coding-system-alist (filename tmpname) "Like `find-operation-coding-system' for Tramp filenames. Tramp's `insert-file-contents' and `write-region' work over @@ -4915,532 +1676,6 @@ (add-to-list 'result (cons (regexp-quote tmpname) (cdr elt)) 'append))))) -(defun tramp-handle-insert-file-contents - (filename &optional visit beg end replace) - "Like `insert-file-contents' for Tramp files." - (barf-if-buffer-read-only) - (setq filename (expand-file-name filename)) - (let (result local-copy remote-copy) - (with-parsed-tramp-file-name filename nil - (unwind-protect - (if (not (file-exists-p filename)) - ;; We don't raise a Tramp error, because it might be - ;; suppressed, like in `find-file-noselect-1'. - (signal 'file-error - (list "File not found on remote host" filename)) - - (if (and (tramp-local-host-p v) - (let (file-name-handler-alist) - (file-readable-p localname))) - ;; Short track: if we are on the local host, we can - ;; run directly. - (setq result - (tramp-run-real-handler - 'insert-file-contents - (list localname visit beg end replace))) - - ;; When we shall insert only a part of the file, we copy - ;; this part. - (when (or beg end) - (setq remote-copy (tramp-make-tramp-temp-file v)) - (tramp-send-command - v - (cond - ((and beg end) - (format "tail -c +%d %s | head -c +%d >%s" - (1+ beg) (tramp-shell-quote-argument localname) - (- end beg) remote-copy)) - (beg - (format "tail -c +%d %s >%s" - (1+ beg) (tramp-shell-quote-argument localname) - remote-copy)) - (end - (format "head -c +%d %s >%s" - (1+ end) (tramp-shell-quote-argument localname) - remote-copy))))) - - ;; `insert-file-contents-literally' takes care to avoid - ;; calling jka-compr. By let-binding - ;; `inhibit-file-name-operation', we propagate that care - ;; to the `file-local-copy' operation. - (setq local-copy - (let ((inhibit-file-name-operation - (when (eq inhibit-file-name-operation - 'insert-file-contents) - 'file-local-copy))) - (cond - ((stringp remote-copy) - (file-local-copy - (tramp-make-tramp-file-name - method user host remote-copy))) - ((stringp tramp-temp-buffer-file-name) - (copy-file filename tramp-temp-buffer-file-name 'ok) - tramp-temp-buffer-file-name) - (t (file-local-copy filename))))) - - ;; When the file is not readable for the owner, it - ;; cannot be inserted, even it is redable for the group - ;; or for everybody. - (set-file-modes local-copy (tramp-octal-to-decimal "0600")) - - (when (and (null remote-copy) - (tramp-get-method-parameter - method 'tramp-copy-keep-tmpfile)) - ;; We keep the local file for performance reasons, - ;; useful for "rsync". - (setq tramp-temp-buffer-file-name local-copy) - (put 'tramp-temp-buffer-file-name 'permanent-local t)) - - (with-progress-reporter - v 3 (format "Inserting local temp file `%s'" local-copy) - ;; We must ensure that `file-coding-system-alist' - ;; matches `local-copy'. - (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist - filename local-copy))) - (setq result - (insert-file-contents - local-copy nil nil nil replace)))))) - - ;; Save exit. - (progn - (when visit - (setq buffer-file-name filename) - (setq buffer-read-only (not (file-writable-p filename))) - (set-visited-file-modtime) - (set-buffer-modified-p nil)) - (when (and (stringp local-copy) - (or remote-copy (null tramp-temp-buffer-file-name))) - (delete-file local-copy)) - (when (stringp remote-copy) - (delete-file - (tramp-make-tramp-file-name method user host remote-copy)))))) - - ;; Result. - (list (expand-file-name filename) - (cadr result)))) - -;; This is needed for XEmacs only. Code stolen from files.el. -(defun tramp-handle-insert-file-contents-literally - (filename &optional visit beg end replace) - "Like `insert-file-contents-literally' for Tramp files." - (let ((format-alist nil) - (after-insert-file-functions nil) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil)) - (inhibit-file-name-handlers '(jka-compr-handler image-file-handler)) - (inhibit-file-name-operation 'insert-file-contents)) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (filename) t)) - (insert-file-contents filename visit beg end replace)) - ;; Save exit. - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - -(defun tramp-handle-find-backup-file-name (filename) - "Like `find-backup-file-name' for Tramp files." - (with-parsed-tramp-file-name filename nil - ;; We set both variables. It doesn't matter whether it is - ;; Emacs or XEmacs. - (let ((backup-directory-alist - ;; Emacs case. - (when (boundp 'backup-directory-alist) - (if (symbol-value 'tramp-backup-directory-alist) - (mapcar - (lambda (x) - (cons - (car x) - (if (and (stringp (cdr x)) - (file-name-absolute-p (cdr x)) - (not (tramp-file-name-p (cdr x)))) - (tramp-make-tramp-file-name method user host (cdr x)) - (cdr x)))) - (symbol-value 'tramp-backup-directory-alist)) - (symbol-value 'backup-directory-alist)))) - - (bkup-backup-directory-info - ;; XEmacs case. - (when (boundp 'bkup-backup-directory-info) - (if (symbol-value 'tramp-bkup-backup-directory-info) - (mapcar - (lambda (x) - (nconc - (list (car x)) - (list - (if (and (stringp (car (cdr x))) - (file-name-absolute-p (car (cdr x))) - (not (tramp-file-name-p (car (cdr x))))) - (tramp-make-tramp-file-name - method user host (car (cdr x))) - (car (cdr x)))) - (cdr (cdr x)))) - (symbol-value 'tramp-bkup-backup-directory-info)) - (symbol-value 'bkup-backup-directory-info))))) - - (tramp-run-real-handler 'find-backup-file-name (list filename))))) - -(defun tramp-handle-make-auto-save-file-name () - "Like `make-auto-save-file-name' for Tramp files. -Returns a file name in `tramp-auto-save-directory' for autosaving this file." - (let ((tramp-auto-save-directory tramp-auto-save-directory) - (buffer-file-name - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - (buffer-file-name)))) - ;; File name must be unique. This is ensured with Emacs 22 (see - ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for - ;; all other cases we must do it ourselves. - (when (boundp 'auto-save-file-name-transforms) - (mapc - (lambda (x) - (when (and (string-match (car x) buffer-file-name) - (not (car (cddr x)))) - (setq tramp-auto-save-directory - (or tramp-auto-save-directory - (tramp-compat-temporary-file-directory))))) - (symbol-value 'auto-save-file-name-transforms))) - ;; Create directory. - (when tramp-auto-save-directory - (setq buffer-file-name - (expand-file-name buffer-file-name tramp-auto-save-directory)) - (unless (file-exists-p tramp-auto-save-directory) - (make-directory tramp-auto-save-directory t))) - ;; Run plain `make-auto-save-file-name'. There might be an advice when - ;; it is not a magic file name operation (since Emacs 22). - ;; We must deactivate it temporarily. - (if (not (ad-is-active 'make-auto-save-file-name)) - (tramp-run-real-handler 'make-auto-save-file-name nil) - ;; else - (ad-deactivate 'make-auto-save-file-name) - (prog1 - (tramp-run-real-handler 'make-auto-save-file-name nil) - (ad-activate 'make-auto-save-file-name))))) - -(defvar tramp-handle-write-region-hook nil - "Normal hook to be run at the end of `tramp-handle-write-region'.") - -;; CCC grok LOCKNAME -(defun tramp-handle-write-region - (start end filename &optional append visit lockname confirm) - "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - ;; Following part commented out because we don't know what to do about - ;; file locking, and it does not appear to be a problem to ignore it. - ;; Ange-ftp ignores it, too. - ;; (when (and lockname (stringp lockname)) - ;; (setq lockname (expand-file-name lockname))) - ;; (unless (or (eq lockname nil) - ;; (string= lockname filename)) - ;; (error - ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME")) - - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) - (tramp-error v 'file-error "File not overwritten"))) - - (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - (if (and (tramp-local-host-p v) - ;; `file-writable-p' calls `file-expand-file-name'. We - ;; cannot use `tramp-run-real-handler' therefore. - (let (file-name-handler-alist) - (and - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))))) - ;; Short track: if we are on the local host, we can run directly. - (tramp-run-real-handler - 'write-region - (list start end localname append 'no-message lockname confirm)) - - (let ((modes (save-excursion (tramp-default-file-modes filename))) - ;; We use this to save the value of - ;; `last-coding-system-used' after writing the tmp - ;; file. At the end of the function, we set - ;; `last-coding-system-used' to this saved value. This - ;; way, any intermediary coding systems used while - ;; talking to the remote shell or suchlike won't hose - ;; this variable. This approach was snarfed from - ;; ange-ftp.el. - coding-system-used - ;; Write region into a tmp file. This isn't really - ;; needed if we use an encoding function, but currently - ;; we use it always because this makes the logic - ;; simpler. - (tmpfile (or tramp-temp-buffer-file-name - (tramp-compat-make-temp-file filename)))) - - ;; If `append' is non-nil, we copy the file locally, and let - ;; the native `write-region' implementation do the job. - (when append (copy-file filename tmpfile 'ok)) - - ;; We say `no-message' here because we don't want the - ;; visited file modtime data to be clobbered from the temp - ;; file. We call `set-visited-file-modtime' ourselves later - ;; on. We must ensure that `file-coding-system-alist' - ;; matches `tmpfile'. - (let (file-name-handler-alist - (file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile))) - (condition-case err - (tramp-run-real-handler - 'write-region - (list start end tmpfile append 'no-message lockname confirm)) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Now, `last-coding-system-used' has the right value. Remember it. - (when (boundp 'last-coding-system-used) - (setq coding-system-used - (symbol-value 'last-coding-system-used)))) - - ;; The permissions of the temporary file should be set. If - ;; filename does not exist (eq modes nil) it has been - ;; renamed to the backup file. This case `save-buffer' - ;; handles permissions. - ;; Ensure, that it is still readable. - (when modes - (set-file-modes - tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400")))) - - ;; This is a bit lengthy due to the different methods - ;; possible for file transfer. First, we check whether the - ;; method uses an rcp program. If so, we call it. - ;; Otherwise, both encoding and decoding command must be - ;; specified. However, if the method _also_ specifies an - ;; encoding function, then that is used for encoding the - ;; contents of the tmp file. - (let* ((size (nth 7 (file-attributes tmpfile))) - (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) - (loc-enc (tramp-get-inline-coding v "local-encoding" size))) - (cond - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (if (and (not (stringp start)) - (= (or end (point-max)) (point-max)) - (= (or start (point-min)) (point-min)) - (tramp-get-method-parameter - method 'tramp-copy-keep-tmpfile)) - (progn - (setq tramp-temp-buffer-file-name tmpfile) - (condition-case err - ;; We keep the local file for performance - ;; reasons, useful for "rsync". - (copy-file tmpfile filename t) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err))))) - (setq tramp-temp-buffer-file-name nil) - ;; Don't rename, in order to keep context in SELinux. - (unwind-protect - (copy-file tmpfile filename t) - (delete-file tmpfile)))) - - ;; Use inline file transfer. - (rem-dec - ;; Encode tmpfile. - (unwind-protect - (with-temp-buffer - (set-buffer-multibyte nil) - ;; Use encoding function or command. - (if (functionp loc-enc) - (with-progress-reporter - v 3 (format "Encoding region using function `%s'" - loc-enc) - (let ((coding-system-for-read 'binary)) - (insert-file-contents-literally tmpfile)) - ;; The following `let' is a workaround for the - ;; base64.el that comes with pgnus-0.84. If - ;; both of the following conditions are - ;; satisfied, it tries to write to a local - ;; file in default-directory, but at this - ;; point, default-directory is remote. - ;; (`call-process-region' can't write to - ;; remote files, it seems.) The file in - ;; question is a tmp file anyway. - (let ((default-directory - (tramp-compat-temporary-file-directory))) - (funcall loc-enc (point-min) (point-max)))) - - (with-progress-reporter - v 3 (format "Encoding region using command `%s'" - loc-enc) - (unless (zerop (tramp-call-local-coding-command - loc-enc tmpfile t)) - (tramp-error - v 'file-error - (concat "Cannot write to `%s', " - "local encoding command `%s' failed") - filename loc-enc)))) - - ;; Send buffer into remote decoding command which - ;; writes to remote file. Because this happens on - ;; the remote host, we cannot use the function. - (with-progress-reporter - v 3 - (format "Decoding region into remote file %s" filename) - (goto-char (point-max)) - (unless (bolp) (newline)) - (tramp-send-command - v - (format - (concat rem-dec " <<'EOF'\n%sEOF") - (tramp-shell-quote-argument localname) - (buffer-string))) - (tramp-barf-unless-okay - v nil - "Couldn't write region to `%s', decode using `%s' failed" - filename rem-dec) - ;; When `file-precious-flag' is set, the region is - ;; written to a temporary file. Check that the - ;; checksum is equal to that from the local tmpfile. - (when file-precious-flag - (erase-buffer) - (and - ;; cksum runs locally, if possible. - (zerop (tramp-local-call-process "cksum" tmpfile t)) - ;; cksum runs remotely. - (zerop - (tramp-send-command-and-check - v - (format - "cksum <%s" - (tramp-shell-quote-argument localname)))) - ;; ... they are different. - (not - (string-equal - (buffer-string) - (with-current-buffer (tramp-get-buffer v) - (buffer-string)))) - (tramp-error - v 'file-error - (concat "Couldn't write region to `%s'," - " decode using `%s' failed") - filename rem-dec))))) - - ;; Save exit. - (delete-file tmpfile))) - - ;; That's not expected. - (t - (tramp-error - v 'file-error - (concat "Method `%s' should specify both encoding and " - "decoding command or an rcp program") - method)))) - - ;; Make `last-coding-system-used' have the right value. - (when coding-system-used - (set 'last-coding-system-used coding-system-used)))) - - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - - ;; We must protect `last-coding-system-used', now we have set it - ;; to its correct value. - (let (last-coding-system-used (need-chown t)) - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename))) - (set-visited-file-modtime - ;; We must pass modtime explicitely, because filename can - ;; be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (nth 5 file-attr)) - (when (and (eq (nth 2 file-attr) uid) - (eq (nth 3 file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid filename uid gid)) - (when (or (eq visit t) (null visit) (stringp visit)) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))))) - -(defvar tramp-vc-registered-file-names nil - "List used to collect file names, which are checked during `vc-registered'.") - -;; VC backends check for the existence of various different special -;; files. This is very time consuming, because every single check -;; requires a remote command (the file cache must be invalidated). -;; Therefore, we apply a kind of optimization. We install the file -;; name handler `tramp-vc-file-name-handler', which does nothing but -;; remembers all file names for which `file-exists-p' or -;; `file-readable-p' has been applied. A first run of `vc-registered' -;; is performed. Afterwards, a script is applied for all collected -;; file names, using just one remote command. The result of this -;; script is used to fill the file cache with actual values. Now we -;; can reset the file name handlers, and we make a second run of -;; `vc-registered', which returns the expected result without sending -;; any other remote command. -(defun tramp-handle-vc-registered (file) - "Like `vc-registered' for Tramp files." - (with-temp-message "" - (with-parsed-tramp-file-name file nil - (with-progress-reporter - v 3 (format "Checking `vc-registered' for %s" file) - - ;; There could be new files, created by the vc backend. We - ;; cannot reuse the old cache entries, therefore. - (let (tramp-vc-registered-file-names - (tramp-cache-inhibit-cache (current-time)) - (file-name-handler-alist - `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) - - ;; Here we collect only file names, which need an operation. - (tramp-run-real-handler 'vc-registered (list file)) - (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) - - ;; Send just one command, in order to fill the cache. - (when tramp-vc-registered-file-names - (tramp-maybe-send-script - v - (format tramp-vc-registered-read-file-names - (tramp-get-file-exists-command v) - (format "%s -r" (tramp-get-test-command v))) - "tramp_vc_registered_read_file_names") - - (dolist - (elt - (tramp-send-command-and-read - v - (format - "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n" - (mapconcat 'tramp-shell-quote-argument - tramp-vc-registered-file-names - "\n")))) - - (tramp-set-file-property - v (car elt) (cadr elt) (cadr (cdr elt)))))) - - ;; Second run. Now all `file-exists-p' or `file-readable-p' - ;; calls shall be answered from the file cache. We unset - ;; `process-file-side-effects' in order to keep the cache when - ;; `process-file' calls appear. - (let (process-file-side-effects) - (tramp-run-real-handler 'vc-registered (list file))))))) - ;;;###autoload (progn (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -5601,8 +1836,7 @@ (condition-case err (apply foreign operation args) - ;; Trace that somebody has interrupted the - ;; operation. + ;; Trace, that somebody has interrupted the operation. (quit (let (tramp-message-show-message) (tramp-message @@ -5660,48 +1894,6 @@ Together with `tramp-locked', this implements a locking mechanism preventing reentrant calls of Tramp.") -(defun tramp-sh-file-name-handler (operation &rest args) - "Invoke remote-shell Tramp file name handler. -Fall back to normal file name handler if no Tramp handler exists." - (when (and tramp-locked (not tramp-locker)) - (setq tramp-locked nil) - (signal 'file-error (list "Forbidden reentrant call of Tramp"))) - (let ((tl tramp-locked)) - (unwind-protect - (progn - (setq tramp-locked t) - (let ((tramp-locker t)) - (save-match-data - (let ((fn (assoc operation tramp-file-name-handler-alist))) - (if fn - (apply (cdr fn) args) - (tramp-run-real-handler operation args)))))) - (setq tramp-locked tl)))) - -(defun tramp-vc-file-name-handler (operation &rest args) - "Invoke special file name handler, which collects files to be handled." - (save-match-data - (let ((filename - (tramp-replace-environment-variables - (apply 'tramp-file-name-for-operation operation args))) - (fn (assoc operation tramp-file-name-handler-alist))) - (with-parsed-tramp-file-name filename nil - (cond - ;; That's what we want: file names, for which checks are - ;; applied. We assume, that VC uses only `file-exists-p' and - ;; `file-readable-p' checks; otherwise we must extend the - ;; list. We do not perform any action, but return nil, in - ;; order to keep `vc-registered' running. - ((and fn (memq operation '(file-exists-p file-readable-p))) - (add-to-list 'tramp-vc-registered-file-names localname 'append) - nil) - ;; Tramp file name handlers like `expand-file-name'. They - ;; must still work. - (fn - (save-match-data (apply (cdr fn) args))) - ;; Default file name handlers, we don't care. - (t (tramp-run-real-handler operation args))))))) - ;;;###autoload (progn (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. @@ -5795,6 +1987,7 @@ ;; Tramp file name syntax. Maybe another variable should be introduced ;; overwriting this check in such cases. Or we change Tramp file name ;; syntax in order to avoid ambiguities, like in XEmacs ... +;;;###tramp-autoload (defun tramp-completion-mode-p () "Check, whether method / user name / host name completion is active." (or @@ -5899,12 +2092,11 @@ ;; Complete local parts. (append result1 - (condition-case nil - (apply (if (tramp-connectable-p fullname) - 'tramp-completion-run-real-handler - 'tramp-run-real-handler) - 'file-name-all-completions (list (list filename directory))) - (error nil))))) + (ignore-errors + (apply (if (tramp-connectable-p fullname) + 'tramp-completion-run-real-handler + 'tramp-run-real-handler) + 'file-name-all-completions (list (list filename directory))))))) ;; Method, host name and user name completion for a file. ;;;###autoload @@ -6344,7 +2536,7 @@ (let ((default-directory (tramp-compat-temporary-file-directory)) res) (with-temp-buffer - (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry)) + (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry)) (goto-char (point-min)) (while (not (eobp)) (push (tramp-parse-putty-group registry) res)))) @@ -6362,81 +2554,10 @@ (forward-line 1) result)) -;;; Internal Functions: - -(defun tramp-maybe-send-script (vec script name) - "Define in remote shell function NAME implemented as SCRIPT. -Only send the definition if it has not already been done." - (let* ((p (tramp-get-connection-process vec)) - (scripts (tramp-get-connection-property p "scripts" nil))) - (unless (member name scripts) - (with-progress-reporter vec 5 (format "Sending script `%s'" name) - ;; The script could contain a call of Perl. This is masked with `%s'. - (tramp-send-command-and-check - vec - (format "%s () {\n%s\n}" name - (format script (tramp-get-remote-perl vec)))) - (tramp-set-connection-property p "scripts" (cons name scripts)))))) - -(defun tramp-set-auto-save () - (when (and ;; ange-ftp has its own auto-save mechanism - (eq (tramp-find-foreign-file-name-handler (buffer-file-name)) - 'tramp-sh-file-name-handler) - auto-save-default) - (auto-save-mode 1))) -(add-hook 'find-file-hooks 'tramp-set-auto-save t) -(add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'find-file-hooks 'tramp-set-auto-save))) - -(defun tramp-run-test (switch filename) - "Run `test' on the remote system, given a SWITCH and a FILENAME. -Returns the exit code of the `test' program." - (with-parsed-tramp-file-name filename nil - (tramp-send-command-and-check - v - (format - "%s %s %s" - (tramp-get-test-command v) - switch - (tramp-shell-quote-argument localname))))) - -(defun tramp-run-test2 (format-string file1 file2) - "Run `test'-like program on the remote system, given FILE1, FILE2. -FORMAT-STRING contains the program name, switches, and place holders. -Returns the exit code of the `test' program. Barfs if the methods, -hosts, or files, disagree." - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "tramp-run-test2 only implemented for same method, user, host"))) - (with-parsed-tramp-file-name file1 v1 - (with-parsed-tramp-file-name file1 v2 - (tramp-send-command-and-check - v1 - (format format-string - (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname)))))) - -(defun tramp-buffer-name (vec) - "A name for the connection buffer VEC." - ;; We must use `tramp-file-name-real-host', because for gateway - ;; methods the default port will be expanded later on, which would - ;; tamper the name. - (let ((method (tramp-file-name-method vec)) - (user (tramp-file-name-user vec)) - (host (tramp-file-name-real-host vec))) - (if (not (zerop (length user))) - (format "*tramp/%s %s@%s*" method user host) - (format "*tramp/%s %s*" method host)))) - (defun tramp-delete-temp-file-function () "Remove temporary files related to current buffer." (when (stringp tramp-temp-buffer-file-name) - (condition-case nil - (delete-file tramp-temp-buffer-file-name) - (error nil)))) + (ignore-errors (delete-file tramp-temp-buffer-file-name)))) (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function) (add-hook 'tramp-cache-unload-hook @@ -6444,241 +2565,6 @@ (remove-hook 'kill-buffer-hook 'tramp-delete-temp-file-function))) -(defun tramp-get-buffer (vec) - "Get the connection buffer to be used for VEC." - (or (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - (setq buffer-undo-list t) - (setq default-directory - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - "/")) - (current-buffer)))) - -(defun tramp-get-connection-buffer (vec) - "Get the connection buffer to be used for VEC. -In case a second asynchronous communication has been started, it is different -from `tramp-get-buffer'." - (or (tramp-get-connection-property vec "process-buffer" nil) - (tramp-get-buffer vec))) - -(defun tramp-get-connection-process (vec) - "Get the connection process to be used for VEC. -In case a second asynchronous communication has been started, it is different -from the default one." - (get-process - (or (tramp-get-connection-property vec "process-name" nil) - (tramp-buffer-name vec)))) - -(defun tramp-debug-buffer-name (vec) - "A name for the debug buffer for VEC." - ;; We must use `tramp-file-name-real-host', because for gateway - ;; methods the default port will be expanded later on, which would - ;; tamper the name. - (let ((method (tramp-file-name-method vec)) - (user (tramp-file-name-user vec)) - (host (tramp-file-name-real-host vec))) - (if (not (zerop (length user))) - (format "*debug tramp/%s %s@%s*" method user host) - (format "*debug tramp/%s %s*" method host)))) - -(defconst tramp-debug-outline-regexp - "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #") - -(defun tramp-get-debug-buffer (vec) - "Get the debug buffer for VEC." - (with-current-buffer - (get-buffer-create (tramp-debug-buffer-name vec)) - (when (bobp) - (setq buffer-undo-list t) - ;; Activate `outline-mode'. This runs `text-mode-hook' and - ;; `outline-mode-hook'. We must prevent that local processes - ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". - ;; Furthermore, `outline-regexp' must have the correct value - ;; already, because it is used by `font-lock-compile-keywords'. - (let ((default-directory (tramp-compat-temporary-file-directory)) - (outline-regexp tramp-debug-outline-regexp)) - (outline-mode)) - (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) - (set (make-local-variable 'outline-level) 'tramp-outline-level)) - (current-buffer))) - -(defun tramp-outline-level () - "Return the depth to which a statement is nested in the outline. -Point must be at the beginning of a header line. - -The outline level is equal to the verbosity of the Tramp message." - (1+ (string-to-number (match-string 1)))) - -(defun tramp-find-executable - (vec progname dirlist &optional ignore-tilde ignore-path) - "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST. -First arg VEC specifies the connection, PROGNAME is the program -to search for, and DIRLIST gives the list of directories to -search. If IGNORE-TILDE is non-nil, directory names starting -with `~' will be ignored. If IGNORE-PATH is non-nil, searches -only in DIRLIST. - -Returns the absolute file name of PROGNAME, if found, and nil otherwise. - -This function expects to be in the right *tramp* buffer." - (with-current-buffer (tramp-get-connection-buffer vec) - (let (result) - ;; Check whether the executable is in $PATH. "which(1)" does not - ;; report always a correct error code; therefore we check the - ;; number of words it returns. - (unless ignore-path - (tramp-send-command vec (format "which \\%s | wc -w" progname)) - (goto-char (point-min)) - (if (looking-at "^\\s-*1$") - (setq result (concat "\\" progname)))) - (unless result - (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. In XEmacs, - ;; `remove' is in CL, and we want to avoid CL dependencies. - (let (newdl d) - (while dirlist - (setq d (car dirlist)) - (setq dirlist (cdr dirlist)) - (unless (char-equal ?~ (aref d 0)) - (setq newdl (cons d newdl)))) - (setq dirlist (nreverse newdl)))) - (tramp-send-command - vec - (format (concat "while read d; " - "do if test -x $d/%s -a -f $d/%s; " - "then echo tramp_executable $d/%s; " - "break; fi; done <<'EOF'\n" - "%s\nEOF") - progname progname progname (mapconcat 'identity dirlist "\n"))) - (goto-char (point-max)) - (when (search-backward "tramp_executable " nil t) - (skip-chars-forward "^ ") - (skip-chars-forward " ") - (setq result (buffer-substring - (point) (tramp-compat-line-end-position))))) - result))) - -(defun tramp-set-remote-path (vec) - "Sets the remote environment PATH to existing directories. -I.e., for each directory in `tramp-remote-path', it is tested -whether it exists and if so, it is added to the environment -variable PATH." - (tramp-message vec 5 (format "Setting $PATH environment variable")) - (tramp-send-command - vec (format "PATH=%s; export PATH" - (mapconcat 'identity (tramp-get-remote-path vec) ":")))) - -;; ------------------------------------------------------------ -;; -- Communication with external shell -- -;; ------------------------------------------------------------ - -(defun tramp-find-file-exists-command (vec) - "Find a command on the remote host for checking if a file exists. -Here, we are looking for a command which has zero exit status if the -file exists and nonzero exit status otherwise." - (let ((existing "/") - (nonexisting - (tramp-shell-quote-argument "/ this file does not exist ")) - result) - ;; The algorithm is as follows: we try a list of several commands. - ;; For each command, we first run `$cmd /' -- this should return - ;; true, as the root directory always exists. And then we run - ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed - ;; does not exist. This should return false. We use the first - ;; command we find that seems to work. - ;; The list of commands to try is as follows: - ;; `ls -d' This works on most systems, but NetBSD 1.4 - ;; has a bug: `ls' always returns zero exit - ;; status, even for files which don't exist. - ;; `test -e' Some Bourne shells have a `test' builtin - ;; which does not know the `-e' option. - ;; `/bin/test -e' For those, the `test' binary on disk normally - ;; provides the option. Alas, the binary - ;; is sometimes `/bin/test' and sometimes it's - ;; `/usr/bin/test'. - ;; `/usr/bin/test -e' In case `/bin/test' does not exist. - (unless (or - (and (setq result (format "%s -e" (tramp-get-test-command vec))) - (zerop (tramp-send-command-and-check - vec (format "%s %s" result existing))) - (not (zerop (tramp-send-command-and-check - vec (format "%s %s" result nonexisting))))) - (and (setq result "/bin/test -e") - (zerop (tramp-send-command-and-check - vec (format "%s %s" result existing))) - (not (zerop (tramp-send-command-and-check - vec (format "%s %s" result nonexisting))))) - (and (setq result "/usr/bin/test -e") - (zerop (tramp-send-command-and-check - vec (format "%s %s" result existing))) - (not (zerop (tramp-send-command-and-check - vec (format "%s %s" result nonexisting))))) - (and (setq result (format "%s -d" (tramp-get-ls-command vec))) - (zerop (tramp-send-command-and-check - vec (format "%s %s" result existing))) - (not (zerop (tramp-send-command-and-check - vec (format "%s %s" result nonexisting)))))) - (tramp-error - vec 'file-error "Couldn't find command to check if file exists")) - result)) - -(defun tramp-open-shell (vec shell) - "Opens shell SHELL." - (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell) - ;; Find arguments for this shell. - (let ((tramp-end-of-output tramp-initial-end-of-output) - (alist tramp-sh-extra-args) - item extra-args) - (while (and alist (null extra-args)) - (setq item (pop alist)) - (when (string-match (car item) shell) - (setq extra-args (cdr item)))) - (when extra-args (setq shell (concat shell " " extra-args))) - (tramp-send-command - vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s" - (shell-quote-argument tramp-end-of-output) shell) - t)) - ;; Setting prompts. - (tramp-send-command - vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) - (tramp-send-command vec "PS2=''" t) - (tramp-send-command vec "PS3=''" t) - (tramp-send-command vec "PROMPT_COMMAND=''" t))) - -(defun tramp-find-shell (vec) - "Opens a shell on the remote host which groks tilde expansion." - (unless (tramp-get-connection-property vec "remote-shell" nil) - (let (shell) - (with-current-buffer (tramp-get-buffer vec) - (tramp-send-command vec "echo ~root" t) - (cond - ((or (string-match "^~root$" (buffer-string)) - ;; The default shell (ksh93) of OpenSolaris is buggy. - (string-equal (tramp-get-connection-property vec "uname" "") - "SunOS 5.11")) - (setq shell - (or (tramp-find-executable - vec "bash" (tramp-get-remote-path vec) t t) - (tramp-find-executable - vec "ksh" (tramp-get-remote-path vec) t t))) - (unless shell - (tramp-error - vec 'file-error - "Couldn't find a shell which groks tilde expansion")) - (tramp-message - vec 5 "Starting remote shell `%s' for tilde expansion" shell) - (tramp-open-shell vec shell)) - - (t (tramp-message - vec 5 "Remote `%s' groks tilde expansion, good" - (tramp-set-connection-property - vec "remote-shell" - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-sh))))))))) - ;; ------------------------------------------------------------ ;; -- Functions for establishing connection -- ;; ------------------------------------------------------------ @@ -6804,7 +2690,7 @@ (defun tramp-process-actions (proc vec actions &optional timeout) "Perform actions until success or TIMEOUT." ;; Preserve message for `progress-reporter'. - (with-temp-message "" + (tramp-compat-with-temp-message "" ;; Enable auth-source and password-cache. (tramp-set-connection-property vec "first-password-request" t) (let (exit) @@ -6912,17 +2798,6 @@ (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp))) found))) -(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args) - "Wait for shell prompt and barf if none appears. -Looks at process PROC to see if a shell prompt appears in TIMEOUT -seconds. If not, it produces an error message with the given ERROR-ARGS." - (unless - (tramp-wait-for-regexp - proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) - (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) - ;; We don't call `tramp-send-string' in order to hide the password ;; from the debug buffer, and because end-of-line handling of the ;; string. @@ -6935,820 +2810,6 @@ 'tramp-password-end-of-line) tramp-default-password-end-of-line)))) -(defun tramp-open-connection-setup-interactive-shell (proc vec) - "Set up an interactive shell. -Mainly sets the prompt and the echo correctly. PROC is the shell -process to set up. VEC specifies the connection." - (let ((tramp-end-of-output tramp-initial-end-of-output)) - ;; It is useful to set the prompt in the following command because - ;; some people have a setting for $PS1 which /bin/sh doesn't know - ;; about and thus /bin/sh will display a strange prompt. For - ;; example, if $PS1 has "${CWD}" in the value, then ksh will - ;; display the current working directory but /bin/sh will display - ;; a dollar sign. The following command line sets $PS1 to a sane - ;; value, and works under Bourne-ish shells as well as csh-like - ;; shells. Daniel Pittman reports that the unusual positioning of - ;; the single quotes makes it work under `rc', too. We also unset - ;; the variable $ENV because that is read by some sh - ;; implementations (eg, bash when called as sh) on startup; this - ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND - ;; is another way to set the prompt in /bin/bash, it must be - ;; discarded as well. - (tramp-open-shell - vec - (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh)) - - ;; Disable echo. - (tramp-message vec 5 "Setting up remote shell environment") - (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t) - ;; Check whether the echo has really been disabled. Some - ;; implementations, like busybox of embedded GNU/Linux, don't - ;; support disabling. - (tramp-send-command vec "echo foo" t) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (when (looking-at "echo foo") - (tramp-set-connection-property proc "remote-echo" t) - (tramp-message vec 5 "Remote echo still on. Ok.") - ;; Make sure backspaces and their echo are enabled and no line - ;; width magic interferes with them. - (tramp-send-command vec "stty icanon erase ^H cols 32767" t)))) - - (tramp-message vec 5 "Setting shell prompt") - (tramp-send-command - vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) - (tramp-send-command vec "PS2=''" t) - (tramp-send-command vec "PS3=''" t) - (tramp-send-command vec "PROMPT_COMMAND=''" t) - - ;; Try to set up the coding system correctly. - ;; CCC this can't be the right way to do it. Hm. - (tramp-message vec 5 "Determining coding system") - (tramp-send-command vec "echo foo ; echo bar" t) - (with-current-buffer (process-buffer proc) - (goto-char (point-min)) - (if (featurep 'mule) - ;; Use MULE to select the right EOL convention for communicating - ;; with the process. - (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc) - (cons 'undecided 'undecided))) - cs-decode cs-encode) - (when (symbolp cs) (setq cs (cons cs cs))) - (setq cs-decode (car cs)) - (setq cs-encode (cdr cs)) - (unless cs-decode (setq cs-decode 'undecided)) - (unless cs-encode (setq cs-encode 'undecided)) - (setq cs-encode (tramp-coding-system-change-eol-conversion - cs-encode 'unix)) - (when (search-forward "\r" nil t) - (setq cs-decode (tramp-coding-system-change-eol-conversion - cs-decode 'dos))) - (tramp-compat-funcall - 'set-buffer-process-coding-system cs-decode cs-encode) - (tramp-message - vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)) - ;; Look for ^M and do something useful if found. - (when (search-forward "\r" nil t) - ;; We have found a ^M but cannot frob the process coding system - ;; because we're running on a non-MULE Emacs. Let's try - ;; stty, instead. - (tramp-send-command vec "stty -onlcr" t)))) - ;; Dump stty settings in the traces. - (when (>= tramp-verbose 9) - (tramp-send-command vec "stty -a" t)) - (tramp-send-command vec "set +o vi +o emacs" t) - - ;; Check whether the output of "uname -sr" has been changed. If - ;; yes, this is a strong indication that we must expire all - ;; connection properties. We start again with - ;; `tramp-maybe-open-connection', it will be catched there. - (tramp-message vec 5 "Checking system information") - (let ((old-uname (tramp-get-connection-property vec "uname" nil)) - (new-uname - (tramp-set-connection-property - vec "uname" - (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) - (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) - (with-current-buffer (tramp-get-debug-buffer vec) - ;; Keep the debug buffer. - (rename-buffer - (generate-new-buffer-name tramp-temp-buffer-name) 'unique) - (tramp-compat-funcall 'tramp-cleanup-connection vec) - (if (= (point-min) (point-max)) - (kill-buffer nil) - (rename-buffer (tramp-debug-buffer-name vec) 'unique)) - ;; We call `tramp-get-buffer' in order to keep the debug buffer. - (tramp-get-buffer vec) - (tramp-message - vec 3 - "Connection reset, because remote host changed from `%s' to `%s'" - old-uname new-uname) - (throw 'uname-changed (tramp-maybe-open-connection vec))))) - - ;; Check whether the remote host suffers from buggy - ;; `send-process-string'. This is known for FreeBSD (see comment in - ;; `send_process', file process.c). I've tested sending 624 bytes - ;; successfully, sending 625 bytes failed. Emacs makes a hack when - ;; this host type is detected locally. It cannot handle remote - ;; hosts, though. - (with-connection-property proc "chunksize" - (cond - ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) - tramp-chunksize) - (t - (tramp-message - vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match - "^FreeBSD" (tramp-get-connection-property vec "uname" "")) - 500 0)))) - - ;; Set remote PATH variable. - (tramp-set-remote-path vec) - - ;; Search for a good shell before searching for a command which - ;; checks if a file exists. This is done because Tramp wants to use - ;; "test foo; echo $?" to check if various conditions hold, and - ;; there are buggy /bin/sh implementations which don't execute the - ;; "echo $?" part if the "test" part has an error. In particular, - ;; the OpenSolaris /bin/sh is a problem. There are also other - ;; problems with /bin/sh of OpenSolaris, like redirection of stderr - ;; in function declarations, or changing HISTFILE in place. - ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when - ;; detected. - (tramp-find-shell vec) - - ;; Disable unexpected output. - (tramp-send-command vec "mesg n; biff n" t) - - ;; IRIX64 bash expands "!" even when in single quotes. This - ;; destroys our shell functions, we must disable it. See - ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. - (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" "")) - (tramp-send-command vec "set +H" t)) - - ;; Set `remote-tty' process property. - (ignore-errors - (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""))) - (unless (zerop (length tty)) (process-put proc 'remote-tty tty)))) - - ;; Set the environment. - (tramp-message vec 5 "Setting default environment") - - (let ((env (copy-sequence tramp-remote-process-environment)) - unset item) - (while env - (setq item (tramp-compat-split-string (car env) "=")) - (setcdr item (mapconcat 'identity (cdr item) "=")) - (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) - (tramp-send-command - vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t) - (push (car item) unset)) - (setq env (cdr env))) - (when unset - (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) - -;; CCC: We should either implement a Perl version of base64 encoding -;; and decoding. Then we just use that in the last item. The other -;; alternative is to use the Perl version of UU encoding. But then -;; we need a Lisp version of uuencode. -;; -;; Old text from documentation of tramp-methods: -;; Using a uuencode/uudecode inline method is discouraged, please use one -;; of the base64 methods instead since base64 encoding is much more -;; reliable and the commands are more standardized between the different -;; Unix versions. But if you can't use base64 for some reason, please -;; note that the default uudecode command does not work well for some -;; Unices, in particular AIX and Irix. For AIX, you might want to use -;; the following command for uudecode: -;; -;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1 -;; -;; For Irix, no solution is known yet. - -(defconst tramp-local-coding-commands - '((b64 base64-encode-region base64-decode-region) - (uu tramp-uuencode-region uudecode-decode-region) - (pack - "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" - "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) - "List of local coding commands for inline transfer. -Each item is a list that looks like this: - -\(FORMAT ENCODING DECODING\) - -FORMAT is symbol describing the encoding/decoding format. It can be -`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. - -ENCODING and DECODING can be strings, giving commands, or symbols, -giving functions. If they are strings, then they can contain -the \"%s\" format specifier. If that specifier is present, the input -filename will be put into the command line at that spot. If the -specifier is not present, the input should be read from standard -input. - -If they are functions, they will be called with two arguments, start -and end of region, and are expected to replace the region contents -with the encoded or decoded results, respectively.") - -(defconst tramp-remote-coding-commands - '((b64 "base64" "base64 -d") - (b64 "mimencode -b" "mimencode -u -b") - (b64 "mmencode -b" "mmencode -u -b") - (b64 "recode data..base64" "recode base64..data") - (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module) - (b64 tramp-perl-encode tramp-perl-decode) - (uu "uuencode xxx" "uudecode -o /dev/stdout") - (uu "uuencode xxx" "uudecode -o -") - (uu "uuencode xxx" "uudecode -p") - (uu "uuencode xxx" tramp-uudecode) - (pack - "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'" - "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'")) - "List of remote coding commands for inline transfer. -Each item is a list that looks like this: - -\(FORMAT ENCODING DECODING\) - -FORMAT is symbol describing the encoding/decoding format. It can be -`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. - -ENCODING and DECODING can be strings, giving commands, or symbols, -giving variables. If they are strings, then they can contain -the \"%s\" format specifier. If that specifier is present, the input -filename will be put into the command line at that spot. If the -specifier is not present, the input should be read from standard -input. - -If they are variables, this variable is a string containing a Perl -implementation for this functionality. This Perl program will be transferred -to the remote host, and it is available as shell function with the same name.") - -(defun tramp-find-inline-encoding (vec) - "Find an inline transfer encoding that works. -Goes through the list `tramp-local-coding-commands' and -`tramp-remote-coding-commands'." - (save-excursion - (let ((local-commands tramp-local-coding-commands) - (magic "xyzzy") - loc-enc loc-dec rem-enc rem-dec litem ritem found) - (while (and local-commands (not found)) - (setq litem (pop local-commands)) - (catch 'wont-work-local - (let ((format (nth 0 litem)) - (remote-commands tramp-remote-coding-commands)) - (setq loc-enc (nth 1 litem)) - (setq loc-dec (nth 2 litem)) - ;; If the local encoder or decoder is a string, the - ;; corresponding command has to work locally. - (if (not (stringp loc-enc)) - (tramp-message - vec 5 "Checking local encoding function `%s'" loc-enc) - (tramp-message - vec 5 "Checking local encoding command `%s' for sanity" loc-enc) - (unless (zerop (tramp-call-local-coding-command - loc-enc nil nil)) - (throw 'wont-work-local nil))) - (if (not (stringp loc-dec)) - (tramp-message - vec 5 "Checking local decoding function `%s'" loc-dec) - (tramp-message - vec 5 "Checking local decoding command `%s' for sanity" loc-dec) - (unless (zerop (tramp-call-local-coding-command - loc-dec nil nil)) - (throw 'wont-work-local nil))) - ;; Search for remote coding commands with the same format - (while (and remote-commands (not found)) - (setq ritem (pop remote-commands)) - (catch 'wont-work-remote - (when (equal format (nth 0 ritem)) - (setq rem-enc (nth 1 ritem)) - (setq rem-dec (nth 2 ritem)) - ;; Check if remote encoding and decoding commands can be - ;; called remotely with null input and output. This makes - ;; sure there are no syntax errors and the command is really - ;; found. Note that we do not redirect stdout to /dev/null, - ;; for two reasons: when checking the decoding command, we - ;; actually check the output it gives. And also, when - ;; redirecting "mimencode" output to /dev/null, then as root - ;; it might change the permissions of /dev/null! - (when (not (stringp rem-enc)) - (let ((name (symbol-name rem-enc))) - (while (string-match (regexp-quote "-") name) - (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value rem-enc) name) - (setq rem-enc name))) - (tramp-message - vec 5 - "Checking remote encoding command `%s' for sanity" rem-enc) - (unless (zerop (tramp-send-command-and-check - vec (format "%s </dev/null" rem-enc) t)) - (throw 'wont-work-remote nil)) - - (when (not (stringp rem-dec)) - (let ((name (symbol-name rem-dec))) - (while (string-match (regexp-quote "-") name) - (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value rem-dec) name) - (setq rem-dec name))) - (tramp-message - vec 5 - "Checking remote decoding command `%s' for sanity" rem-dec) - (unless (zerop (tramp-send-command-and-check - vec - (format "echo %s | %s | %s" - magic rem-enc rem-dec) - t)) - (throw 'wont-work-remote nil)) - - (with-current-buffer (tramp-get-buffer vec) - (goto-char (point-min)) - (unless (looking-at (regexp-quote magic)) - (throw 'wont-work-remote nil))) - - ;; `rem-enc' and `rem-dec' could be a string meanwhile. - (setq rem-enc (nth 1 ritem)) - (setq rem-dec (nth 2 ritem)) - (setq found t))))))) - - ;; Did we find something? - (unless found - (tramp-error - vec 'file-error "Couldn't find an inline transfer encoding")) - - ;; Set connection properties. - (tramp-message vec 5 "Using local encoding `%s'" loc-enc) - (tramp-set-connection-property vec "local-encoding" loc-enc) - (tramp-message vec 5 "Using local decoding `%s'" loc-dec) - (tramp-set-connection-property vec "local-decoding" loc-dec) - (tramp-message vec 5 "Using remote encoding `%s'" rem-enc) - (tramp-set-connection-property vec "remote-encoding" rem-enc) - (tramp-message vec 5 "Using remote decoding `%s'" rem-dec) - (tramp-set-connection-property vec "remote-decoding" rem-dec)))) - -(defun tramp-call-local-coding-command (cmd input output) - "Call the local encoding or decoding command. -If CMD contains \"%s\", provide input file INPUT there in command. -Otherwise, INPUT is passed via standard input. -INPUT can also be nil which means `/dev/null'. -OUTPUT can be a string (which specifies a filename), or t (which -means standard output and thus the current buffer), or nil (which -means discard it)." - (tramp-local-call-process - tramp-encoding-shell - (when (and input (not (string-match "%s" cmd))) input) - (if (eq output t) t nil) - nil - tramp-encoding-command-switch - (concat - (if (string-match "%s" cmd) (format cmd input) cmd) - (if (stringp output) (concat "> " output) "")))) - -(defconst tramp-inline-compress-commands - '(("gzip" "gzip -d") - ("bzip2" "bzip2 -d") - ("compress" "compress -d")) - "List of compress and decompress commands for inline transfer. -Each item is a list that looks like this: - -\(COMPRESS DECOMPRESS\) - -COMPRESS or DECOMPRESS are strings with the respective commands.") - -(defun tramp-find-inline-compress (vec) - "Find an inline transfer compress command that works. -Goes through the list `tramp-inline-compress-commands'." - (save-excursion - (let ((commands tramp-inline-compress-commands) - (magic "xyzzy") - item compress decompress - found) - (while (and commands (not found)) - (catch 'next - (setq item (pop commands) - compress (nth 0 item) - decompress (nth 1 item)) - (tramp-message - vec 5 - "Checking local compress command `%s', `%s' for sanity" - compress decompress) - (unless (zerop (tramp-call-local-coding-command - (format "echo %s | %s | %s" - magic compress decompress) nil nil)) - (throw 'next nil)) - (tramp-message - vec 5 - "Checking remote compress command `%s', `%s' for sanity" - compress decompress) - (unless (zerop (tramp-send-command-and-check - vec (format "echo %s | %s | %s" - magic compress decompress) t)) - (throw 'next nil)) - (setq found t))) - - ;; Did we find something? - (if found - (progn - ;; Set connection properties. - (tramp-message - vec 5 "Using inline transfer compress command `%s'" compress) - (tramp-set-connection-property vec "inline-compress" compress) - (tramp-message - vec 5 "Using inline transfer decompress command `%s'" decompress) - (tramp-set-connection-property vec "inline-decompress" decompress)) - - (tramp-set-connection-property vec "inline-compress" nil) - (tramp-set-connection-property vec "inline-decompress" nil) - (tramp-message - vec 2 "Couldn't find an inline transfer compress command"))))) - -(defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'. -Gateway hops are already opened." - (let ((target-alist `(,vec)) - (choices tramp-default-proxies-alist) - item proxy) - - ;; Look for proxy hosts to be passed. - (while choices - (setq item (pop choices) - proxy (eval (nth 2 item))) - (when (and - ;; host - (string-match (or (eval (nth 0 item)) "") - (or (tramp-file-name-host (car target-alist)) "")) - ;; user - (string-match (or (eval (nth 1 item)) "") - (or (tramp-file-name-user (car target-alist)) ""))) - (if (null proxy) - ;; No more hops needed. - (setq choices nil) - ;; Replace placeholders. - (setq proxy - (format-spec - proxy - (format-spec-make - ?u (or (tramp-file-name-user (car target-alist)) "") - ?h (or (tramp-file-name-host (car target-alist)) "")))) - (with-parsed-tramp-file-name proxy l - ;; Add the hop. - (add-to-list 'target-alist l) - ;; Start next search. - (setq choices tramp-default-proxies-alist))))) - - ;; Handle gateways. - (when (and (boundp 'tramp-gw-tunnel-method) - (string-match (format - "^\\(%s\\|%s\\)$" - (symbol-value 'tramp-gw-tunnel-method) - (symbol-value 'tramp-gw-socks-method)) - (tramp-file-name-method (car target-alist)))) - (let ((gw (pop target-alist)) - (hop (pop target-alist))) - ;; Is the method prepared for gateways? - (unless (tramp-get-method-parameter - (tramp-file-name-method hop) 'tramp-default-port) - (tramp-error - vec 'file-error - "Method `%s' is not supported for gateway access." - (tramp-file-name-method hop))) - ;; Add default port if needed. - (unless - (string-match - tramp-host-with-port-regexp (tramp-file-name-host hop)) - (aset hop 2 - (concat - (tramp-file-name-host hop) tramp-prefix-port-format - (number-to-string - (tramp-get-method-parameter - (tramp-file-name-method hop) 'tramp-default-port))))) - ;; Open the gateway connection. - (add-to-list - 'target-alist - (vector - (tramp-file-name-method hop) (tramp-file-name-user hop) - (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil)) - ;; For the password prompt, we need the correct values. - ;; Therefore, we must remember the gateway vector. But we - ;; cannot do it as connection property, because it shouldn't - ;; be persistent. And we have no started process yet either. - (tramp-set-file-property (car target-alist) "" "gateway" hop))) - - ;; Foreign and out-of-band methods are not supported for multi-hops. - (when (cdr target-alist) - (setq choices target-alist) - (while choices - (setq item (pop choices)) - (when - (or - (not - (tramp-get-method-parameter - (tramp-file-name-method item) 'tramp-login-program)) - (tramp-get-method-parameter - (tramp-file-name-method item) 'tramp-copy-program)) - (tramp-error - vec 'file-error - "Method `%s' is not supported for multi-hops." - (tramp-file-name-method item))))) - - ;; In case the host name is not used for the remote shell - ;; command, the user could be misguided by applying a random - ;; hostname. - (let* ((v (car target-alist)) - (method (tramp-file-name-method v)) - (host (tramp-file-name-host v))) - (unless - (or - ;; There are multi-hops. - (cdr target-alist) - ;; The host name is used for the remote shell command. - (member - '("%h") (tramp-get-method-parameter method 'tramp-login-args)) - ;; The host is local. We cannot use `tramp-local-host-p' - ;; here, because it opens a connection as well. - (string-match tramp-local-host-regexp host)) - (tramp-error - v 'file-error - "Host `%s' looks like a remote host, `%s' can only use the local host" - host method))) - - ;; Result. - target-alist)) - -(defun tramp-maybe-open-connection (vec) - "Maybe open a connection VEC. -Does not do anything if a connection is already open, but re-opens the -connection if a previous connection has died for some reason." - (catch 'uname-changed - (let ((p (tramp-get-connection-process vec)) - (process-name (tramp-get-connection-property vec "process-name" nil)) - (process-environment (copy-sequence process-environment))) - - ;; If too much time has passed since last command was sent, look - ;; whether process is still alive. If it isn't, kill it. When - ;; using ssh, it can sometimes happen that the remote end has - ;; hung up but the local ssh client doesn't recognize this until - ;; it tries to send some data to the remote end. So that's why - ;; we try to send a command from time to time, then look again - ;; whether the process is really alive. - (condition-case nil - (when (and (> (tramp-time-diff - (current-time) - (tramp-get-connection-property - p "last-cmd-time" '(0 0 0))) - 60) - p (processp p) (memq (process-status p) '(run open))) - (tramp-send-command vec "echo are you awake" t t) - (unless (and (memq (process-status p) '(run open)) - (tramp-wait-for-output p 10)) - ;; The error will be catched locally. - (tramp-error vec 'file-error "Awake did fail"))) - (file-error - (tramp-flush-connection-property vec) - (tramp-flush-connection-property p) - (delete-process p) - (setq p nil))) - - ;; New connection must be opened. - (unless (and p (processp p) (memq (process-status p) '(run open))) - - ;; We call `tramp-get-buffer' in order to get a debug buffer for - ;; messages from the beginning. - (tramp-get-buffer vec) - (with-progress-reporter - vec 3 - (if (zerop (length (tramp-file-name-user vec))) - (format "Opening connection for %s using %s" - (tramp-file-name-host vec) - (tramp-file-name-method vec)) - (format "Opening connection for %s@%s using %s" - (tramp-file-name-user vec) - (tramp-file-name-host vec) - (tramp-file-name-method vec))) - - ;; Start new process. - (when (and p (processp p)) - (delete-process p)) - (setenv "TERM" tramp-terminal-type) - (setenv "LC_ALL" "C") - (setenv "PROMPT_COMMAND") - (setenv "PS1" tramp-initial-end-of-output) - (let* ((target-alist (tramp-compute-multi-hops vec)) - (process-connection-type tramp-process-connection-type) - (process-adaptive-read-buffering nil) - (coding-system-for-read nil) - ;; This must be done in order to avoid our file name handler. - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (start-process - (or process-name (tramp-buffer-name vec)) - (tramp-get-connection-buffer vec) - tramp-encoding-shell)))) - - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - - ;; Check whether process is alive. - (tramp-set-process-query-on-exit-flag p nil) - (tramp-barf-if-no-shell-prompt - p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell) - - ;; Now do all the connections as specified. - (while target-alist - (let* ((hop (car target-alist)) - (l-method (tramp-file-name-method hop)) - (l-user (tramp-file-name-user hop)) - (l-host (tramp-file-name-host hop)) - (l-port nil) - (login-program - (tramp-get-method-parameter - l-method 'tramp-login-program)) - (login-args - (tramp-get-method-parameter l-method 'tramp-login-args)) - (async-args - (tramp-get-method-parameter l-method 'tramp-async-args)) - (gw-args - (tramp-get-method-parameter l-method 'tramp-gw-args)) - (gw (tramp-get-file-property hop "" "gateway" nil)) - (g-method (and gw (tramp-file-name-method gw))) - (g-user (and gw (tramp-file-name-user gw))) - (g-host (and gw (tramp-file-name-host gw))) - (command login-program) - ;; We don't create the temporary file. In fact, - ;; it is just a prefix for the ControlPath option - ;; of ssh; the real temporary file has another - ;; name, and it is created and protected by ssh. - ;; It is also removed by ssh, when the connection - ;; is closed. - (tmpfile - (tramp-set-connection-property - p "temp-file" - (make-temp-name - (expand-file-name - tramp-temp-name-prefix - (tramp-compat-temporary-file-directory))))) - spec) - - ;; Add arguments for asynchrononous processes. - (when (and process-name async-args) - (setq login-args (append async-args login-args))) - - ;; Add gateway arguments if necessary. - (when (and gw gw-args) - (setq login-args (append gw-args login-args))) - - ;; Check for port number. Until now, there's no need - ;; for handling like method, user, host. - (when (string-match tramp-host-with-port-regexp l-host) - (setq l-port (match-string 2 l-host) - l-host (match-string 1 l-host))) - - ;; Set variables for computing the prompt for reading - ;; password. They can also be derived from a gateway. - (setq tramp-current-method (or g-method l-method) - tramp-current-user (or g-user l-user) - tramp-current-host (or g-host l-host)) - - ;; Replace login-args place holders. - (setq - l-host (or l-host "") - l-user (or l-user "") - l-port (or l-port "") - spec (format-spec-make - ?h l-host ?u l-user ?p l-port ?t tmpfile) - command - (concat - ;; We do not want to see the trailing local prompt in - ;; `start-file-process'. - (unless (memq system-type '(windows-nt)) "exec ") - command " " - (mapconcat - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (mapconcat 'identity x " "))) - login-args " ") - ;; Local shell could be a Windows COMSPEC. It - ;; doesn't know the ";" syntax, but we must exit - ;; always for `start-file-process'. "exec" does not - ;; work either. - (if (memq system-type '(windows-nt)) " && exit || exit"))) - - ;; Send the command. - (tramp-message vec 3 "Sending command `%s'" command) - (tramp-send-command vec command t t) - (tramp-process-actions p vec tramp-actions-before-shell 60) - (tramp-message - vec 3 "Found remote shell prompt on `%s'" l-host)) - ;; Next hop. - (setq target-alist (cdr target-alist))) - - ;; Make initial shell settings. - (tramp-open-connection-setup-interactive-shell p vec))))))) - -(defun tramp-send-command (vec command &optional neveropen nooutput) - "Send the COMMAND to connection VEC. -Erases temporary buffer before sending the command. If optional -arg NEVEROPEN is non-nil, never try to open the connection. This -is meant to be used from `tramp-maybe-open-connection' only. The -function waits for output unless NOOUTPUT is set." - (unless neveropen (tramp-maybe-open-connection vec)) - (let ((p (tramp-get-connection-process vec))) - (when (tramp-get-connection-property p "remote-echo" nil) - ;; We mark the command string that it can be erased in the output buffer. - (tramp-set-connection-property p "check-remote-echo" t) - (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark))) - (tramp-message vec 6 "%s" command) - (tramp-send-string vec command) - (unless nooutput (tramp-wait-for-output p)))) - -(defun tramp-wait-for-output (proc &optional timeout) - "Wait for output from remote command." - (unless (buffer-live-p (process-buffer proc)) - (delete-process proc) - (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) - (with-current-buffer (process-buffer proc) - (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might - ;; be leading escape sequences, which must be ignored. - (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) - ;; Sometimes, the commands do not return a newline but a - ;; null byte before the shell prompt, for example "git - ;; ls-files -c -z ...". - (regexp1 (format "\\(^\\|\000\\)%s" regexp)) - (found (tramp-wait-for-regexp proc timeout regexp1))) - (if found - (let (buffer-read-only) - ;; A simple-minded busybox has sent " ^H" sequences. - ;; Delete them. - (goto-char (point-min)) - (when (re-search-forward - "^\\(.\b\\)+$" (tramp-compat-line-end-position) t) - (forward-line 1) - (delete-region (point-min) (point))) - ;; Delete the prompt. - (goto-char (point-max)) - (re-search-backward regexp nil t) - (delete-region (point) (point-max))) - (if timeout - (tramp-error - proc 'file-error - "[[Remote prompt `%s' not found in %d secs]]" - tramp-end-of-output timeout) - (tramp-error - proc 'file-error - "[[Remote prompt `%s' not found]]" tramp-end-of-output))) - ;; Return value is whether end-of-output sentinel was found. - found))) - -(defun tramp-send-command-and-check - (vec command &optional subshell dont-suppress-err) - "Run COMMAND and check its exit status. -Sends `echo $?' along with the COMMAND for checking the exit status. If -COMMAND is nil, just sends `echo $?'. Returns the exit status found. - -If the optional argument SUBSHELL is non-nil, the command is -executed in a subshell, ie surrounded by parentheses. If -DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null." - (tramp-send-command - vec - (concat (if subshell "( " "") - command - (if command (if dont-suppress-err "; " " 2>/dev/null; ") "") - "echo tramp_exit_status $?" - (if subshell " )" ""))) - (with-current-buffer (tramp-get-connection-buffer vec) - (goto-char (point-max)) - (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) - (tramp-error - vec 'file-error "Couldn't find exit status of `%s'" command)) - (skip-chars-forward "^ ") - (prog1 - (read (current-buffer)) - (let (buffer-read-only) (delete-region (match-beginning 0) (point-max)))))) - -(defun tramp-barf-unless-okay (vec command fmt &rest args) - "Run COMMAND, check exit status, throw error if exit status not okay. -Similar to `tramp-send-command-and-check' but accepts two more arguments -FMT and ARGS which are passed to `error'." - (unless (zerop (tramp-send-command-and-check vec command)) - (apply 'tramp-error vec 'file-error fmt args))) - -(defun tramp-send-command-and-read (vec command) - "Run COMMAND and return the output, which must be a Lisp expression. -In case there is no valid Lisp expression, it raises an error" - (tramp-barf-unless-okay vec command "`%s' returns with error" command) - (with-current-buffer (tramp-get-connection-buffer vec) - ;; Read the expression. - (goto-char (point-min)) - (condition-case nil - (prog1 (read (current-buffer)) - ;; Error handling. - (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t) - (error nil))) - (error (tramp-error - vec 'file-error - "`%s' does not return a valid Lisp expression: `%s'" - command (buffer-string)))))) - ;; It seems that Tru64 Unix does not like it if long strings are sent ;; to it in one go. (This happens when sending the Perl ;; `file-attributes' implementation, for instance.) Therefore, we @@ -7791,181 +2852,6 @@ (setq pos (+ pos chunksize)))) (process-send-string p string))))) -(defun tramp-mode-string-to-int (mode-string) - "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits." - (let* (case-fold-search - (mode-chars (string-to-vector mode-string)) - (owner-read (aref mode-chars 1)) - (owner-write (aref mode-chars 2)) - (owner-execute-or-setid (aref mode-chars 3)) - (group-read (aref mode-chars 4)) - (group-write (aref mode-chars 5)) - (group-execute-or-setid (aref mode-chars 6)) - (other-read (aref mode-chars 7)) - (other-write (aref mode-chars 8)) - (other-execute-or-sticky (aref mode-chars 9))) - (save-match-data - (logior - (cond - ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400")) - ((char-equal owner-read ?-) 0) - (t (error "Second char `%c' must be one of `r-'" owner-read))) - (cond - ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200")) - ((char-equal owner-write ?-) 0) - (t (error "Third char `%c' must be one of `w-'" owner-write))) - (cond - ((char-equal owner-execute-or-setid ?x) - (tramp-octal-to-decimal "00100")) - ((char-equal owner-execute-or-setid ?S) - (tramp-octal-to-decimal "04000")) - ((char-equal owner-execute-or-setid ?s) - (tramp-octal-to-decimal "04100")) - ((char-equal owner-execute-or-setid ?-) 0) - (t (error "Fourth char `%c' must be one of `xsS-'" - owner-execute-or-setid))) - (cond - ((char-equal group-read ?r) (tramp-octal-to-decimal "00040")) - ((char-equal group-read ?-) 0) - (t (error "Fifth char `%c' must be one of `r-'" group-read))) - (cond - ((char-equal group-write ?w) (tramp-octal-to-decimal "00020")) - ((char-equal group-write ?-) 0) - (t (error "Sixth char `%c' must be one of `w-'" group-write))) - (cond - ((char-equal group-execute-or-setid ?x) - (tramp-octal-to-decimal "00010")) - ((char-equal group-execute-or-setid ?S) - (tramp-octal-to-decimal "02000")) - ((char-equal group-execute-or-setid ?s) - (tramp-octal-to-decimal "02010")) - ((char-equal group-execute-or-setid ?-) 0) - (t (error "Seventh char `%c' must be one of `xsS-'" - group-execute-or-setid))) - (cond - ((char-equal other-read ?r) - (tramp-octal-to-decimal "00004")) - ((char-equal other-read ?-) 0) - (t (error "Eighth char `%c' must be one of `r-'" other-read))) - (cond - ((char-equal other-write ?w) (tramp-octal-to-decimal "00002")) - ((char-equal other-write ?-) 0) - (t (error "Nineth char `%c' must be one of `w-'" other-write))) - (cond - ((char-equal other-execute-or-sticky ?x) - (tramp-octal-to-decimal "00001")) - ((char-equal other-execute-or-sticky ?T) - (tramp-octal-to-decimal "01000")) - ((char-equal other-execute-or-sticky ?t) - (tramp-octal-to-decimal "01001")) - ((char-equal other-execute-or-sticky ?-) 0) - (t (error "Tenth char `%c' must be one of `xtT-'" - other-execute-or-sticky))))))) - -(defun tramp-convert-file-attributes (vec attr) - "Convert file-attributes ATTR generated by perl script, stat or ls. -Convert file mode bits to string and set virtual device number. -Return ATTR." - (when attr - ;; Convert last access time. - (unless (listp (nth 4 attr)) - (setcar (nthcdr 4 attr) - (list (floor (nth 4 attr) 65536) - (floor (mod (nth 4 attr) 65536))))) - ;; Convert last modification time. - (unless (listp (nth 5 attr)) - (setcar (nthcdr 5 attr) - (list (floor (nth 5 attr) 65536) - (floor (mod (nth 5 attr) 65536))))) - ;; Convert last status change time. - (unless (listp (nth 6 attr)) - (setcar (nthcdr 6 attr) - (list (floor (nth 6 attr) 65536) - (floor (mod (nth 6 attr) 65536))))) - ;; Convert file size. - (when (< (nth 7 attr) 0) - (setcar (nthcdr 7 attr) -1)) - (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) - (setcar (nthcdr 7 attr) (round (nth 7 attr)))) - ;; Convert file mode bits to string. - (unless (stringp (nth 8 attr)) - (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))) - (when (stringp (car attr)) - (aset (nth 8 attr) 0 ?l))) - ;; Convert directory indication bit. - (when (string-match "^d" (nth 8 attr)) - (setcar attr t)) - ;; Convert symlink from `tramp-do-file-attributes-with-stat'. - (when (consp (car attr)) - (if (and (stringp (caar attr)) - (string-match ".+ -> .\\(.+\\)." (caar attr))) - (setcar attr (match-string 1 (caar attr))) - (setcar attr nil))) - ;; Set file's gid change bit. - (setcar (nthcdr 9 attr) - (if (numberp (nth 3 attr)) - (not (= (nth 3 attr) - (tramp-get-remote-gid vec 'integer))) - (not (string-equal - (nth 3 attr) - (tramp-get-remote-gid vec 'string))))) - ;; Convert inode. - (unless (listp (nth 10 attr)) - (setcar (nthcdr 10 attr) - (condition-case nil - (cons (floor (nth 10 attr) 65536) - (floor (mod (nth 10 attr) 65536))) - ;; Inodes can be incredible huge. We must hide this. - (error (tramp-get-inode vec))))) - ;; Set virtual device number. - (setcar (nthcdr 11 attr) - (tramp-get-device vec)) - attr)) - -(defun tramp-check-cached-permissions (vec access) - "Check `file-attributes' caches for VEC. -Return t if according to the cache access type ACCESS is known to -be granted." - (let ((result nil) - (offset (cond - ((eq ?r access) 1) - ((eq ?w access) 2) - ((eq ?x access) 3)))) - (dolist (suffix '("string" "integer") result) - (setq - result - (or - result - (let ((file-attr - (tramp-get-file-property - vec (tramp-file-name-localname vec) - (concat "file-attributes-" suffix) nil)) - (remote-uid - (tramp-get-connection-property - vec (concat "uid-" suffix) nil)) - (remote-gid - (tramp-get-connection-property - vec (concat "gid-" suffix) nil))) - (and - file-attr - (or - ;; Not a symlink - (eq t (car file-attr)) - (null (car file-attr))) - (or - ;; World accessible. - (eq access (aref (nth 8 file-attr) (+ offset 6))) - ;; User accessible and owned by user. - (and - (eq access (aref (nth 8 file-attr) offset)) - (equal remote-uid (nth 2 file-attr))) - ;; Group accessible and owned by user's - ;; principal group. - (and - (eq access (aref (nth 8 file-attr) (+ offset 3))) - (equal remote-gid (nth 3 file-attr))))))))))) - (defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." @@ -7992,199 +2878,6 @@ (list string (length tramp-devices)))) (cons -1 (nth 1 (assoc string tramp-devices))))) -(defun tramp-file-mode-from-int (mode) - "Turn an integer representing a file mode into an ls(1)-like string." - (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) - (user (logand (lsh mode -6) 7)) - (group (logand (lsh mode -3) 7)) - (other (logand (lsh mode -0) 7)) - (suid (> (logand (lsh mode -9) 4) 0)) - (sgid (> (logand (lsh mode -9) 2) 0)) - (sticky (> (logand (lsh mode -9) 1) 0))) - (setq user (tramp-file-mode-permissions user suid "s")) - (setq group (tramp-file-mode-permissions group sgid "s")) - (setq other (tramp-file-mode-permissions other sticky "t")) - (concat type user group other))) - -(defun tramp-file-mode-permissions (perm suid suid-text) - "Convert a permission bitset into a string. -This is used internally by `tramp-file-mode-from-int'." - (let ((r (> (logand perm 4) 0)) - (w (> (logand perm 2) 0)) - (x (> (logand perm 1) 0))) - (concat (or (and r "r") "-") - (or (and w "w") "-") - (or (and suid x suid-text) ; suid, execute - (and suid (upcase suid-text)) ; suid, !execute - (and x "x") "-")))) ; !suid - -(defun tramp-decimal-to-octal (i) - "Return a string consisting of the octal digits of I. -Not actually used. Use `(format \"%o\" i)' instead?" - (cond ((< i 0) (error "Cannot convert negative number to octal")) - ((not (integerp i)) (error "Cannot convert non-integer to octal")) - ((zerop i) "0") - (t (concat (tramp-decimal-to-octal (/ i 8)) - (number-to-string (% i 8)))))) - -;; Kudos to Gerd Moellmann for this suggestion. -(defun tramp-octal-to-decimal (ostr) - "Given a string of octal digits, return a decimal number." - (let ((x (or ostr ""))) - ;; `save-match' is in `tramp-mode-string-to-int' which calls this. - (unless (string-match "\\`[0-7]*\\'" x) - (error "Non-octal junk in string `%s'" x)) - (string-to-number ostr 8))) - -(defun tramp-shell-case-fold (string) - "Converts STRING to shell glob pattern which ignores case." - (mapconcat - (lambda (c) - (if (equal (downcase c) (upcase c)) - (vector c) - (format "[%c%c]" (downcase c) (upcase c)))) - string - "")) - - -;; ------------------------------------------------------------ -;; -- Tramp file names -- -;; ------------------------------------------------------------ -;; Conversion functions between external representation and -;; internal data structure. Convenience functions for internal -;; data structure. - -(defun tramp-file-name-p (vec) - "Check, whether VEC is a Tramp object." - (and (vectorp vec) (= 4 (length vec)))) - -(defun tramp-file-name-method (vec) - "Return method component of VEC." - (and (tramp-file-name-p vec) (aref vec 0))) - -(defun tramp-file-name-user (vec) - "Return user component of VEC." - (and (tramp-file-name-p vec) (aref vec 1))) - -(defun tramp-file-name-host (vec) - "Return host component of VEC." - (and (tramp-file-name-p vec) (aref vec 2))) - -(defun tramp-file-name-localname (vec) - "Return localname component of VEC." - (and (tramp-file-name-p vec) (aref vec 3))) - -;; The user part of a Tramp file name vector can be of kind -;; "user%domain". Sometimes, we must extract these parts. -(defun tramp-file-name-real-user (vec) - "Return the user name of VEC without domain." - (save-match-data - (let ((user (tramp-file-name-user vec))) - (if (and (stringp user) - (string-match tramp-user-with-domain-regexp user)) - (match-string 1 user) - user)))) - -(defun tramp-file-name-domain (vec) - "Return the domain name of VEC." - (save-match-data - (let ((user (tramp-file-name-user vec))) - (and (stringp user) - (string-match tramp-user-with-domain-regexp user) - (match-string 2 user))))) - -;; The host part of a Tramp file name vector can be of kind -;; "host#port". Sometimes, we must extract these parts. -(defun tramp-file-name-real-host (vec) - "Return the host name of VEC without port." - (save-match-data - (let ((host (tramp-file-name-host vec))) - (if (and (stringp host) - (string-match tramp-host-with-port-regexp host)) - (match-string 1 host) - host)))) - -(defun tramp-file-name-port (vec) - "Return the port number of VEC." - (save-match-data - (let ((host (tramp-file-name-host vec))) - (and (stringp host) - (string-match tramp-host-with-port-regexp host) - (string-to-number (match-string 2 host)))))) - -(defun tramp-tramp-file-p (name) - "Return t if NAME is a string with Tramp file name syntax." - (save-match-data - (and (stringp name) (string-match tramp-file-name-regexp name)))) - -(defun tramp-find-method (method user host) - "Return the right method string to use. -This is METHOD, if non-nil. Otherwise, do a lookup in -`tramp-default-method-alist'." - (or method - (let ((choices tramp-default-method-alist) - lmethod item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or host "")) - (string-match (or (nth 1 item) "") (or user ""))) - (setq lmethod (nth 2 item)) - (setq choices nil))) - lmethod) - tramp-default-method)) - -(defun tramp-find-user (method user host) - "Return the right user string to use. -This is USER, if non-nil. Otherwise, do a lookup in -`tramp-default-user-alist'." - (or user - (let ((choices tramp-default-user-alist) - luser item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or method "")) - (string-match (or (nth 1 item) "") (or host ""))) - (setq luser (nth 2 item)) - (setq choices nil))) - luser) - tramp-default-user)) - -(defun tramp-find-host (method user host) - "Return the right host string to use. -This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." - (or (and (> (length host) 0) host) - tramp-default-host)) - -(defun tramp-dissect-file-name (name &optional nodefault) - "Return a `tramp-file-name' structure. -The structure consists of remote method, remote user, remote host -and localname (file name on remote host). If NODEFAULT is -non-nil, the file name parts are not expanded to their default -values." - (save-match-data - (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match (error "Not a Tramp file name: %s" name)) - (let ((method (match-string (nth 1 tramp-file-name-structure) name)) - (user (match-string (nth 2 tramp-file-name-structure) name)) - (host (match-string (nth 3 tramp-file-name-structure) name)) - (localname (match-string (nth 4 tramp-file-name-structure) name))) - (when (member method '("multi" "multiu")) - (error - "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")" - method)) - (when host - (when (string-match tramp-prefix-ipv6-regexp host) - (setq host (replace-match "" nil t host))) - (when (string-match tramp-postfix-ipv6-regexp host) - (setq host (replace-match "" nil t host)))) - (if nodefault - (vector method user host localname) - (vector - (tramp-find-method method user host) - (tramp-find-user method user host) - (tramp-find-host method user host) - localname)))))) - (defun tramp-equal-remote (file1 file2) "Check, whether the remote parts of FILE1 and FILE2 are identical. The check depends on method, user and host name of the files. If @@ -8203,423 +2896,6 @@ (stringp (file-remote-p file2)) (string-equal (file-remote-p file1) (file-remote-p file2)))) -(defun tramp-make-tramp-file-name (method user host localname) - "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME." - (concat tramp-prefix-format - (when (not (zerop (length method))) - (concat method tramp-postfix-method-format)) - (when (not (zerop (length user))) - (concat user tramp-postfix-user-format)) - (when host - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host)) - tramp-postfix-host-format - (when localname localname))) - -(defun tramp-completion-make-tramp-file-name (method user host localname) - "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. -It must not be a complete Tramp file name, but as long as there are -necessary only. This function will be used in file name completion." - (concat tramp-prefix-format - (when (not (zerop (length method))) - (concat method tramp-postfix-method-format)) - (when (not (zerop (length user))) - (concat user tramp-postfix-user-format)) - (when (not (zerop (length host))) - (concat - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host) - tramp-postfix-host-format)) - (when localname localname))) - -(defun tramp-make-copy-program-file-name (vec) - "Create a file name suitable to be passed to `rcp' and workalikes." - (let ((user (tramp-file-name-user vec)) - (host (tramp-file-name-real-host vec)) - (localname (tramp-shell-quote-argument - (tramp-file-name-localname vec)))) - (if (not (zerop (length user))) - (format "%s@%s:%s" user host localname) - (format "%s:%s" host localname)))) - -(defun tramp-method-out-of-band-p (vec size) - "Return t if this is an out-of-band method, nil otherwise." - (and - ;; It shall be an out-of-band method. - (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program) - ;; Either the file size is large enough, or (in rare cases) there - ;; does not exist a remote encoding. - (or (null tramp-copy-size-limit) - (> size tramp-copy-size-limit) - (null (tramp-get-inline-coding vec "remote-encoding" size))))) - -(defun tramp-local-host-p (vec) - "Return t if this points to the local host, nil otherwise." - ;; We cannot use `tramp-file-name-real-host'. A port is an - ;; indication for an ssh tunnel or alike. - (let ((host (tramp-file-name-host vec))) - (and - (stringp host) - (string-match tramp-local-host-regexp host) - ;; The method shall be applied to one of the shell file name - ;; handler. `tramp-local-host-p' is also called for "smb" and - ;; alike, where it must fail. - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-login-program) - ;; The local temp directory must be writable for the other user. - (file-writable-p - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - host - (tramp-compat-temporary-file-directory))) - ;; On some systems, chown runs only for root. - (or (zerop (user-uid)) - (zerop (tramp-get-remote-uid vec 'integer)))))) - -;; Variables local to connection. - -(defun tramp-get-remote-path (vec) - (with-connection-property - ;; When `tramp-own-remote-path' is in `tramp-remote-path', we - ;; cache the result for the session only. Otherwise, the result - ;; is cached persistently. - (if (memq 'tramp-own-remote-path tramp-remote-path) - (tramp-get-connection-process vec) - vec) - "remote-path" - (let* ((remote-path (copy-tree tramp-remote-path)) - (elt1 (memq 'tramp-default-remote-path remote-path)) - (elt2 (memq 'tramp-own-remote-path remote-path)) - (default-remote-path - (when elt1 - (condition-case nil - (tramp-send-command-and-read - vec "echo \\\"`getconf PATH`\\\"") - ;; Default if "getconf" is not available. - (error - (tramp-message - vec 3 - "`getconf PATH' not successful, using default value \"%s\"." - "/bin:/usr/bin") - "/bin:/usr/bin")))) - (own-remote-path - (when elt2 - (condition-case nil - (tramp-send-command-and-read vec "echo \\\"$PATH\\\"") - ;; Default if "getconf" is not available. - (error - (tramp-message - vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.") - nil))))) - - ;; Replace place holder `tramp-default-remote-path'. - (when elt1 - (setcdr elt1 - (append - (tramp-compat-split-string default-remote-path ":") - (cdr elt1))) - (setq remote-path (delq 'tramp-default-remote-path remote-path))) - - ;; Replace place holder `tramp-own-remote-path'. - (when elt2 - (setcdr elt2 - (append - (tramp-compat-split-string own-remote-path ":") - (cdr elt2))) - (setq remote-path (delq 'tramp-own-remote-path remote-path))) - - ;; Remove double entries. - (setq elt1 remote-path) - (while (consp elt1) - (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1)))) - (setcar elt2 nil)) - (setq elt1 (cdr elt1))) - - ;; Remove non-existing directories. - (delq - nil - (mapcar - (lambda (x) - (and - (stringp x) - (file-directory-p - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - x)) - x)) - remote-path))))) - -(defun tramp-get-remote-tmpdir (vec) - (with-connection-property vec "tmp-directory" - (let ((dir (tramp-shell-quote-argument "/tmp"))) - (if (and (zerop - (tramp-send-command-and-check - vec (format "%s -d %s" (tramp-get-test-command vec) dir))) - (zerop - (tramp-send-command-and-check - vec (format "%s -w %s" (tramp-get-test-command vec) dir)))) - dir - (tramp-error vec 'file-error "Directory %s not accessible" dir))))) - -(defun tramp-get-ls-command (vec) - (with-connection-property vec "ls" - (tramp-message vec 5 "Finding a suitable `ls' command") - (or - (catch 'ls-found - (dolist (cmd '("ls" "gnuls" "gls")) - (let ((dl (tramp-get-remote-path vec)) - result) - (while (and dl (setq result (tramp-find-executable vec cmd dl t t))) - ;; Check parameters. On busybox, "ls" output coloring is - ;; enabled by default sometimes. So we try to disable it - ;; when possible. $LS_COLORING is not supported there. - ;; Some "ls" versions are sensible wrt the order of - ;; arguments, they fail when "-al" is after the - ;; "--color=never" argument (for example on FreeBSD). - (when (zerop (tramp-send-command-and-check - vec (format "%s -lnd /" result))) - (when (zerop (tramp-send-command-and-check - vec (format - "%s --color=never -al /dev/null" result))) - (setq result (concat result " --color=never"))) - (throw 'ls-found result)) - (setq dl (cdr dl)))))) - (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) - -(defun tramp-get-ls-command-with-dired (vec) - (save-match-data - (with-connection-property vec "ls-dired" - (tramp-message vec 5 "Checking, whether `ls --dired' works") - ;; Some "ls" versions are sensible wrt the order of arguments, - ;; they fail when "-al" is after the "--dired" argument (for - ;; example on FreeBSD). - (zerop (tramp-send-command-and-check - vec (format "%s --dired -al /dev/null" - (tramp-get-ls-command vec))))))) - -(defun tramp-get-test-command (vec) - (with-connection-property vec "test" - (tramp-message vec 5 "Finding a suitable `test' command") - (if (zerop (tramp-send-command-and-check vec "test 0")) - "test" - (tramp-find-executable vec "test" (tramp-get-remote-path vec))))) - -(defun tramp-get-test-nt-command (vec) - ;; Does `test A -nt B' work? Use abominable `find' construct if it - ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, - ;; for otherwise the shell crashes. - (with-connection-property vec "test-nt" - (or - (progn - (tramp-send-command - vec (format "( %s / -nt / )" (tramp-get-test-command vec))) - (with-current-buffer (tramp-get-buffer vec) - (goto-char (point-min)) - (when (looking-at (regexp-quote tramp-end-of-output)) - (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) - (progn - (tramp-send-command - vec - (format - "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}" - (tramp-get-test-command vec))) - "tramp_test_nt %s %s")))) - -(defun tramp-get-file-exists-command (vec) - (with-connection-property vec "file-exists" - (tramp-message vec 5 "Finding command to check if file exists") - (tramp-find-file-exists-command vec))) - -(defun tramp-get-remote-ln (vec) - (with-connection-property vec "ln" - (tramp-message vec 5 "Finding a suitable `ln' command") - (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) - -(defun tramp-get-remote-perl (vec) - (with-connection-property vec "perl" - (tramp-message vec 5 "Finding a suitable `perl' command") - (let ((result - (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) - (tramp-find-executable - vec "perl" (tramp-get-remote-path vec))))) - ;; We must check also for some Perl modules. - (when result - (with-connection-property vec "perl-file-spec" - (zerop - (tramp-send-command-and-check - vec (format "%s -e 'use File::Spec;'" result)))) - (with-connection-property vec "perl-cwd-realpath" - (zerop - (tramp-send-command-and-check - vec (format "%s -e 'use Cwd \"realpath\";'" result))))) - result))) - -(defun tramp-get-remote-stat (vec) - (with-connection-property vec "stat" - (tramp-message vec 5 "Finding a suitable `stat' command") - (let ((result (tramp-find-executable - vec "stat" (tramp-get-remote-path vec))) - tmp) - ;; Check whether stat(1) returns usable syntax. %s does not - ;; work on older AIX systems. - (when result - (setq tmp - ;; We don't want to display an error message. - (with-temp-message (or (current-message) "") - (condition-case nil - (tramp-send-command-and-read - vec (format "%s -c '(\"%%N\" %%s)' /" result)) - (error nil)))) - (unless (and (listp tmp) (stringp (car tmp)) - (string-match "^./.$" (car tmp)) - (integerp (cadr tmp))) - (setq result nil))) - result))) - -(defun tramp-get-remote-readlink (vec) - (with-connection-property vec "readlink" - (tramp-message vec 5 "Finding a suitable `readlink' command") - (let ((result (tramp-find-executable - vec "readlink" (tramp-get-remote-path vec)))) - (when (and result - ;; We don't want to display an error message. - (with-temp-message (or (current-message) "") - (condition-case nil - (zerop - (tramp-send-command-and-check - vec (format "%s --canonicalize-missing /" result))) - (error nil)))) - result)))) - -(defun tramp-get-remote-trash (vec) - (with-connection-property vec "trash" - (tramp-message vec 5 "Finding a suitable `trash' command") - (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) - -(defun tramp-get-remote-id (vec) - (with-connection-property vec "id" - (tramp-message vec 5 "Finding POSIX `id' command") - (or - (catch 'id-found - (let ((dl (tramp-get-remote-path vec)) - result) - (while (and dl (setq result (tramp-find-executable vec "id" dl t t))) - ;; Check POSIX parameter. - (when (zerop (tramp-send-command-and-check - vec (format "%s -u" result))) - (throw 'id-found result)) - (setq dl (cdr dl))))) - (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))) - -(defun tramp-get-remote-uid (vec id-format) - (with-connection-property vec (format "uid-%s" id-format) - (let ((res (tramp-send-command-and-read - vec - (format "%s -u%s %s" - (tramp-get-remote-id vec) - (if (equal id-format 'integer) "" "n") - (if (equal id-format 'integer) - "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/"))))) - ;; The command might not always return a number. - (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) - -(defun tramp-get-remote-gid (vec id-format) - (with-connection-property vec (format "gid-%s" id-format) - (let ((res (tramp-send-command-and-read - vec - (format "%s -g%s %s" - (tramp-get-remote-id vec) - (if (equal id-format 'integer) "" "n") - (if (equal id-format 'integer) - "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/"))))) - ;; The command might not always return a number. - (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) - -(defun tramp-get-local-uid (id-format) - (if (equal id-format 'integer) (user-uid) (user-login-name))) - -(defun tramp-get-local-gid (id-format) - (nth 3 (tramp-compat-file-attributes "~/" id-format))) - -;; Some predefined connection properties. -(defun tramp-get-inline-compress (vec prop size) - "Return the compress command related to PROP. -PROP is either `inline-compress' or `inline-decompress'. SIZE is -the length of the file to be compressed. - -If no corresponding command is found, nil is returned." - (when (and (integerp tramp-inline-compress-start-size) - (> size tramp-inline-compress-start-size)) - (with-connection-property vec prop - (tramp-find-inline-compress vec) - (tramp-get-connection-property vec prop nil)))) - -(defun tramp-get-inline-coding (vec prop size) - "Return the coding command related to PROP. -PROP is either `remote-encoding', `remode-decoding', -`local-encoding' or `local-decoding'. - -SIZE is the length of the file to be coded. Depending on SIZE, -compression might be applied. - -If no corresponding command is found, nil is returned. -Otherwise, either a string is returned which contains a `%s' mark -to be used for the respective input or output file; or a Lisp -function cell is returned to be applied on a buffer." - (let ((coding - (with-connection-property vec prop - (tramp-find-inline-encoding vec) - (tramp-get-connection-property vec prop nil))) - (prop1 (if (string-match "encoding" prop) - "inline-compress" "inline-decompress")) - compress) - ;; The connection property might have been cached. So we must send - ;; the script to the remote side - maybe. - (when (and coding (symbolp coding) (string-match "remote" prop)) - (let ((name (symbol-name coding))) - (while (string-match (regexp-quote "-") name) - (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value coding) name) - (setq coding name))) - (when coding - ;; Check for the `compress' command. - (setq compress (tramp-get-inline-compress vec prop1 size)) - ;; Return the value. - (cond - ((and compress (symbolp coding)) - (if (string-match "decompress" prop1) - `(lambda (beg end) - (,coding beg end) - (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary)) - (apply - 'call-process-region (point-min) (point-max) - (car (split-string ,compress)) t t nil - (cdr (split-string ,compress))))) - `(lambda (beg end) - (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary)) - (apply - 'call-process-region beg end - (car (split-string ,compress)) t t nil - (cdr (split-string ,compress)))) - (,coding (point-min) (point-max))))) - ((symbolp coding) - coding) - ((and compress (string-match "decoding" prop)) - (format "(%s | %s >%%s)" coding compress)) - (compress - (format "(%s <%%s | %s)" compress coding)) - ((string-match "decoding" prop) - (format "%s >%%s" coding)) - (t - (format "%s <%%s" coding)))))) - (defun tramp-get-method-parameter (method param) "Return the method parameter PARAM. If the `tramp-methods' entry does not exist, return nil." @@ -8632,27 +2908,26 @@ "Check, whether OPERATION runs a file name handler." ;; The file name handler is determined on base of either an ;; argument, `buffer-file-name', or `default-directory'. - (condition-case nil - (let* ((buffer-file-name "/") - (default-directory "/") - (fnha file-name-handler-alist) - (check-file-name-operation operation) - (file-name-handler-alist - (list - (cons "/" - (lambda (operation &rest args) - "Returns OPERATION if it is the one to be checked." - (if (equal check-file-name-operation operation) - operation - (let ((file-name-handler-alist fnha)) - (apply operation args)))))))) - (equal (apply operation args) operation)) - (error nil))) + (ignore-errors + (let* ((buffer-file-name "/") + (default-directory "/") + (fnha file-name-handler-alist) + (check-file-name-operation operation) + (file-name-handler-alist + (list + (cons "/" + (lambda (operation &rest args) + "Returns OPERATION if it is the one to be checked." + (if (equal check-file-name-operation operation) + operation + (let ((file-name-handler-alist fnha)) + (apply operation args)))))))) + (equal (apply operation args) operation)))) (unless (tramp-exists-file-name-handler 'make-auto-save-file-name) (defadvice make-auto-save-file-name (around tramp-advice-make-auto-save-file-name () activate) - "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files." + "Invoke `tramp-*-handle-make-auto-save-file-name' for Tramp files." (if (tramp-tramp-file-p (buffer-file-name)) ;; We cannot call `tramp-handle-make-auto-save-file-name' ;; directly, because this would bypass the locking mechanism. @@ -8682,8 +2957,9 @@ ;; Permissions should be set always, because there might be an old ;; auto-saved file belonging to another original file. This could ;; be a security threat. - (set-file-modes buffer-auto-save-file-name - (or (file-modes bfn) (tramp-octal-to-decimal "0600")))))) + (set-file-modes + buffer-auto-save-file-name + (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600")))))) (unless (and (featurep 'xemacs) (= emacs-major-version 21) @@ -8787,7 +3063,6 @@ (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." - ;; Pacify byte-compiler with `symbol-function'. (cond ((and (fboundp 'subtract-time) (fboundp 'float-time)) (tramp-compat-funcall @@ -8863,6 +3138,7 @@ ;; CCC: This function should be rewritten so that ;; `shell-quote-argument' is not used. This way, we are safe from ;; changes in `shell-quote-argument'. +;;;###tramp-autoload (defun tramp-shell-quote-argument (s) "Similar to `shell-quote-argument', but groks newlines. Only works for Bourne-like shells." @@ -8888,112 +3164,42 @@ (defun tramp-unload-tramp () "Discard Tramp from loading remote files." (interactive) - ;; When Tramp is not loaded yet, its autoloads are still active. - (tramp-unload-file-name-handlers) ;; ange-ftp settings must be enabled. (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp) - ;; Maybe its not loaded yet. - (condition-case nil - (unload-feature 'tramp 'force) - (error nil))) - -(when (and load-in-progress - (string-match "Loading tramp..." (or (current-message) ""))) - (message "Loading tramp...done")) + ;; Maybe it's not loaded yet. + (ignore-errors (unload-feature 'tramp 'force))) (provide 'tramp) ;;; TODO: -;; * Handle nonlocal exits such as C-g. -;; * But it would probably be better to use with-local-quit at the -;; place where it's actually needed: around any potentially -;; indefinitely blocking piece of code. In this case it would be -;; within Tramp around one of its calls to accept-process-output (or -;; around one of the loops that calls accept-process-output) -;; (Stefan Monnier). ;; * Rewrite `tramp-shell-quote-argument' to abstain from using ;; `shell-quote-argument'. ;; * In Emacs 21, `insert-directory' shows total number of bytes used ;; by the files in that directory. Add this here. ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) -;; * Don't use globbing for directories with many files, as this is -;; likely to produce long command lines, and some shells choke on -;; long command lines. -;; * How to deal with MULE in `insert-file-contents' and `write-region'? ;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) -;; * Remove unneeded parameters from methods. -;; * Make it work for different encodings, and for different file name -;; encodings, too. (Daniel Pittman) -;; * Don't search for perl5 and perl. Instead, only search for perl and -;; then look if it's the right version (with `perl -v'). -;; * When editing a remote CVS controlled file as a different user, VC -;; gets confused about the file locking status. Try to find out why -;; the workaround doesn't work. ;; * Username and hostname completion. ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'. ;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'. ;; Code is nearly identical. -;; * Allow out-of-band methods as _last_ multi-hop. Open a connection -;; until the last but one hop via `start-file-process'. Apply it -;; also for ftp and smb. -;; * WIBNI if we had a command "trampclient"? If I was editing in -;; some shell with root priviledges, it would be nice if I could -;; just call -;; trampclient filename.c -;; as an editor, and the _current_ shell would connect to an Emacs -;; server and would be used in an existing non-priviledged Emacs -;; session for doing the editing in question. -;; That way, I need not tell Emacs my password again and be afraid -;; that it makes it into core dumps or other ugly stuff (I had Emacs -;; once display a just typed password in the context of a keyboard -;; sequence prompt for a question immediately following in a shell -;; script run within Emacs -- nasty). -;; And if I have some ssh session running to a different computer, -;; having the possibility of passing a local file there to a local -;; Emacs session (in case I can arrange for a connection back) would -;; be nice. -;; Likely the corresponding Tramp server should not allow the -;; equivalent of the emacsclient -eval option in order to make this -;; reasonably unproblematic. And maybe trampclient should have some -;; way of passing credentials, like by using an SSL socket or -;; something. (David Kastrup) -;; * Reconnect directly to a compliant shell without first going -;; through the user's default shell. (Pete Forman) ;; * Make `tramp-default-user' obsolete. -;; * How can I interrupt the remote process with a signal -;; (interrupt-process seems not to work)? (Markus Triska) -;; * Avoid the local shell entirely for starting remote processes. If -;; so, I think even a signal, when delivered directly to the local -;; SSH instance, would correctly be propagated to the remote process -;; automatically; possibly SSH would have to be started with -;; "-t". (Markus Triska) -;; * It makes me wonder if tramp couldn't fall back to ssh when scp -;; isn't on the remote host. (Mark A. Hershberger) -;; * Use lsh instead of ssh. (Alfred M. Szmidt) ;; * Implement a general server-local-variable mechanism, as there are ;; probably other variables that need different values for different ;; servers too. The user could then configure a variable (such as ;; tramp-server-local-variable-alist) to define any such variables ;; that they need to, which would then be let bound as appropriate ;; in tramp functions. (Jason Rumney) -;; * Optimize out-of-band copying, when both methods are scp-like (not -;; rsync). -;; * Keep a second connection open for out-of-band methods like scp or -;; rsync. ;; * IMHO, it's a drawback that currently Tramp doesn't support ;; Unicode in Dired file names by default. Is it possible to ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705) -;; * Try telnet+curl as new method. It might be useful for busybox, -;; without built-in uuencode/uudecode. ;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. ;; * I was wondering it it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like
--- a/lisp/net/trampver.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/net/trampver.el Thu Sep 16 11:11:13 2010 +0900 @@ -31,16 +31,29 @@ ;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; ;; should be changed only there. -(defconst tramp-version "2.1.19" +;;;###tramp-autoload +(defconst tramp-version "2.2.0-pre" "This version of Tramp.") +;;;###tramp-autoload (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") ;; Check for (X)Emacs version. -(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) +(let ((x (if (or (>= emacs-major-version 22) + (and (featurep 'xemacs) + (= emacs-major-version 21) + (>= emacs-minor-version 4))) + "ok" + (format "Tramp 2.2.0-pre is not fit for %s" + (when (string-match "^.*$" (emacs-version)) + (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'trampver 'force))) + (provide 'trampver) ;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1
--- a/lisp/notifications.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/notifications.el Thu Sep 16 11:11:13 2010 +0900 @@ -42,6 +42,9 @@ (require 'dbus) +(defconst notifications-specification-version "1.1" + "The version of the Desktop Notifications Specification implemented.") + (defconst notifications-application-name "Emacs" "Default application name.") @@ -151,7 +154,14 @@ :image-data This is a raw data image format which describes the width, height, rowstride, has alpha, bits per sample, channels and image data respectively. + :image-path This is represented either as a URI (file:// is the + only URI schema supported right now) or a name + in a freedesktop.org-compliant icon theme. :sound-file The path to a sound file to play when the notification pops up. + :sound-name A themeable named sound from the freedesktop.org sound naming + specification to play when the notification pops up. + Similar to icon-name,only for sounds. An example would + be \"message-new-instant\". :suppress-sound Causes the server to suppress playing any sounds, if it has that ability. :x Specifies the X location on the screen that the notification @@ -186,7 +196,9 @@ (category (plist-get params :category)) (desktop-entry (plist-get params :desktop-entry)) (image-data (plist-get params :image-data)) + (image-path (plist-get params :image-path)) (sound-file (plist-get params :sound-file)) + (sound-name (plist-get params :sound-name)) (suppress-sound (plist-get params :suppress-sound)) (x (plist-get params :x)) (y (plist-get params :y)) @@ -211,10 +223,18 @@ (add-to-list 'hints `(:dict-entry "image_data" (:variant :struct ,image-data)) t)) + (when image-path + (add-to-list 'hints `(:dict-entry + "image_path" + (:variant :string ,image-path)) t)) (when sound-file (add-to-list 'hints `(:dict-entry "sound-file" (:variant :string ,sound-file)) t)) + (when sound-name + (add-to-list 'hints `(:dict-entry + "sound-name" + (:variant :string ,sound-name)) t)) (when suppress-sound (add-to-list 'hints `(:dict-entry "suppress-sound"
--- a/lisp/nxml/TODO Thu Sep 16 10:51:56 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,468 +0,0 @@ -* High priority - -** Command to insert an element template, including all required -attributes and child elements. When there's a choice of elements -possible, we could insert a comment, and put an overlay on that -comment that makes it behave like a button with a pop-up menu to -select the appropriate choice. - -** Command to tag a region. With a schema should complete using legal -tags, but should work without a schema as well. - -** Provide a way to conveniently rename an element. With a schema should -complete using legal tags, but should work without a schema as well. - -* Outlining - -** Implement C-c C-o C-q. - -** Install pre/post command hook for moving out of invisible section. - -** Put a modify hook on invisible sections that expands them. - -** Integrate dumb folding somehow. - -** An element should be able to be its own heading. - -** Optimize to avoid complete buffer scan on each command. - -** Make it work with HTML-style headings (i.e. level indicated by -name of heading element rather than depth of section nesting). - -** Recognize root element as a section provided it has a title, even -if it doesn't match section-element-name-regex. - -** Support for incremental search automatically making hidden text -visible. - -** Allow title to be an attribute. - -** Command that says to recognize the tag at point as a section/heading. - -** Explore better ways to determine when an element is a section -or a heading. - -** rng-next-error needs to either ignore invisible portion or reveal it -(maybe use isearch oriented text properties). - -** Errors within hidden section should be highlighted by underlining the -ellipsis. - -** Make indirect buffers work. - -** How should nxml-refresh outline recover from non well-formed tags? - -** Hide tags in title elements? - -** Use overlays instead of text properties for holding outline state? -Necessary for indirect buffers to work? - -** Allow an outline to go in the speedbar. - -** Split up outlining manual section into subsections. - -** More detail in the manual about each outlining command. - -** More menu entries for hiding/showing? - -** Indication of many lines have been hidden? - -* Locating schemas - -** Should rng-validate-mode give the user an opportunity to specify a -schema if there is currently none? Or should it at least give a hint -to the user how to specify a non-vacuous schema? - -** Support for adding new schemas to schema-locating files. Add -documentElement and namespace elements. - -** C-c C-w should be able to report current type id. - -** Implement doctypePublicId. - -** Implement typeIdBase. - -** Implement typeIdProcessingInstruction. - -** Support xml:base. - -** Implement group. - -** Find preferred prefix from schema-locating files. Get rid of -rng-preferred-prefix-alist. - -** Inserting document element with vacuous schema should complete using -document elements declared in schema locating files, and set schema -appropriately. - -** Add a ruleType attribute to the <include> element? - -** Allow processing instruction in prolog to contain the compact syntax -schema directly. - -** Use RDDL to locate a schema based on the namespace URI. - -** Should not prompt to add redundant association to schema locating -file. - -** Command to reload current schema. - -* Schema-sensitive features - -** Should filter dynamic markup possibilities using schema validity, by -adding hook to nxml-mode. - -** Dynamic markup word should (at least optionally) be able to look in -other buffers that are using nxml-mode. - -** Should clicking on Invalid move to next error if already on an error? - -** Take advantage of a:documentation. Needs change to schema format. - -** Provide feasible validation (as in Jing) toggle. - -** Save the validation state as a property on the error overlay to enable -more detailed diagnosis. - -** Provide an Error Summary buffer showing all the validation errors. - -** Pop-up menu. What is useful? Tag a region (should be greyed out if -the region is not balanced). Suggestions based on error messages. - -** Have configurable list of namespace URIs so that we can provide -namespace URI completion on extension elements or with schema-less -documents. - -** Allow validation to handle XInclude. - -** ID/IDREF support. - -* Completion - -** Make it work with icomplete. Only use a function to complete when -some of the possible names have undeclared namespaces. - -** How should C-return in mixed text work? - -** When there's a vacuous schema, C-return after < will insert the -end-tag. Is this a bug or a feature? - -** After completing start-tag, ensure we don't get unhelpful message -from validation - -** Syntax table for completion. - -** Should complete start-tag name with a space if namespace attributes -are required. - -** When completing start-tag name with no prefix and it doesn't match -should try to infer namespace from local name. - -** Should completion pay attention to characters after point? If so, -how? - -** When completing start-tag name, add required atts if only one required -attribute. - -** When completing attribute name, add attribute value if only one value -is possible. - -** After attribute-value completion, insert space after close delimiter -if more attributes are required. - -** Complete on enumerated data values in elements. - -** When in context that allows only elements, should get tag -completion without having to type < first. - -** When immediately after start-tag name, and name is valid and not -prefix of any other name, should C-return complete on attribute names? - -** When completing attributes, more consistent to ignore all attributes -after point. - -** Inserting attribute value completions needs to be sensitive to what -delimiter is used so that it quotes the correct character. - -** Complete on encoding-names in XML decl. - -** Complete namespace declarations by searching for all namespaces -mentioned in the schema. - -* Well-formed XML support - -** Deal better with Mule-UCS - -** Deal with UTF-8 BOM when reading. - -** Complete entity names. - -** Provide some support for entity names for MathML. - -** Command to repeat the last tag. - -** Support for changing between character references and characters. -Need to check that context is one in which character references are -allowed. xmltok prolog parsing will need to distinguish parameter -literals from other kinds of literal. - -** Provide a comment command to bind to M-; that works better than the -normal one. - -** Make indenting in a multi-line comment work. - -** Structure view. Separate buffer displaying element tree. Be able to -navigate from structure view to document and vice-versa. - -** Flash matching >. - -** Smart selection command that selects increasingly large syntactically -coherent chunks of XML. If point is in an attribute value, first -select complete value; then if command is repeated, select value plus -delimiters, then select attribute name as well, then complete -start-tag, then complete element, then enclosing element, etc. - -** ispell integration. - -** Block-level items in mixed content should be indented, e.g: - <para>This is list: - <ul> - <li>item</li> - -** Provide option to indent like this: - -** <para>This is a paragraph - occupying multiple lines.</para> - -** Option to add make a / that closes a start-tag electrically insert a -space for the XHTML guys. - -** C-M-q should work. - -* Datatypes - -** Figure out workaround for CJK characters with regexps. - -** Does category C contain Cn? - -** Do ENTITY datatype properly. - -* XML Parsing Library - -** Parameter entity parsing option, nil (never), t (always), -unless-standalone (unless standalone="yes" in XML declaration). - -** When a file is currently being edited, there should be an option to -use its buffer instead of the on-disk copy. - -* Handling all XML features - -** Provide better support for editing external general parsed entities. -Perhaps provide a way to force ignoring undefined entities; maybe turn -this on automatically with <?xml encoding=""?> (with no version -pseudo-att). - -** Handle internal general entity declarations containing elements. - -** Handle external general entity declarations. - -** Handle default attribute declarations in internal subset. - -** Handle parameter entities (including DTD). - -* RELAX NG - -** Do complete schema checking, at least optionally. - -** Detect include/external loops during schema parse. - -** Coding system detection for schemas. Should use utf-8/utf-16 per the -spec. But also need to allow encodings other than UTF-8/16 to support -CJK charsets that Emacs cannot represent in Unicode. - -* Catching XML errors - -** Check public identifiers. - -** Check default attribute values. - -* Performance - -** Explore whether overlay-recenter can cure overlays performance -problems. - -** Cache schemas. Need to have list of files and mtimes. - -** Make it possible to reduce rng-validate-chunk-size significantly, -perhaps to 500 bytes, without bad performance impact: don't do -redisplay on every chunk; pass continue functions on other uses of -rng-do-some-validation. - -** Cache after first tag. - -** Introduce a new name class that is a choice between names (so that -we can use member) - -** intern-choice should simplify after patterns with same 1st/2nd args - -** Large numbers of overlays slow things down dramatically. Represent -errors using text properties. This implies we cannot incrementally -keep track of the number of errors, in order to determine validity. -Instead, when validation completes, scan for any characters with an -error text property; this seems to be fast enough even with large -buffers. Problem with error at end of buffer, where there's no -character; need special variable for this. Need to merge face from -font-lock with the error face: use :inherit attribute with list of two -faces. How do we avoid making rng-valid depend on nxml-mode? - -* Error recovery - -** Don't stop at newline in looking for close of start-tag. - -** Use indentation to guide recovery from mismatched end-tags - -** Don't keep parsing when currently not well-formed but previously -well-formed - -** Try to recover from a bad start-tag by popping an open element if -there was a mismatched end-tag unaccounted for. - -** Try to recover from a bad start-tag open on the hypothesis that there -was an error in the namespace URI. - -** Better recovery from ill-formed XML declarations. - -* Useability improvements - -** Should print a "Parsing..." message during long movements. - -** Provide better position for reference to undefined pattern error. - -** Put Well-formed in the mode-line when validating against any-content. - -** Trim marking of illegal data for leading and trailing whitespace. - -** Show Invalid status as soon as we are sure it's invalid, rather than -waiting for everything to be completely up to date. - -** When narrowed, Valid or Invalid status should probably consider only -validity of narrowed region. - -* Bug fixes - -** Need to give an error for a document like: <foo/><![CDATA[ ]]> - -** Make nxml-forward-balanced-item work better for the prolog. - -** Make filling and indenting comments work in the prolog. - -** Should delete RNC Input buffers. - -** Figure out what regex use for NCName and use it consistently, - -** Should have not-well-formed tokens in ref. - -** Require version in XML declaration? Probably not because prevents -use for external parsed entities. At least forbid standalone -without version. - -** Reject schema that compiles to rng-not-allowed-ipattern. - -** Move point backwards on schema parse error so that it's on the right token. - -* Internal - -** Use rng-quote-string consistently. - -** Use parsing library for XML to texinfo conversion. - -** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of -xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to -nxml-t-token-start. - -** Can we set fill-prefix to nil and rely on indenting? - -** xmltok should make available replacement text of entities containing -elements - -** In rng-valid, instead of using modification-hooks and -insert-behind-hooks on dependent overlays, use same technique as -nxml-mode. - -** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on -Mule-UCS); overlays/text properties vs extents; absence of -fontification-functions hook. - -* Fontification - -** Allow face to depend on element qname, attribute qname, attribute -value. Use list with pairs of (R . F), where R specifies regexps and -F specifies faces. How can this list be made to depend on the -document type? - -* Other - -** Support RELAX NG XML syntax (use XML parsing library). - -** Support W3C XML Schema (use XML parsing library). - -** Command to infer schema from current document (like trang). - -* Schemas - -** XSLT schema should take advantage of RELAX NG to express cooccurrence -constraints on attributes (e.g. xsl:template). - -* Documentation - -** Move material from README to manual. - -** Document encodings. - -* Notes - -** How can we allow an error to be displayed on a different token from -where it is detected? In particular, for a missing closing ">" we -will need to display it at the beginning of the following token. At -the moment, when we parse the following token the error overlay will -get cleared. - -** How should rng-goto-next-error deal with narrowing? - -** Perhaps should merge errors having same start position even if they -have different ends. - -** How to handle surrogates? One possibility is to be compatible with -utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible -with this. - -** Should we distinguish well-formedness errors from invalidity errors? -(I think not: we may want to recover from a bad start-tag by implying -an end-tag.) - -** Seems to be a bug with Emacs, where a mouse movement that causes -help-echo text to appear counts as pending input but does not cause -idle timer to be restarted. - -** Use XML to represent this file. - -** I had a TODO which said simply "split-string". What did I mean? - -** Investigate performance on large files all on one line. - -* Issues for Emacs versions >= 22 - -** Take advantage of UTF-8 CJK support. - -** Supply a next-error-function. - -** Investigate this NEWS item "Emacs now tries to set up buffer coding -systems for HTML/XML files automatically." - -** Take advantage of the pointer text property. - -** Leverage char-displayable-p. - -Local variables: -mode: outline -end:
--- a/lisp/obsolete/old-whitespace.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/obsolete/old-whitespace.el Thu Sep 16 11:11:13 2010 +0900 @@ -788,7 +788,7 @@ (defun whitespace-unload-function () "Unload the whitespace library." - (if (unintern "whitespace-unload-hook") + (if (unintern "whitespace-unload-hook" obarray) ;; if whitespace-unload-hook is defined, let's get rid of it ;; and recursively call `unload-feature' (progn (unload-feature 'whitespace) t)
--- a/lisp/progmodes/ada-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/ada-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -834,10 +834,7 @@ ;; ;; On Emacs, this is done through the `syntax-table' text property. The ;; corresponding action is applied automatically each time the buffer -;; changes. If `font-lock-mode' is enabled (the default) the action is -;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it -;; manually in `ada-after-change-function'. The proper method is -;; installed by `ada-handle-syntax-table-properties'. +;; changes via syntax-propertize-function. ;; ;; on XEmacs, the `syntax-table' property does not exist and we have to use a ;; slow advice to `parse-partial-sexp' to do the same thing. @@ -937,6 +934,12 @@ (insert (caddar change)) (setq change (cdr change))))))) +(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table + ;; properties, and in some cases we even had to do it manually (in + ;; `ada-after-change-function'). `ada-handle-syntax-table-properties' + ;; decides which method to use. + (defun ada-set-syntax-table-properties () "Assign `syntax-table' properties in accessible part of buffer. In particular, character constants are said to be strings, #...# @@ -991,6 +994,8 @@ ;; Take care of `syntax-table' properties manually. (ada-initialize-syntax-table-properties))) +) ;;(not (fboundp 'syntax-propertize)) + ;;------------------------------------------------------------------ ;; Testing the grammatical context ;;------------------------------------------------------------------ @@ -1118,7 +1123,8 @@ ;;;###autoload (defun ada-mode () - "Ada mode is the major mode for editing Ada code." + "Ada mode is the major mode for editing Ada code. +\\{ada-mode-map}" (interactive) (kill-all-local-variables) @@ -1161,9 +1167,9 @@ (set (make-local-variable 'comment-padding) 0) (set (make-local-variable 'parse-sexp-lookup-properties) t)) - (set 'case-fold-search t) + (setq case-fold-search t) (if (boundp 'imenu-case-fold-search) - (set 'imenu-case-fold-search t)) + (setq imenu-case-fold-search t)) (set (make-local-variable 'fill-paragraph-function) 'ada-fill-comment-paragraph) @@ -1186,8 +1192,13 @@ '(ada-font-lock-keywords nil t ((?\_ . "w") (?# . ".")) - beginning-of-line - (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) + beginning-of-line)) + + (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords)) + (set (make-local-variable 'font-lock-syntactic-keywords) + ada-font-lock-syntactic-keywords)) ;; Set up support for find-file.el. (set (make-local-variable 'ff-other-file-alist) @@ -1322,22 +1333,24 @@ ;; To be run after the hook, in case the user modified ;; ada-fill-comment-prefix - (make-local-variable 'comment-start) - (if ada-fill-comment-prefix - (set 'comment-start ada-fill-comment-prefix) - (set 'comment-start "-- ")) + ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs + ;; then it was already available before running the hook, and if he + ;; modifies it in the hook, he might as well modify comment-start instead. + (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- ")) ;; Run this after the hook to give the users a chance to activate ;; font-lock-mode - (unless (featurep 'xemacs) + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) (ada-initialize-syntax-table-properties) (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) ;; the following has to be done after running the ada-mode-hook ;; because users might want to set the values of these variable ;; inside the hook - + ;; FIXME: it might even be set later on via file-local vars, no? + ;; so maybe ada-keywords should be set lazily. (cond ((eq ada-language-version 'ada83) (setq ada-keywords ada-83-keywords)) ((eq ada-language-version 'ada95) @@ -1397,25 +1410,21 @@ The new word is added to the first file in `ada-case-exception-file'. The standard casing rules will no longer apply to this word." (interactive) - (let ((previous-syntax-table (syntax-table)) - file-name - ) - - (cond ((stringp ada-case-exception-file) - (setq file-name ada-case-exception-file)) - ((listp ada-case-exception-file) - (setq file-name (car ada-case-exception-file))) - (t - (error (concat "No exception file specified. " - "See variable ada-case-exception-file")))) - - (set-syntax-table ada-mode-symbol-syntax-table) + (let ((file-name + (cond ((stringp ada-case-exception-file) + ada-case-exception-file) + ((listp ada-case-exception-file) + (car ada-case-exception-file)) + (t + (error (concat "No exception file specified. " + "See variable ada-case-exception-file")))))) + (unless word - (save-excursion - (skip-syntax-backward "w") - (setq word (buffer-substring-no-properties - (point) (save-excursion (forward-word 1) (point)))))) - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (skip-syntax-backward "w") + (setq word (buffer-substring-no-properties + (point) (save-excursion (forward-word 1) (point))))))) ;; Reread the exceptions file, in case it was modified by some other, (ada-case-read-exceptions-from-file file-name) @@ -1425,11 +1434,9 @@ (if (and (not (equal ada-case-exception '())) (assoc-string word ada-case-exception t)) (setcar (assoc-string word ada-case-exception t) word) - (add-to-list 'ada-case-exception (cons word t)) - ) - - (ada-save-exceptions-to-file file-name) - )) + (add-to-list 'ada-case-exception (cons word t))) + + (ada-save-exceptions-to-file file-name))) (defun ada-create-case-exception-substring (&optional word) "Define the substring WORD as an exception for the casing system. @@ -1464,7 +1471,7 @@ (modify-syntax-entry ?_ "." (syntax-table)) (save-excursion (skip-syntax-backward "w") - (set 'word (buffer-substring-no-properties + (setq word (buffer-substring-no-properties (point) (save-excursion (forward-word 1) (point)))))) (modify-syntax-entry ?_ (make-string 1 underscore-syntax) @@ -1633,37 +1640,30 @@ (interactive "P") (if ada-auto-case - (let ((lastk last-command-event) - (previous-syntax-table (syntax-table))) - - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - (cond ((or (eq lastk ?\n) - (eq lastk ?\r)) - ;; horrible kludge - (insert " ") - (ada-adjust-case) - ;; horrible dekludge - (delete-char -1) - ;; some special keys and their bindings - (cond - ((eq lastk ?\n) - (funcall ada-lfd-binding)) - ((eq lastk ?\r) - (funcall ada-ret-binding)))) - ((eq lastk ?\C-i) (ada-tab)) - ;; Else just insert the character - ((self-insert-command (prefix-numeric-value arg)))) - ;; if there is a keyword in front of the underscore - ;; then it should be part of an identifier (MH) - (if (eq lastk ?_) - (ada-adjust-case t) - (ada-adjust-case)) - ) - ;; Restore the syntax table - (set-syntax-table previous-syntax-table)) - ) + (let ((lastk last-command-event)) + + (with-syntax-table ada-mode-symbol-syntax-table + (cond ((or (eq lastk ?\n) + (eq lastk ?\r)) + ;; horrible kludge + (insert " ") + (ada-adjust-case) + ;; horrible dekludge + (delete-char -1) + ;; some special keys and their bindings + (cond + ((eq lastk ?\n) + (funcall ada-lfd-binding)) + ((eq lastk ?\r) + (funcall ada-ret-binding)))) + ((eq lastk ?\C-i) (ada-tab)) + ;; Else just insert the character + ((self-insert-command (prefix-numeric-value arg)))) + ;; if there is a keyword in front of the underscore + ;; then it should be part of an identifier (MH) + (if (eq lastk ?_) + (ada-adjust-case t) + (ada-adjust-case)))) ;; Else, no auto-casing (cond @@ -1672,10 +1672,10 @@ ((eq last-command-event ?\r) (funcall ada-ret-binding)) (t - (self-insert-command (prefix-numeric-value arg)))) - )) + (self-insert-command (prefix-numeric-value arg)))))) (defun ada-activate-keys-for-case () + ;; FIXME: Use post-self-insert-hook instead of changing key bindings. "Modify the key bindings for all the keys that should readjust the casing." (interactive) ;; Save original key-bindings to allow swapping ret/lfd @@ -1735,44 +1735,41 @@ (let ((begin nil) (end nil) (keywordp nil) - (attribp nil) - (previous-syntax-table (syntax-table))) + (attribp nil)) (message "Adjusting case ...") - (unwind-protect - (save-excursion - (set-syntax-table ada-mode-symbol-syntax-table) - (goto-char to) - ;; - ;; loop: look for all identifiers, keywords, and attributes - ;; - (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) - (setq end (match-end 1)) - (setq attribp - (and (> (point) from) - (save-excursion - (forward-char -1) - (setq attribp (looking-at "'.[^']"))))) - (or - ;; do nothing if it is a string or comment - (ada-in-string-or-comment-p) - (progn - ;; - ;; get the identifier or keyword or attribute - ;; - (setq begin (point)) - (setq keywordp (looking-at ada-keywords)) - (goto-char end) - ;; - ;; casing according to user-option - ;; - (if attribp - (funcall ada-case-attribute -1) - (if keywordp - (funcall ada-case-keyword -1) - (ada-adjust-case-identifier))) - (goto-char begin)))) - (message "Adjusting case ... Done")) - (set-syntax-table previous-syntax-table)))) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (goto-char to) + ;; + ;; loop: look for all identifiers, keywords, and attributes + ;; + (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) + (setq end (match-end 1)) + (setq attribp + (and (> (point) from) + (save-excursion + (forward-char -1) + (setq attribp (looking-at "'.[^']"))))) + (or + ;; do nothing if it is a string or comment + (ada-in-string-or-comment-p) + (progn + ;; + ;; get the identifier or keyword or attribute + ;; + (setq begin (point)) + (setq keywordp (looking-at ada-keywords)) + (goto-char end) + ;; + ;; casing according to user-option + ;; + (if attribp + (funcall ada-case-attribute -1) + (if keywordp + (funcall ada-case-keyword -1) + (ada-adjust-case-identifier))) + (goto-char begin)))) + (message "Adjusting case ... Done"))))) (defun ada-adjust-case-buffer () "Adjust the case of all words in the whole buffer. @@ -1803,46 +1800,39 @@ (let ((begin nil) (end nil) (delend nil) - (paramlist nil) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - ;; check if really inside parameter list - (or (ada-in-paramlist-p) - (error "Not in parameter list")) - - ;; find start of current parameter-list - (ada-search-ignore-string-comment - (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) - (down-list 1) - (backward-char 1) - (setq begin (point)) - - ;; find end of parameter-list - (forward-sexp 1) - (setq delend (point)) - (delete-char -1) - (insert "\n") - - ;; find end of last parameter-declaration - (forward-comment -1000) - (setq end (point)) - - ;; build a list of all elements of the parameter-list - (setq paramlist (ada-scan-paramlist (1+ begin) end)) - - ;; delete the original parameter-list - (delete-region begin delend) - - ;; insert the new parameter-list - (goto-char begin) - (ada-insert-paramlist paramlist)) - - ;; restore syntax-table - (set-syntax-table previous-syntax-table) - ))) + (paramlist nil)) + (with-syntax-table ada-mode-symbol-syntax-table + + ;; check if really inside parameter list + (or (ada-in-paramlist-p) + (error "Not in parameter list")) + + ;; find start of current parameter-list + (ada-search-ignore-string-comment + (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) + (down-list 1) + (backward-char 1) + (setq begin (point)) + + ;; find end of parameter-list + (forward-sexp 1) + (setq delend (point)) + (delete-char -1) + (insert "\n") + + ;; find end of last parameter-declaration + (forward-comment -1000) + (setq end (point)) + + ;; build a list of all elements of the parameter-list + (setq paramlist (ada-scan-paramlist (1+ begin) end)) + + ;; delete the original parameter-list + (delete-region begin delend) + + ;; insert the new parameter-list + (goto-char begin) + (ada-insert-paramlist paramlist)))) (defun ada-scan-paramlist (begin end) "Scan the parameter list found in between BEGIN and END. @@ -2186,14 +2176,12 @@ Return the calculation that was done, including the reference point and the offset." (interactive) - (let ((previous-syntax-table (syntax-table)) - (orgpoint (point-marker)) + (let ((orgpoint (point-marker)) cur-indent tmp-indent prev-indent) (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table ;; This need to be done here so that the advice is not always ;; activated (this might interact badly with other modes) @@ -2203,14 +2191,14 @@ (save-excursion (setq cur-indent - ;; Not First line in the buffer ? - (if (save-excursion (zerop (forward-line -1))) - (progn - (back-to-indentation) - (ada-get-current-indent)) - - ;; first line in the buffer - (list (point-min) 0)))) + ;; Not First line in the buffer ? + (if (save-excursion (zerop (forward-line -1))) + (progn + (back-to-indentation) + (ada-get-current-indent)) + + ;; first line in the buffer + (list (point-min) 0)))) ;; Evaluate the list to get the column to indent to ;; prev-indent contains the column to indent to @@ -2242,14 +2230,10 @@ (if (< (current-column) (current-indentation)) (back-to-indentation))) - ;; restore syntax-table - (set-syntax-table previous-syntax-table) (if (featurep 'xemacs) - (ad-deactivate 'parse-partial-sexp)) - ) - - cur-indent - )) + (ad-deactivate 'parse-partial-sexp))) + + cur-indent)) (defun ada-get-current-indent () "Return the indentation to use for the current line." @@ -2512,11 +2496,11 @@ (if (looking-at "renames") (let (pos) (save-excursion - (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t))) + (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t))) (if (and pos (= (downcase (char-after (car pos))) ?r)) (goto-char (car pos))) - (set 'var 'ada-indent-renames))) + (setq var 'ada-indent-renames))) (forward-comment -1000) (if (= (char-before) ?\)) @@ -2533,7 +2517,7 @@ (looking-at "\\(function\\|procedure\\)\\>")) (progn (backward-word 1) - (set 'num-back 2) + (setq num-back 2) (looking-at "\\(function\\|procedure\\)\\>"))))) ;; The indentation depends of the value of ada-indent-return @@ -4046,8 +4030,7 @@ (let (found begin end - parse-result - (previous-syntax-table (syntax-table))) + parse-result) ;; FIXME: need to pass BACKWARD to search-func! (unless search-func @@ -4057,67 +4040,65 @@ ;; search until found or end-of-buffer ;; We have to test that we do not look further than limit ;; - (set-syntax-table ada-mode-symbol-syntax-table) - (while (and (not found) - (or (not limit) - (or (and backward (<= limit (point))) - (>= limit (point)))) - (funcall search-func search-re limit 1)) - (setq begin (match-beginning 0)) - (setq end (match-end 0)) - - (setq parse-result (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))) - - (cond - ;; - ;; If inside a string, skip it (and the following comments) - ;; - ((ada-in-string-p parse-result) - (if (featurep 'xemacs) - (search-backward "\"" nil t) - (goto-char (nth 8 parse-result))) - (unless backward (forward-sexp 1))) - ;; - ;; If inside a comment, skip it (and the following comments) - ;; There is a special code for comments at the end of the file - ;; - ((ada-in-comment-p parse-result) - (if (featurep 'xemacs) - (progn - (forward-line 1) - (beginning-of-line) - (forward-comment -1)) - (goto-char (nth 8 parse-result))) - (unless backward - ;; at the end of the file, it is not possible to skip a comment - ;; so we just go at the end of the line - (if (forward-comment 1) - (progn - (forward-comment 1000) - (beginning-of-line)) - (end-of-line)))) - ;; - ;; directly in front of a comment => skip it, if searching forward - ;; - ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) - (unless backward (progn (forward-char -1) (forward-comment 1000)))) - - ;; - ;; found a parameter-list but should ignore it => skip it - ;; - ((and (not paramlists) (ada-in-paramlist-p)) - (if backward - (search-backward "(" nil t) - (search-forward ")" nil t))) - ;; - ;; found what we were looking for - ;; - (t - (setq found t)))) ; end of loop - - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (while (and (not found) + (or (not limit) + (or (and backward (<= limit (point))) + (>= limit (point)))) + (funcall search-func search-re limit 1)) + (setq begin (match-beginning 0)) + (setq end (match-end 0)) + + (setq parse-result (parse-partial-sexp + (save-excursion (beginning-of-line) (point)) + (point))) + + (cond + ;; + ;; If inside a string, skip it (and the following comments) + ;; + ((ada-in-string-p parse-result) + (if (featurep 'xemacs) + (search-backward "\"" nil t) + (goto-char (nth 8 parse-result))) + (unless backward (forward-sexp 1))) + ;; + ;; If inside a comment, skip it (and the following comments) + ;; There is a special code for comments at the end of the file + ;; + ((ada-in-comment-p parse-result) + (if (featurep 'xemacs) + (progn + (forward-line 1) + (beginning-of-line) + (forward-comment -1)) + (goto-char (nth 8 parse-result))) + (unless backward + ;; at the end of the file, it is not possible to skip a comment + ;; so we just go at the end of the line + (if (forward-comment 1) + (progn + (forward-comment 1000) + (beginning-of-line)) + (end-of-line)))) + ;; + ;; directly in front of a comment => skip it, if searching forward + ;; + ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) + (unless backward (progn (forward-char -1) (forward-comment 1000)))) + + ;; + ;; found a parameter-list but should ignore it => skip it + ;; + ((and (not paramlists) (ada-in-paramlist-p)) + (if backward + (search-backward "(" nil t) + (search-forward ")" nil t))) + ;; + ;; found what we were looking for + ;; + (t + (setq found t))))) ; end of loop (if found (cons begin end) @@ -4398,122 +4379,109 @@ (defun ada-move-to-start () "Move point to the matching start of the current Ada structure." (interactive) - (let ((pos (point)) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - (save-excursion - ;; - ;; do nothing if in string or comment or not on 'end ...;' - ;; or if an error occurs during processing - ;; - (or - (ada-in-string-or-comment-p) - (and (progn - (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) - (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) - (or (looking-at "[ \t]*\\<end\\>") - (error "Not on end ...;"))) - (ada-goto-matching-start 1) - (setq pos (point)) - - ;; - ;; on 'begin' => go on, according to user option - ;; - ada-move-to-declaration - (looking-at "\\<begin\\>") - (ada-goto-decl-start) - (setq pos (point)))) - - ) ; end of save-excursion - - ;; now really move to the found position - (goto-char pos)) - - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + (let ((pos (point))) + (with-syntax-table ada-mode-symbol-syntax-table + + (save-excursion + ;; + ;; do nothing if in string or comment or not on 'end ...;' + ;; or if an error occurs during processing + ;; + (or + (ada-in-string-or-comment-p) + (and (progn + (or (looking-at "[ \t]*\\<end\\>") + (backward-word 1)) + (or (looking-at "[ \t]*\\<end\\>") + (backward-word 1)) + (or (looking-at "[ \t]*\\<end\\>") + (error "Not on end ...;"))) + (ada-goto-matching-start 1) + (setq pos (point)) + + ;; + ;; on 'begin' => go on, according to user option + ;; + ada-move-to-declaration + (looking-at "\\<begin\\>") + (ada-goto-decl-start) + (setq pos (point)))) + + ) ; end of save-excursion + + ;; now really move to the found position + (goto-char pos)))) (defun ada-move-to-end () "Move point to the end of the block around point. Moves to 'begin' if in a declarative part." (interactive) (let ((pos (point)) - decl-start - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - (save-excursion - - (cond - ;; Go to the beginning of the current word, and check if we are - ;; directly on 'begin' - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\<begin\\>")) - (ada-goto-matching-end 1) - ) - - ;; on first line of subprogram body - ;; Do nothing for specs or generic instantion, since these are - ;; handled as the general case (find the enclosing block) - ;; We also need to make sure that we ignore nested subprograms - ((save-excursion - (and (skip-syntax-backward "w") - (looking-at "\\<function\\>\\|\\<procedure\\>" ) - (ada-search-ignore-string-comment "is\\|;") - (not (= (char-before) ?\;)) - )) - (skip-syntax-backward "w") - (ada-goto-matching-end 0 t)) - - ;; on first line of task declaration - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\<task\\>" ) - (forward-word 1) - (ada-goto-next-non-ws) - (looking-at "\\<body\\>"))) - (ada-search-ignore-string-comment "begin" nil nil nil - 'word-search-forward)) - ;; accept block start - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\<accept\\>" ))) - (ada-goto-matching-end 0)) - ;; package start - ((save-excursion - (setq decl-start (and (ada-goto-decl-start t) (point))) - (and decl-start (looking-at "\\<package\\>"))) - (ada-goto-matching-end 1)) - - ;; On a "declare" keyword - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\<declare\\>")) - (ada-goto-matching-end 0 t)) - - ;; inside a 'begin' ... 'end' block - (decl-start - (goto-char decl-start) - (ada-goto-matching-end 0 t)) - - ;; (hopefully ;-) everything else - (t - (ada-goto-matching-end 1))) - (setq pos (point)) - ) - - ;; now really move to the position found - (goto-char pos)) - - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + decl-start) + (with-syntax-table ada-mode-symbol-syntax-table + + (save-excursion + + (cond + ;; Go to the beginning of the current word, and check if we are + ;; directly on 'begin' + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\<begin\\>")) + (ada-goto-matching-end 1)) + + ;; on first line of subprogram body + ;; Do nothing for specs or generic instantion, since these are + ;; handled as the general case (find the enclosing block) + ;; We also need to make sure that we ignore nested subprograms + ((save-excursion + (and (skip-syntax-backward "w") + (looking-at "\\<function\\>\\|\\<procedure\\>" ) + (ada-search-ignore-string-comment "is\\|;") + (not (= (char-before) ?\;)) + )) + (skip-syntax-backward "w") + (ada-goto-matching-end 0 t)) + + ;; on first line of task declaration + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\<task\\>" ) + (forward-word 1) + (ada-goto-next-non-ws) + (looking-at "\\<body\\>"))) + (ada-search-ignore-string-comment "begin" nil nil nil + 'word-search-forward)) + ;; accept block start + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\<accept\\>" ))) + (ada-goto-matching-end 0)) + ;; package start + ((save-excursion + (setq decl-start (and (ada-goto-decl-start t) (point))) + (and decl-start (looking-at "\\<package\\>"))) + (ada-goto-matching-end 1)) + + ;; On a "declare" keyword + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\<declare\\>")) + (ada-goto-matching-end 0 t)) + + ;; inside a 'begin' ... 'end' block + (decl-start + (goto-char decl-start) + (ada-goto-matching-end 0 t)) + + ;; (hopefully ;-) everything else + (t + (ada-goto-matching-end 1))) + (setq pos (point)) + ) + + ;; now really move to the position found + (goto-char pos)))) (defun ada-next-procedure () "Move point to next procedure." @@ -4818,7 +4786,7 @@ (if (featurep 'xemacs) (progn (define-key ada-mode-map [menu-bar] ada-mode-menu) - (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) + (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) ;; ------------------------------------------------------- @@ -5040,7 +5008,7 @@ (ada-find-src-file-in-dir (file-name-nondirectory (concat name (car suffixes)))))) (if other - (set 'is-spec other))) + (setq is-spec other))) ;; Else search in the current directory (if (file-exists-p (concat name (car suffixes)))
--- a/lisp/progmodes/antlr-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/antlr-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -951,7 +951,7 @@ (3 antlr-keyword-face) (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) antlr-keyword-face - type-face))) + font-lock-type-face))) (,(lambda (limit) (antlr-re-search-forward "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
--- a/lisp/progmodes/autoconf.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/autoconf.el Thu Sep 16 11:11:13 2010 +0900 @@ -43,9 +43,6 @@ (defvar autoconf-mode-hook nil "Hook run by `autoconf-mode'.") -(defconst autoconf-font-lock-syntactic-keywords - '(("\\<dnl\\>" 0 '(11)))) - (defconst autoconf-definition-regexp "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*") @@ -94,8 +91,8 @@ "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") (set (make-local-variable 'comment-start) "dnl ") (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +") - (set (make-local-variable 'font-lock-syntactic-keywords) - autoconf-font-lock-syntactic-keywords) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) (set (make-local-variable 'font-lock-defaults) `(autoconf-font-lock-keywords nil nil (("_" . "w")))) (set (make-local-variable 'imenu-generic-expression)
--- a/lisp/progmodes/cc-engine.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/cc-engine.el Thu Sep 16 11:11:13 2010 +0900 @@ -5449,49 +5449,47 @@ (forward-char) (unless (looking-at c-<-op-cont-regexp) - (while (and + (while (and (progn - (c-forward-syntactic-ws) - (let ((orig-record-found-types c-record-found-types)) - (when (or (and c-record-type-identifiers all-types) - (c-major-mode-is 'java-mode)) - ;; All encountered identifiers are types, so set the - ;; promote flag and parse the type. - (progn - (c-forward-syntactic-ws) - (if (looking-at "\\?") - (forward-char) - (when (looking-at c-identifier-start) - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-type)))) - - (c-forward-syntactic-ws) - - (when (or (looking-at "extends") - (looking-at "super")) - (forward-word) - (c-forward-syntactic-ws) - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-type) - (c-forward-syntactic-ws)))))) - - (setq pos (point)) - - (or - ;; Note: These regexps exploit the match order in \| so - ;; that "<>" is matched by "<" rather than "[^>:-]>". - (c-syntactic-re-search-forward - ;; Stop on ',', '|', '&', '+' and '-' to catch - ;; common binary operators that could be between - ;; two comparison expressions "a<b" and "c>d". - "[<;{},|+&-]\\|[>)]" - nil t t) - t)) - - (cond - ((eq (char-before) ?>) + (c-forward-syntactic-ws) + (let ((orig-record-found-types c-record-found-types)) + (when (or (and c-record-type-identifiers all-types) + (c-major-mode-is 'java-mode)) + ;; All encountered identifiers are types, so set the + ;; promote flag and parse the type. + (progn + (c-forward-syntactic-ws) + (if (looking-at "\\?") + (forward-char) + (when (looking-at c-identifier-start) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type)))) + + (c-forward-syntactic-ws) + + (when (or (looking-at "extends") + (looking-at "super")) + (forward-word) + (c-forward-syntactic-ws) + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-type) + (c-forward-syntactic-ws)))))) + + (setq pos (point)) + + ;; Note: These regexps exploit the match order in \| so + ;; that "<>" is matched by "<" rather than "[^>:-]>". + (c-syntactic-re-search-forward + ;; Stop on ',', '|', '&', '+' and '-' to catch + ;; common binary operators that could be between + ;; two comparison expressions "a<b" and "c>d". + "[<;{},|+&-]\\|[>)]" + nil t t)) + + (cond + ((eq (char-before) ?>) ;; Either an operator starting with '>' or the end of ;; the angle bracket arglist. @@ -5532,14 +5530,14 @@ (when (or (setq keyword-match (looking-at c-opt-<>-sexp-key)) (not (looking-at c-keywords-regexp))) - (setq id-start (point)))) - - (setq subres - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-<>-arglist-recur - (and keyword-match - (c-keyword-member + (setq id-start (point)))) + + (setq subres + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-<>-arglist-recur + (and keyword-match + (c-keyword-member (c-keyword-sym (match-string 1)) 'c-<>-type-kwds))))) ))) @@ -5560,16 +5558,16 @@ (c-forward-syntactic-ws) (looking-at c-opt-identifier-concat-key))) (c-record-ref-id (cons id-start id-end)) - (c-record-type-id (cons id-start id-end)))))) - t) - - ((and (not c-restricted-<>-arglists) - (or (and (eq (char-before) ?&) - (not (eq (char-after) ?&))) - (eq (char-before) ?,))) - ;; Just another argument. Record the position. The - ;; type check stuff that made us stop at it is at - ;; the top of the loop. + (c-record-type-id (cons id-start id-end)))))) + t) + + ((and (not c-restricted-<>-arglists) + (or (and (eq (char-before) ?&) + (not (eq (char-after) ?&))) + (eq (char-before) ?,))) + ;; Just another argument. Record the position. The + ;; type check stuff that made us stop at it is at + ;; the top of the loop. (setq arg-start-pos (cons (point) arg-start-pos))) (t
--- a/lisp/progmodes/cfengine.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/cfengine.el Thu Sep 16 11:11:13 2010 +0900 @@ -83,12 +83,6 @@ ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) -(defconst cfengine-font-lock-syntactic-keywords - ;; In the main syntax-table, backslash is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to recognize - ;; the cases where backslash is used as an escape inside strings. - '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\"))) - (defvar cfengine-imenu-expression `((nil ,(concat "^[ \t]*" (eval-when-compile (regexp-opt cfengine-actions t)) @@ -237,13 +231,15 @@ (set (make-local-variable 'fill-paragraph-function) #'cfengine-fill-paragraph) (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs) - ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of - ;; functions in evaluated classes to string syntax, and then obey - ;; syntax properties. (setq font-lock-defaults - '(cfengine-font-lock-keywords nil nil nil beginning-of-line - (font-lock-syntactic-keywords - . cfengine-font-lock-syntactic-keywords))) + '(cfengine-font-lock-keywords nil nil nil beginning-of-line)) + ;; Fixme: set the args of functions in evaluated classes to string + ;; syntax, and then obey syntax properties. + (set (make-local-variable 'syntax-propertize-function) + ;; In the main syntax-table, \ is marked as a punctuation, because + ;; of its use in DOS-style directory separators. Here we try to + ;; recognize the cases where \ is used as an escape inside strings. + (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) (setq imenu-generic-expression cfengine-imenu-expression) (set (make-local-variable 'beginning-of-defun-function) #'cfengine-beginning-of-defun)
--- a/lisp/progmodes/compile.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/compile.el Thu Sep 16 11:11:13 2010 +0900 @@ -164,7 +164,7 @@ (defvar compilation-num-errors-found) -(defconst compilation-error-regexp-alist-alist +(defvar compilation-error-regexp-alist-alist '((absoft "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) @@ -263,9 +263,11 @@ ;; The core of the regexp is the one with *?. It says that a file name ;; can be composed of any non-newline char, but it also rules out some ;; valid but unlikely cases, such as a trailing space or a space - ;; followed by a -. + ;; followed by a -, or a colon followed by a space. + + ;; The "in \\|from " exception was added to handle messages from Ruby. "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ -\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\ +\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\ \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ @@ -766,12 +768,27 @@ skip anything less than warning or 0 -- don't skip any messages. Note that all messages not positively identified as warning or info, are considered errors." - :type '(choice (const :tag "Warnings and info" 2) - (const :tag "Info" 1) - (const :tag "None" 0)) + :type '(choice (const :tag "Skip warnings and info" 2) + (const :tag "Skip info" 1) + (const :tag "No skip" 0)) :group 'compilation :version "22.1") +(defun compilation-set-skip-threshold (level) + "Switch the `compilation-skip-threshold' level." + (interactive + (list + (mod (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + (1+ compilation-skip-threshold)) + 3))) + (setq compilation-skip-threshold level) + (message "Skipping %s" + (case compilation-skip-threshold + (0 "Nothing") + (1 "Info messages") + (2 "Warnings and info")))) + (defcustom compilation-skip-visited nil "Compilation motion commands skip visited messages if this is t. Visited messages are ones for which the file, line and column have been jumped @@ -1212,7 +1229,7 @@ (let* ((name-of-mode (if (eq mode t) "compilation" - (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) + (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) (thisdir default-directory) outwin outbuf) (with-current-buffer @@ -2377,7 +2394,7 @@ (defun compilation-forget-errors () ;; In case we hit the same file/line specs, we want to recompute a new ;; marker for them, so flush our cache. - (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) + (clrhash compilation-locs) (setq compilation-gcpro nil) ;; FIXME: the old code reset the directory-stack, so maybe we should ;; put a `directory change' marker of some sort, but where? -stef
--- a/lisp/progmodes/cperl-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/cperl-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -1840,7 +1840,13 @@ (make-local-variable 'cperl-syntax-state) (setq cperl-syntax-state nil) ; reset syntaxification cache (if cperl-use-syntax-table-text-property - (progn + (if (boundp 'syntax-propertize-function) + (progn + ;; Reset syntaxification cache. + (set (make-local-variable 'cperl-syntax-done-to) nil) + (set (make-local-variable 'syntax-propertize-function) + (lambda (start end) + (goto-char start) (cperl-fontify-syntaxically end)))) (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t)
--- a/lisp/progmodes/fortran.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/fortran.el Thu Sep 16 11:11:13 2010 +0900 @@ -483,6 +483,7 @@ "Maximum highlighting for Fortran mode. Consists of level 3 plus all other intrinsics not already highlighted.") +(defvar fortran--font-lock-syntactic-keywords) ;; Comments are real pain in Fortran because there is no way to ;; represent the standard comment syntax in an Emacs syntax table. ;; (We can do so for F90-style). Therefore an unmatched quote in a @@ -887,9 +888,11 @@ fortran-font-lock-keywords-3 fortran-font-lock-keywords-4) nil t ((?/ . "$/") ("_$" . "w")) - fortran-beginning-of-subprogram - (font-lock-syntactic-keywords - . fortran-font-lock-syntactic-keywords))) + fortran-beginning-of-subprogram)) + (set (make-local-variable 'fortran--font-lock-syntactic-keywords) + (fortran-make-syntax-propertize-function)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords)) (set (make-local-variable 'imenu-case-fold-search) t) (set (make-local-variable 'imenu-generic-expression) fortran-imenu-generic-expression) @@ -917,11 +920,13 @@ (when (eq major-mode 'fortran-mode) (setq fortran-line-length nchars fill-column fortran-line-length - new (fortran-font-lock-syntactic-keywords)) + new (fortran-make-syntax-propertize-function)) ;; Refontify only if necessary. - (unless (equal new font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords - (fortran-font-lock-syntactic-keywords)) + (unless (equal new fortran--font-lock-syntactic-keywords) + (setq fortran--font-lock-syntactic-keywords new) + (setq syntax-propertize-function + (syntax-propertize-via-font-lock new)) + (syntax-ppss-flush-cache (point-min)) (if font-lock-mode (font-lock-mode 1)))))) (if global (buffer-list)
--- a/lisp/progmodes/gud.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/gud.el Thu Sep 16 11:11:13 2010 +0900 @@ -3123,10 +3123,12 @@ ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) -(defvar gdb-script-font-lock-syntactic-keywords - '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ("^end\\>" - (0 (unless (eq (match-beginning 0) (point-min)) +(defconst gdb-script-syntax-propertize-function + (syntax-propertize-rules + ("^document\\s-.*\\(\n\\)" (1 "< b")) + ("^end\\(\\>\\)" + (1 (ignore + (unless (eq (match-beginning 0) (point-min)) ;; We change the \n in front, which is more difficult, but results ;; in better highlighting. If the doc is empty, the single \n is ;; both the beginning and the end of the docstring, which can't be @@ -3138,10 +3140,9 @@ 'syntax-table (eval-when-compile (string-to-syntax "> b"))) ;; Make sure that rehighlighting the previous line won't erase our - ;; syntax-table property. + ;; syntax-table property and that modifying `end' will. (put-text-property (1- (match-beginning 0)) (match-end 0) - 'font-lock-multiline t) - nil))))) + 'syntax-multiline t))))))) (defun gdb-script-font-lock-syntactic-face (state) (cond @@ -3239,10 +3240,13 @@ #'gdb-script-end-of-defun) (set (make-local-variable 'font-lock-defaults) '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-keywords - . gdb-script-font-lock-syntactic-keywords) (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face)))) + . gdb-script-font-lock-syntactic-face))) + ;; Recognize docstrings. + (set (make-local-variable 'syntax-propertize-function) + gdb-script-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local)) ;;; tooltips for GUD
--- a/lisp/progmodes/js.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/js.el Thu Sep 16 11:11:13 2010 +0900 @@ -45,16 +45,16 @@ ;;; Code: -(eval-and-compile - (require 'cc-mode) - (require 'font-lock) - (require 'newcomment) - (require 'imenu) - (require 'etags) - (require 'thingatpt) - (require 'easymenu) - (require 'moz nil t) - (require 'json nil t)) + +(require 'cc-mode) +(require 'font-lock) +(require 'newcomment) +(require 'imenu) +(require 'etags) +(require 'thingatpt) +(require 'easymenu) +(require 'moz nil t) +(require 'json nil t) (eval-when-compile (require 'cl) @@ -725,20 +725,19 @@ If invoked while inside a macro, it treats the contents of the macro as normal text." + (unless count (setq count 1)) (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-forward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-backward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-forward-inner regexp bound count))))) + (search-fun + (cond ((< count 0) (setq count (- count)) + #'js--re-search-backward-inner) + ((> count 0) #'js--re-search-forward-inner) + (t #'ignore)))) (condition-case err - (eval search-expr) + (funcall search-fun regexp bound count) (search-failed (goto-char saved-point) (unless noerror - (error (error-message-string err))))))) + (signal (car err) (cdr err))))))) (defun js--re-search-backward-inner (regexp &optional bound count) @@ -782,20 +781,7 @@ removed. If invoked while inside a macro, treat the macro as normal text." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-backward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-forward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-backward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) + (js--re-search-forward regexp bound noerror (if count (- count) -1))) (defun js--forward-expression () "Move forward over a whole JavaScript expression. @@ -1674,18 +1660,19 @@ ;; XXX: Javascript can continue a regexp literal across lines so long ;; as the newline is escaped with \. Account for that in the regexp ;; below. -(defconst js--regexp-literal +(eval-and-compile + (defconst js--regexp-literal "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)" "Regexp matching a JavaScript regular expression literal. Match groups 1 and 2 are the characters forming the beginning and -end of the literal.") - -;; we want to match regular expressions only at the beginning of -;; expressions -(defconst js-font-lock-syntactic-keywords - `((,js--regexp-literal (1 "|") (2 "|"))) - "Syntactic font lock keywords matching regexps in JavaScript. -See `font-lock-keywords'.") +end of the literal.")) + + +(defconst js-syntax-propertize-function + (syntax-propertize-rules + ;; We want to match regular expressions only at the beginning of + ;; expressions. + (js--regexp-literal (1 "\"") (2 "\"")))) ;;; Indentation @@ -3317,10 +3304,9 @@ (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) (set (make-local-variable 'font-lock-defaults) - (list js--font-lock-keywords - nil nil nil nil - '(font-lock-syntactic-keywords - . js-font-lock-syntactic-keywords))) + '(js--font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + js-syntax-propertize-function) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'parse-sexp-lookup-properties) t)
--- a/lisp/progmodes/make-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/make-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -505,15 +505,16 @@ cpp-font-lock-keywords)) -(defconst makefile-font-lock-syntactic-keywords - ;; From sh-script.el. - ;; A `#' begins a comment in sh when it is unquoted and at the beginning - ;; of a word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec of the - ;; shell command language (under `quoting') but with `$' removed. - '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_") - ;; Change the syntax of a quoted newline so that it does not end a comment. - ("\\\\\n" 0 "."))) +(defconst makefile-syntax-propertize-function + (syntax-propertize-rules + ;; From sh-script.el. + ;; A `#' begins a comment in sh when it is unquoted and at the beginning + ;; of a word. In the shell, words are separated by metacharacters. + ;; The list of special chars is taken from the single-unix spec of the + ;; shell command language (under `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; Change the syntax of a quoted newline so that it does not end a comment. + ("\\\\\n" (0 ".")))) (defvar makefile-imenu-generic-expression `(("Dependencies" makefile-previous-dependency 1) @@ -872,9 +873,9 @@ '(makefile-font-lock-keywords nil nil ((?$ . ".")) - backward-paragraph - (font-lock-syntactic-keywords - . makefile-font-lock-syntactic-keywords))) + backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + makefile-syntax-propertize-function) ;; Add-log. (set (make-local-variable 'add-log-current-defun-function) @@ -943,15 +944,9 @@ (define-derived-mode makefile-imake-mode makefile-mode "Imakefile" "An adapted `makefile-mode' that knows about imake." :syntax-table makefile-imake-mode-syntax-table - (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))) - new) - ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults. - (mapc (lambda (elt) - (unless (and (consp elt) - (eq (car elt) 'font-lock-syntactic-keywords)) - (setq new (cons elt new)))) - base) - (setq font-lock-defaults (nreverse new)))) + (set (make-local-variable 'syntax-propertize-function) nil) + (setq font-lock-defaults + `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
--- a/lisp/progmodes/mixal-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/mixal-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -89,7 +89,7 @@ (defvar mixal-mode-syntax-table (let ((st (make-syntax-table))) ;; We need to do a bit more to make fontlocking for comments work. - ;; See mixal-font-lock-syntactic-keywords. + ;; See use of syntax-propertize-function. ;; (modify-syntax-entry ?* "<" st) (modify-syntax-entry ?\n ">" st) st) @@ -1028,13 +1028,14 @@ ;;; Font-locking: -(defvar mixal-font-lock-syntactic-keywords - ;; Normal comments start with a * in column 0 and end at end of line. - '(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11) - ;; Every line can end with a comment which is placed after the operand. - ;; I assume here that mnemonics without operands can not have a comment. - ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" - (1 '(11))))) +(defconst mixal-syntax-propertize-function + (syntax-propertize-rules + ;; Normal comments start with a * in column 0 and end at end of line. + ("^\\*" (0 "<")) + ;; Every line can end with a comment which is placed after the operand. + ;; I assume here that mnemonics without operands can not have a comment. + ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" + (1 "<")))) (defvar mixal-font-lock-keywords `(("^\\([A-Z0-9a-z]+\\)" @@ -1110,9 +1111,9 @@ (set (make-local-variable 'comment-start) "*") (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") (set (make-local-variable 'font-lock-defaults) - `(mixal-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + `(mixal-font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + mixal-syntax-propertize-function) ;; might add an indent function in the future ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) (set (make-local-variable 'compile-command) (concat "mixasm "
--- a/lisp/progmodes/octave-mod.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/octave-mod.el Thu Sep 16 11:11:13 2010 +0900 @@ -179,38 +179,28 @@ '(3 font-lock-function-name-face nil t))) "Additional Octave expressions to highlight.") -(defvar octave-font-lock-syntactic-keywords +(defun octave-syntax-propertize-function (start end) + (goto-char start) + (octave-syntax-propertize-sqs end) + (funcall (syntax-propertize-rules ;; Try to distinguish the string-quotes from the transpose-quotes. - '(("[[({,; ]\\('\\)" (1 "\"'")) - (octave-font-lock-close-quotes))) + ("[[({,; ]\\('\\)" + (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) + (point) end)) -(defun octave-font-lock-close-quotes (limit) - "Fix the syntax-table of the closing quotes of single-quote strings." - ;; Freely inspired from perl-font-lock-special-syntactic-constructs. - (let ((state (syntax-ppss))) - (while (< (point) limit) - (cond - ((eq (nth 3 state) ?\') +(defun octave-syntax-propertize-sqs (end) + "Propertize the content/end of single-quote strings." + (when (eq (nth 3 (syntax-ppss)) ?\') ;; A '..' string. - (save-excursion - (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']" - nil t) - (goto-char (1- (point))) - ;; Remove any syntax-table property we may have applied to - ;; some of the (doubled) single quotes within the string. - ;; Since these are the only chars on which we place properties, - ;; we take a shortcut and just remove all properties. - (remove-text-properties (1+ (nth 8 state)) (match-beginning 1) - '(syntax-table nil)) + (when (re-search-forward + "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) + (goto-char (match-beginning 2)) (when (eq (char-before (match-beginning 1)) ?\\) ;; Backslash cannot escape a single quote. (put-text-property (1- (match-beginning 1)) (match-beginning 1) 'syntax-table (string-to-syntax "."))) (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "\"'")))))) - - (setq state (parse-partial-sexp (point) limit nil nil state - 'syntax-table))))) + 'syntax-table (string-to-syntax "\"'"))))) (defcustom inferior-octave-buffer "*Inferior Octave*" "Name of buffer for running an inferior Octave process." @@ -544,6 +534,8 @@ 0) ((:before . "case") octave-block-offset))) +(defvar electric-indent-chars) + ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. @@ -682,9 +674,10 @@ (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) (set (make-local-variable 'font-lock-defaults) - '(octave-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords . octave-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + '(octave-font-lock-keywords)) + + (set (make-local-variable 'syntax-propertize-function) + #'octave-syntax-propertize-function) (set (make-local-variable 'imenu-generic-expression) octave-mode-imenu-generic-expression)
--- a/lisp/progmodes/perl-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/perl-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -250,59 +250,76 @@ ;; y /.../.../ ;; ;; <file*glob> -(defvar perl-font-lock-syntactic-keywords - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") - `(;; Turn POD into b-style comments - ("^\\(=\\)\\sw" (1 "< b")) - ("^=cut[ \t]*\\(\n\\)" (1 "> b")) - ;; Catch ${ so that ${var} doesn't screw up indentation. - ;; This also catches $' to handle 'foo$', although it should really - ;; check that it occurs inside a '..' string. - ("\\(\\$\\)[{']" (1 ". p")) - ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) - ;; format statements - ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) - ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. - ;; Be careful not to match "sub { (...) ... }". - ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" - 1 '(1)) - ;; Regexp and funny quotes. Distinguishing a / that starts a regexp - ;; match from the division operator is ...interesting. - ;; Basically, / is a regexp match if it's preceded by an infix operator - ;; (or some similar separator), or by one of the special keywords - ;; corresponding to builtin functions that can take their first arg - ;; without parentheses. Of course, that presume we're looking at the - ;; *opening* slash. We can afford to mis-match the closing ones - ;; here, because they will be re-treated separately later in - ;; perl-font-lock-special-syntactic-constructs. - (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" - (regexp-opt '("split" "if" "unless" "until" "while" "split" - "grep" "map" "not" "or" "and")) - "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") - (2 (if (and (match-end 1) - (save-excursion - (goto-char (match-end 1)) - ;; Not 100% correct since we haven't finished setting up - ;; the syntax-table before point, but better than nothing. - (forward-comment (- (point-max))) - (put-text-property (point) (match-end 2) - 'jit-lock-defer-multiline t) - (not (memq (char-before) - '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) - nil ;; A division sign instead of a regexp-match. - '(7)))) - ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" - ;; Nasty cases: - ;; /foo/m $a->m $#m $m @m %m - ;; \s (appears often in regexps). - ;; -s file - (3 (if (assoc (char-after (match-beginning 3)) - perl-quote-like-pairs) - '(15) '(7)))) - ;; Find and mark the end of funny quotes and format statements. - (perl-font-lock-special-syntactic-constructs) - )) +(defun perl-syntax-propertize-function (start end) + (let ((case-fold-search nil)) + (goto-char start) + (perl-syntax-propertize-special-constructs end) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + (funcall + (syntax-propertize-rules + ;; Turn POD into b-style comments. Place the cut rule first since it's + ;; more specific. + ("^=cut\\>.*\\(\n\\)" (1 "> b")) + ("^\\(=\\)\\sw" (1 "< b")) + ;; Catch ${ so that ${var} doesn't screw up indentation. + ;; This also catches $' to handle 'foo$', although it should really + ;; check that it occurs inside a '..' string. + ("\\(\\$\\)[{']" (1 ". p")) + ;; Handle funny names like $DB'stop. + ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ;; format statements + ("^[ \t]*format.*=[ \t]*\\(\n\\)" + (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) + ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. + ;; Be careful not to match "sub { (...) ... }". + ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" + (1 ".")) + ;; Regexp and funny quotes. Distinguishing a / that starts a regexp + ;; match from the division operator is ...interesting. + ;; Basically, / is a regexp match if it's preceded by an infix operator + ;; (or some similar separator), or by one of the special keywords + ;; corresponding to builtin functions that can take their first arg + ;; without parentheses. Of course, that presume we're looking at the + ;; *opening* slash. We can afford to mis-match the closing ones + ;; here, because they will be re-treated separately later in + ;; perl-font-lock-special-syntactic-constructs. + ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" + (regexp-opt '("split" "if" "unless" "until" "while" "split" + "grep" "map" "not" "or" "and")) + "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") + (2 (ignore + (if (and (match-end 1) ; / at BOL. + (save-excursion + (goto-char (match-end 1)) + (forward-comment (- (point-max))) + (put-text-property (point) (match-end 2) + 'syntax-multiline t) + (not (memq (char-before) + '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) + nil ;; A division sign instead of a regexp-match. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "\"")) + (perl-syntax-propertize-special-constructs end))))) + ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" + ;; Nasty cases: + ;; /foo/m $a->m $#m $m @m %m + ;; \s (appears often in regexps). + ;; -s file + ;; sub tr {...} + (3 (ignore + (if (save-excursion (goto-char (match-beginning 0)) + (forward-word -1) + (looking-at-p "sub[ \t\n]")) + ;; This is defining a function. + nil + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table + (if (assoc (char-after (match-beginning 3)) + perl-quote-like-pairs) + (string-to-syntax "|") + (string-to-syntax "\""))) + (perl-syntax-propertize-special-constructs end)))))) + (point) end))) (defvar perl-empty-syntax-table (let ((st (copy-syntax-table))) @@ -321,95 +338,123 @@ (modify-syntax-entry close ")" st)) st)) -(defun perl-font-lock-special-syntactic-constructs (limit) - ;; We used to do all this in a font-lock-syntactic-face-function, which - ;; did not work correctly because sometimes some parts of the buffer are - ;; treated with font-lock-syntactic-keywords but not with - ;; font-lock-syntactic-face-function (mostly because of - ;; font-lock-syntactically-fontified). That meant that some syntax-table - ;; properties were missing. So now we do the parse-partial-sexp loop - ;; ourselves directly from font-lock-syntactic-keywords, so we're sure - ;; it's done when necessary. +(defun perl-syntax-propertize-special-constructs (limit) + "Propertize special constructs like regexps and formats." (let ((state (syntax-ppss)) char) - (while (< (point) limit) - (cond - ((or (null (setq char (nth 3 state))) - (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) - ;; Normal text, or comment, or docstring, or normal string. - nil) - ((eq (nth 3 state) ?\n) - ;; A `format' command. - (save-excursion - (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) - (not (eobp))) - (put-text-property (point) (1+ (point)) 'syntax-table '(7))))) - (t - ;; This is regexp like quote thingy. - (setq char (char-after (nth 8 state))) - (save-excursion - (let ((twoargs (save-excursion - (goto-char (nth 8 state)) - (skip-syntax-backward " ") - (skip-syntax-backward "w") - (member (buffer-substring - (point) (progn (forward-word 1) (point))) - '("tr" "s" "y")))) - (close (cdr (assq char perl-quote-like-pairs))) - (pos (point)) - (st (perl-quote-syntax-table char))) - (if (not close) - ;; The closing char is the same as the opening char. - (with-syntax-table st - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table) - (when twoargs - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table))) - ;; The open/close chars are matched like () [] {} and <>. - (let ((parse-sexp-lookup-properties nil)) - (condition-case err - (progn - (with-syntax-table st - (goto-char (nth 8 state)) (forward-sexp 1)) - (when twoargs - (save-excursion - ;; Skip whitespace and make sure that font-lock will - ;; refontify the second part in the proper context. - (put-text-property - (point) (progn (forward-comment (point-max)) (point)) - 'font-lock-multiline t) - ;; - (unless - (or (eobp) - (save-excursion - (with-syntax-table - (perl-quote-syntax-table (char-after)) - (forward-sexp 1)) - (put-text-property pos (line-end-position) - 'jit-lock-defer-multiline t) - (looking-at "\\s-*\\sw*e"))) - (put-text-property (point) (1+ (point)) - 'syntax-table - (if (assoc (char-after) - perl-quote-like-pairs) - '(15) '(7))))))) - ;; The arg(s) is not terminated, so it extends until EOB. - (scan-error (goto-char (point-max)))))) - ;; Point is now right after the arg(s). - ;; Erase any syntactic marks within the quoted text. - (put-text-property pos (1- (point)) 'syntax-table nil) - (when (eq (char-before (1- (point))) ?$) - (put-text-property (- (point) 2) (1- (point)) - 'syntax-table '(1))) - (put-text-property (1- (point)) (point) - 'syntax-table (if close '(15) '(7))))))) + (cond + ((or (null (setq char (nth 3 state))) + (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) + ;; Normal text, or comment, or docstring, or normal string. + nil) + ((eq (nth 3 state) ?\n) + ;; A `format' command. + (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + (t + ;; This is regexp like quote thingy. + (setq char (char-after (nth 8 state))) + (let ((twoargs (save-excursion + (goto-char (nth 8 state)) + (skip-syntax-backward " ") + (skip-syntax-backward "w") + (member (buffer-substring + (point) (progn (forward-word 1) (point))) + '("tr" "s" "y")))) + (close (cdr (assq char perl-quote-like-pairs))) + (st (perl-quote-syntax-table char))) + (when (with-syntax-table st + (if close + ;; For paired delimiters, Perl allows nesting them, but + ;; since we treat them as strings, Emacs does not count + ;; those delimiters in `state', so we don't know how deep + ;; we are: we have to go back to the beginning of this + ;; "string" and count from there. + (condition-case nil + (progn + ;; Start after the first char since it doesn't have + ;; paren-syntax (an alternative would be to let-bind + ;; parse-sexp-lookup-properties). + (goto-char (1+ (nth 8 state))) + (up-list 1) + t) + (scan-error nil)) + (not (or (nth 8 (parse-partial-sexp + (point) limit nil nil state 'syntax-table)) + ;; If we have a self-paired opener and a twoargs + ;; command, the form is s/../../ so we have to skip + ;; a second time. + ;; In the case of s{...}{...}, we only handle the + ;; first part here and the next below. + (when (and twoargs (not close)) + (nth 8 (parse-partial-sexp + (point) limit + nil nil state 'syntax-table))))))) + ;; Point is now right after the arg(s). + (when (eq (char-before (1- (point))) ?$) + (put-text-property (- (point) 2) (1- (point)) + 'syntax-table '(1))) + (put-text-property (1- (point)) (point) + 'syntax-table + (if close + (string-to-syntax "|") + (string-to-syntax "\""))) + ;; If we have two args with a non-self-paired starter (e.g. + ;; s{...}{...}) we're right after the first arg, so we still have to + ;; handle the second part. + (when (and twoargs close) + ;; Skip whitespace and make sure that font-lock will + ;; refontify the second part in the proper context. + (put-text-property + (point) (progn (forward-comment (point-max)) (point)) + 'syntax-multiline t) + ;; + (when (< (point) limit) + (put-text-property (point) (1+ (point)) + 'syntax-table + (if (assoc (char-after) + perl-quote-like-pairs) + ;; Put an `e' in the cdr to mark this + ;; char as "second arg starter". + (string-to-syntax "|e") + (string-to-syntax "\"e"))) + (forward-char 1) + ;; Re-use perl-syntax-propertize-special-constructs to handle the + ;; second part (the first delimiter of second part can't be + ;; preceded by "s" or "tr" or "y", so it will not be considered + ;; as twoarg). + (perl-syntax-propertize-special-constructs limit))))))))) - (setq state (parse-partial-sexp (point) limit nil nil state - 'syntax-table)))) - ;; Tell font-lock that this needs not further processing. - nil) - +(defun perl-font-lock-syntactic-face-function (state) + (cond + ((and (nth 3 state) + (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) + ;; This is a second-arg of s{..}{...} form; let's check if this second + ;; arg is executable code rather than a string. For that, we need to + ;; look for an "e" after this second arg, so we have to hunt for the + ;; end of the arg. Depending on whether the whole arg has already + ;; been syntax-propertized or not, the end-char will have different + ;; syntaxes, so let's ignore syntax-properties temporarily so we can + ;; pretend it has not been syntax-propertized yet. + (let* ((parse-sexp-lookup-properties nil) + (char (char-after (nth 8 state))) + (paired (assq char perl-quote-like-pairs))) + (with-syntax-table (perl-quote-syntax-table char) + (save-excursion + (if (not paired) + (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table) + (condition-case nil + (progn + (goto-char (1+ (nth 8 state))) + (up-list 1)) + (scan-error (goto-char (point-max))))) + (put-text-property (nth 8 state) (point) + 'jit-lock-defer-multiline t) + (looking-at "[ \t]*\\sw*e"))))) + nil) + (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) (defcustom perl-indent-level 4 "*Indentation of Perl statements with respect to containing block." @@ -574,9 +619,12 @@ perl-font-lock-keywords-1 perl-font-lock-keywords-2) nil nil ((?\_ . "w")) nil - (font-lock-syntactic-keywords - . perl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + (font-lock-syntactic-face-function + . perl-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'perl-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) ;; Tell imenu how to handle Perl. (set (make-local-variable 'imenu-generic-expression) perl-imenu-generic-expression)
--- a/lisp/progmodes/python.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/python.el Thu Sep 16 11:11:13 2010 +0900 @@ -166,29 +166,32 @@ symbol-end) . font-lock-builtin-face))) -(defconst python-font-lock-syntactic-keywords +(defconst python-syntax-propertize-function ;; Make outer chars of matching triple-quote sequences into generic ;; string delimiters. Fixme: Is there a better way? ;; First avoid a sequence preceded by an odd number of backslashes. - `((,(rx (not (any ?\\)) - ?\\ (* (and ?\\ ?\\)) - (group (syntax string-quote)) - (backref 1) - (group (backref 1))) - (2 ,(string-to-syntax "\""))) ; dummy - (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property - (optional (any "rR")) ; possible second prefix - (group (syntax string-quote)) ; maybe gets property - (backref 2) ; per first quote - (group (backref 2))) ; maybe gets property - (1 (python-quote-syntax 1)) - (2 (python-quote-syntax 2)) - (3 (python-quote-syntax 3))) - ;; This doesn't really help. -;;; (,(rx (and ?\\ (group ?\n))) (1 " ")) - )) + (syntax-propertize-rules + (;; (rx (not (any ?\\)) + ;; ?\\ (* (and ?\\ ?\\)) + ;; (group (syntax string-quote)) + ;; (backref 1) + ;; (group (backref 1))) + ;; ¡Backrefs don't work in syntax-propertize-rules! + "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)" + (2 "\"")) ; dummy + (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property + ;; (optional (any "rR")) ; possible second prefix + ;; (group (syntax string-quote)) ; maybe gets property + ;; (backref 2) ; per first quote + ;; (group (backref 2))) ; maybe gets property + ;; ¡Backrefs don't work in syntax-propertize-rules! + "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)" + (3 (ignore (python-quote-syntax)))) + ;; This doesn't really help. + ;;((rx (and ?\\ (group ?\n))) (1 " ")) + )) -(defun python-quote-syntax (n) +(defun python-quote-syntax () "Put `syntax-table' property correctly on triple quote. Used for syntactic keywords. N is the match number (1, 2 or 3)." ;; Given a triple quote, we have to check the context to know @@ -206,28 +209,25 @@ ;; x '"""' x """ \"""" x (save-excursion (goto-char (match-beginning 0)) - (cond - ;; Consider property for the last char if in a fenced string. - ((= n 3) - (let* ((font-lock-syntactic-keywords nil) - (syntax (syntax-ppss))) - (when (eq t (nth 3 syntax)) ; after unclosed fence - (goto-char (nth 8 syntax)) ; fence position - (skip-chars-forward "uUrR") ; skip any prefix - ;; Is it a matching sequence? - (if (eq (char-after) (char-after (match-beginning 2))) - (eval-when-compile (string-to-syntax "|")))))) - ;; Consider property for initial char, accounting for prefixes. - ((or (and (= n 2) ; leading quote (not prefix) - (= (match-beginning 1) (match-end 1))) ; prefix is null - (and (= n 1) ; prefix - (/= (match-beginning 1) (match-end 1)))) ; non-empty - (let ((font-lock-syntactic-keywords nil)) - (unless (eq 'string (syntax-ppss-context (syntax-ppss))) - (eval-when-compile (string-to-syntax "|"))))) - ;; Otherwise (we're in a non-matching string) the property is - ;; nil, which is OK. - ))) + (let ((syntax (save-match-data (syntax-ppss)))) + (cond + ((eq t (nth 3 syntax)) ; after unclosed fence + ;; Consider property for the last char if in a fenced string. + (goto-char (nth 8 syntax)) ; fence position + (skip-chars-forward "uUrR") ; skip any prefix + ;; Is it a matching sequence? + (if (eq (char-after) (char-after (match-beginning 2))) + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table (string-to-syntax "|")))) + ((match-end 1) + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|"))) + (t + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "|")))) + ))) ;; This isn't currently in `font-lock-defaults' as probably not worth ;; it -- we basically only mess with a few normally-symbol characters. @@ -2495,12 +2495,12 @@ :group 'python (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords - . python-font-lock-syntactic-keywords) - ;; This probably isn't worth it. - ;; (font-lock-syntactic-face-function - ;; . python-font-lock-syntactic-face-function) - )) + ;; This probably isn't worth it. + ;; (font-lock-syntactic-face-function + ;; . python-font-lock-syntactic-face-function) + )) + (set (make-local-variable 'syntax-propertize-function) + python-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start) "# ")
--- a/lisp/progmodes/ruby-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/ruby-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -100,17 +100,10 @@ (defconst ruby-block-end-re "\\<end\\>") -(defconst ruby-here-doc-beg-re +(eval-and-compile + (defconst ruby-here-doc-beg-re "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" - "Regexp to match the beginning of a heredoc.") - -(defconst ruby-here-doc-end-re - "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$" - "Regexp to match the end of heredocs. - -This will actually match any line with one or more characters. -It's useful in that it divides up the match string so that -`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + "Regexp to match the beginning of a heredoc.")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -123,18 +116,6 @@ (match-string 5) (match-string 6))))) -(defun ruby-here-doc-beg-match () - "Return a regexp to find the beginning of a heredoc. - -This should only be called after matching against `ruby-here-doc-end-re'." - (let ((contents (regexp-quote (concat (match-string 2) (match-string 3))))) - (concat "<<" - (let ((match (match-string 1))) - (if (and match (> (length match) 0)) - (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)" - contents "\\b\\(\\1\\|\\2\\)") - (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) - (defconst ruby-delimiter (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" ruby-block-beg-re @@ -362,7 +343,7 @@ (back-to-indentation) (current-column))) -(defun ruby-indent-line (&optional flag) +(defun ruby-indent-line (&optional ignored) "Correct the indentation of the current Ruby line." (interactive) (ruby-indent-to (ruby-calculate-indent))) @@ -405,8 +386,7 @@ "TODO: document." (save-excursion (store-match-data nil) - (let ((space (skip-chars-backward " \t")) - (start (point))) + (let ((space (skip-chars-backward " \t"))) (cond ((bolp) t) ((progn @@ -700,7 +680,7 @@ (beginning-of-line) (let ((ruby-indent-point (point)) (case-fold-search nil) - state bol eol begin op-end + state eol begin op-end (paren (progn (skip-syntax-forward " ") (and (char-after) (matching-paren (char-after))))) (indent 0)) @@ -780,7 +760,6 @@ (if (re-search-forward "^\\s *#" end t) (beginning-of-line) (setq done t)))) - (setq bol (point)) (end-of-line) ;; skip the comment at the end (skip-chars-backward " \t") @@ -1037,10 +1016,8 @@ (ruby-beginning-of-defun) (re-search-backward "^\n" (- (point) 1) t)) -(defun ruby-indent-exp (&optional shutup-p) - "Indent each line in the balanced expression following the point. -If a prefix arg is given or SHUTUP-P is non-nil, no errors -are signalled if a balanced expression isn't found." +(defun ruby-indent-exp (&optional ignored) + "Indent each line in the balanced expression following the point." (interactive "*P") (let ((here (point-marker)) start top column (nest t)) (set-marker-insertion-type here t) @@ -1133,58 +1110,208 @@ (if mlist (concat mlist mname) mname) mlist))))) -(defconst ruby-font-lock-syntactic-keywords - `(;; #{ }, #$hoge, #@foo are not comments - ("\\(#\\)[{$@]" 1 (1 . nil)) - ;; the last $', $", $` in the respective string is not variable - ;; the last ?', ?", ?` in the respective string is not ascii code - ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" - (2 (7 . nil)) - (4 (7 . nil))) - ;; $' $" $` .... are variables - ;; ?' ?" ?` are ascii codes - ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) - ;; regexps - ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" - (4 (7 . ?/)) - (6 (7 . ?/))) - ("^=en\\(d\\)\\_>" 1 "!") - ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) - ;; Currently, the following case is highlighted incorrectly: - ;; - ;; <<FOO - ;; FOO - ;; <<BAR - ;; <<BAZ - ;; BAZ - ;; BAR - ;; - ;; This is because all here-doc beginnings are highlighted before any endings, - ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ - ;; it thinks <<BAR is part of a string so it's marked as well. - ;; - ;; This may be fixable by modifying ruby-in-here-doc-p to use - ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, - ;; but I don't want to try that until we've got unit tests set up - ;; to make sure I don't break anything else. - (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") - ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) - (ruby-here-doc-beg-syntax)) - (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) - "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") +(if (eval-when-compile (fboundp #'syntax-propertize-rules)) + ;; New code that works independently from font-lock. + (progn + (defun ruby-syntax-propertize-function (start end) + "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." + (goto-char start) + (ruby-syntax-propertize-heredoc end) + (funcall + (syntax-propertize-rules + ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" (1 ".")) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 "\"") + (4 "\"")) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 ".")) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 "\"/") + (6 "\"/")) + ("^=en\\(d\\)\\_>" (1 "!")) + ("^\\(=\\)begin\\_>" (1 "!")) + ;; Handle here documents. + ((concat ruby-here-doc-beg-re ".*\\(\n\\)") + (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end))))) + (point) end)) + + (defun ruby-syntax-propertize-heredoc (limit) + (let ((ppss (syntax-ppss)) + (res '())) + (when (eq ?\n (nth 3 ppss)) + (save-excursion + (goto-char (nth 8 ppss)) + (beginning-of-line) + (while (re-search-forward ruby-here-doc-beg-re + (line-end-position) t) + (push (concat (ruby-here-doc-end-match) "\n") res))) + (let ((start (point))) + ;; With multiple openers on the same line, we don't know in which + ;; part `start' is, so we have to go back to the beginning. + (when (cdr res) + (goto-char (nth 8 ppss)) + (setq res (nreverse res))) + (while (and res (re-search-forward (pop res) limit 'move)) + (if (null res) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + ;; Make extra sure we don't move back, lest we could fall into an + ;; inf-loop. + (if (< (point) start) (goto-char start)))))) + ) + + ;; For Emacsen where syntax-propertize-rules is not (yet) available, + ;; fallback on the old font-lock-syntactic-keywords stuff. -(defun ruby-comment-beg-syntax () - "Return the syntax cell for a the first character of a =begin. + (defconst ruby-here-doc-end-re + "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)" + "Regexp to match the end of heredocs. + +This will actually match any line with one or more characters. +It's useful in that it divides up the match string so that +`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + + (defun ruby-here-doc-beg-match () + "Return a regexp to find the beginning of a heredoc. + +This should only be called after matching against `ruby-here-doc-end-re'." + (let ((contents (regexp-quote (match-string 2)))) + (concat "<<" + (let ((match (match-string 1))) + (if (and match (> (length match) 0)) + (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)" + contents "\\b\\(\\1\\|\\2\\)") + (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) + + (defconst ruby-font-lock-syntactic-keywords + `( ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" 1 (1 . nil)) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 (7 . nil)) + (4 (7 . nil))) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 (7 . ?/)) + (6 (7 . ?/))) + ("^=en\\(d\\)\\_>" 1 "!") + ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) + ;; Currently, the following case is highlighted incorrectly: + ;; + ;; <<FOO + ;; FOO + ;; <<BAR + ;; <<BAZ + ;; BAZ + ;; BAR + ;; + ;; This is because all here-doc beginnings are highlighted before any endings, + ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ + ;; it thinks <<BAR is part of a string so it's marked as well. + ;; + ;; This may be fixable by modifying ruby-in-here-doc-p to use + ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, + ;; but I don't want to try that until we've got unit tests set up + ;; to make sure I don't break anything else. + (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") + ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) + (ruby-here-doc-beg-syntax)) + (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) + "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") + + (defun ruby-comment-beg-syntax () + "Return the syntax cell for a the first character of a =begin. See the definition of `ruby-font-lock-syntactic-keywords'. This returns a comment-delimiter cell as long as the =begin isn't in a string or another comment." - (when (not (nth 3 (syntax-ppss))) - (string-to-syntax "!"))) + (when (not (nth 3 (syntax-ppss))) + (string-to-syntax "!"))) + + (defun ruby-in-here-doc-p () + "Return whether or not the point is in a heredoc." + (save-excursion + (let ((old-point (point)) (case-fold-search nil)) + (beginning-of-line) + (catch 'found-beg + (while (re-search-backward ruby-here-doc-beg-re nil t) + (if (not (or (ruby-in-ppss-context-p 'anything) + (ruby-here-doc-find-end old-point))) + (throw 'found-beg t))))))) + + (defun ruby-here-doc-find-end (&optional limit) + "Expects the point to be on a line with one or more heredoc openers. +Returns the buffer position at which all heredocs on the line +are terminated, or nil if they aren't terminated before the +buffer position `limit' or the end of the buffer." + (save-excursion + (beginning-of-line) + (catch 'done + (let ((eol (save-excursion (end-of-line) (point))) + (case-fold-search nil) + ;; Fake match data such that (match-end 0) is at eol + (end-match-data (progn (looking-at ".*$") (match-data))) + beg-match-data end-re) + (while (re-search-forward ruby-here-doc-beg-re eol t) + (setq beg-match-data (match-data)) + (setq end-re (ruby-here-doc-end-match)) + + (set-match-data end-match-data) + (goto-char (match-end 0)) + (unless (re-search-forward end-re limit t) (throw 'done nil)) + (setq end-match-data (match-data)) -(unless (functionp 'syntax-ppss) - (defun syntax-ppss (&optional pos) - (parse-partial-sexp (point-min) (or pos (point))))) + (set-match-data beg-match-data) + (goto-char (match-end 0))) + (set-match-data end-match-data) + (goto-char (match-end 0)) + (point))))) + + (defun ruby-here-doc-beg-syntax () + "Return the syntax cell for a line that may begin a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'. + +This sets the syntax cell for the newline ending the line +containing the heredoc beginning so that cases where multiple +heredocs are started on one line are handled correctly." + (save-excursion + (goto-char (match-beginning 0)) + (unless (or (ruby-in-ppss-context-p 'non-heredoc) + (ruby-in-here-doc-p)) + (string-to-syntax "\"")))) + + (defun ruby-here-doc-end-syntax () + "Return the syntax cell for a line that may end a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'." + (let ((pss (syntax-ppss)) (case-fold-search nil)) + ;; If we aren't in a string, we definitely aren't ending a heredoc, + ;; so we can just give up. + ;; This means we aren't doing a full-document search + ;; every time we enter a character. + (when (ruby-in-ppss-context-p 'heredoc pss) + (save-excursion + (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. + (let ((eol (point))) + (beginning-of-line) + (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... + (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... + (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... + (not (re-search-forward ruby-here-doc-beg-re eol t)))) + (string-to-syntax "\""))))))) + + (unless (functionp 'syntax-ppss) + (defun syntax-ppss (&optional pos) + (parse-partial-sexp (point-min) (or pos (point))))) + ) (defun ruby-in-ppss-context-p (context &optional ppss) (let ((ppss (or ppss (syntax-ppss (point))))) @@ -1195,10 +1322,7 @@ ((eq context 'string) (nth 3 ppss)) ((eq context 'heredoc) - (and (nth 3 ppss) - ;; If it's generic string, it's a heredoc and we don't care - ;; See `parse-partial-sexp' - (not (numberp (nth 3 ppss))))) + (eq ?\n (nth 3 ppss))) ((eq context 'non-heredoc) (and (ruby-in-ppss-context-p 'anything) (not (ruby-in-ppss-context-p 'heredoc)))) @@ -1210,77 +1334,6 @@ "context name `" (symbol-name context) "' is unknown")))) t))) -(defun ruby-in-here-doc-p () - "Return whether or not the point is in a heredoc." - (save-excursion - (let ((old-point (point)) (case-fold-search nil)) - (beginning-of-line) - (catch 'found-beg - (while (re-search-backward ruby-here-doc-beg-re nil t) - (if (not (or (ruby-in-ppss-context-p 'anything) - (ruby-here-doc-find-end old-point))) - (throw 'found-beg t))))))) - -(defun ruby-here-doc-find-end (&optional limit) - "Expects the point to be on a line with one or more heredoc openers. -Returns the buffer position at which all heredocs on the line -are terminated, or nil if they aren't terminated before the -buffer position `limit' or the end of the buffer." - (save-excursion - (beginning-of-line) - (catch 'done - (let ((eol (save-excursion (end-of-line) (point))) - (case-fold-search nil) - ;; Fake match data such that (match-end 0) is at eol - (end-match-data (progn (looking-at ".*$") (match-data))) - beg-match-data end-re) - (while (re-search-forward ruby-here-doc-beg-re eol t) - (setq beg-match-data (match-data)) - (setq end-re (ruby-here-doc-end-match)) - - (set-match-data end-match-data) - (goto-char (match-end 0)) - (unless (re-search-forward end-re limit t) (throw 'done nil)) - (setq end-match-data (match-data)) - - (set-match-data beg-match-data) - (goto-char (match-end 0))) - (set-match-data end-match-data) - (goto-char (match-end 0)) - (point))))) - -(defun ruby-here-doc-beg-syntax () - "Return the syntax cell for a line that may begin a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'. - -This sets the syntax cell for the newline ending the line -containing the heredoc beginning so that cases where multiple -heredocs are started on one line are handled correctly." - (save-excursion - (goto-char (match-beginning 0)) - (unless (or (ruby-in-ppss-context-p 'non-heredoc) - (ruby-in-here-doc-p)) - (string-to-syntax "|")))) - -(defun ruby-here-doc-end-syntax () - "Return the syntax cell for a line that may end a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'." - (let ((pss (syntax-ppss)) (case-fold-search nil)) - ;; If we aren't in a string, we definitely aren't ending a heredoc, - ;; so we can just give up. - ;; This means we aren't doing a full-document search - ;; every time we enter a character. - (when (ruby-in-ppss-context-p 'heredoc pss) - (save-excursion - (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. - (let ((eol (point))) - (beginning-of-line) - (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... - (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... - (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... - (not (re-search-forward ruby-here-doc-beg-re eol t)))) - (string-to-syntax "|"))))))) - (if (featurep 'xemacs) (put 'ruby-mode 'font-lock-defaults '((ruby-font-lock-keywords) @@ -1377,8 +1430,10 @@ ) "Additional expressions to highlight in Ruby mode.") +(defvar electric-indent-chars) + ;;;###autoload -(defun ruby-mode () +(define-derived-mode ruby-mode prog-mode "Ruby" "Major mode for editing Ruby scripts. \\[ruby-indent-line] properly indents subexpressions of multi-line class, module, def, if, while, for, do, and case statements, taking @@ -1387,27 +1442,22 @@ The variable `ruby-indent-level' controls the amount of indentation. \\{ruby-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map ruby-mode-map) - (setq mode-name "Ruby") - (setq major-mode 'ruby-mode) (ruby-mode-variables) - (set (make-local-variable 'indent-line-function) - 'ruby-indent-line) (set (make-local-variable 'imenu-create-index-function) 'ruby-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) 'ruby-add-log-current-method) (add-hook - (cond ((boundp 'before-save-hook) - (make-local-variable 'before-save-hook) - 'before-save-hook) + (cond ((boundp 'before-save-hook) 'before-save-hook) ((boundp 'write-contents-functions) 'write-contents-functions) ((boundp 'write-contents-hooks) 'write-contents-hooks)) - 'ruby-mode-set-encoding) + 'ruby-mode-set-encoding nil 'local) + + (set (make-local-variable 'electric-indent-chars) + (append '(?\{ ?\}) (if (boundp 'electric-indent-chars) + (default-value 'electric-indent-chars)))) (set (make-local-variable 'font-lock-defaults) '((ruby-font-lock-keywords) nil nil)) @@ -1415,12 +1465,12 @@ ruby-font-lock-keywords) (set (make-local-variable 'font-lock-syntax-table) ruby-font-lock-syntax-table) - (set (make-local-variable 'font-lock-syntactic-keywords) - ruby-font-lock-syntactic-keywords) - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'ruby-mode-hook) - (run-hooks 'ruby-mode-hook))) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + #'ruby-syntax-propertize-function) + (set (make-local-variable 'font-lock-syntactic-keywords) + ruby-font-lock-syntactic-keywords))) ;;; Invoke ruby-mode when appropriate
--- a/lisp/progmodes/sh-script.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/sh-script.el Thu Sep 16 11:11:13 2010 +0900 @@ -939,7 +939,6 @@ ;; These are used for the syntax table stuff (derived from cperl-mode). ;; Note: parse-sexp-lookup-properties must be set to t for it to work. (defconst sh-st-punc (string-to-syntax ".")) -(defconst sh-st-symbol (string-to-syntax "_")) (defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string (defconst sh-escaped-line-re @@ -957,7 +956,7 @@ (defvar sh-here-doc-re sh-here-doc-open-re) (make-variable-buffer-local 'sh-here-doc-re) -(defun sh-font-lock-close-heredoc (bol eof indented) +(defun sh-font-lock-close-heredoc (bol eof indented eol) "Determine the syntax of the \\n after an EOF. If non-nil INDENTED indicates that the EOF was indented." (let* ((eof-re (if eof (regexp-quote eof) "")) @@ -971,6 +970,8 @@ (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) (start (save-excursion (goto-char bol) + ;; FIXME: will incorrectly find a <<EOF embedded inside + ;; the heredoc. (re-search-backward (concat sre "\\|" ere) nil t)))) ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first ;; found a close-heredoc which makes the current close-heredoc inoperant. @@ -990,7 +991,7 @@ (sh-in-comment-or-string (point))))) ;; No <<EOF2 found after our <<. (= (point) start))) - sh-here-doc-syntax) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)) ((not (or start (save-excursion (re-search-forward sre nil t)))) ;; There's no <<EOF either before or after us, ;; so we should remove ourselves from font-lock's keywords. @@ -1000,7 +1001,7 @@ (regexp-opt sh-here-doc-markers t) "\\(\n\\)")) nil)))) -(defun sh-font-lock-open-heredoc (start string) +(defun sh-font-lock-open-heredoc (start string eol) "Determine the syntax of the \\n after a <<EOF. START is the position of <<. STRING is the actual word used as delimiter (e.g. \"EOF\"). @@ -1030,13 +1031,8 @@ ;; Don't bother fixing it now, but place a multiline property so ;; that when jit-lock-context-* refontifies the rest of the ;; buffer, it also refontifies the current line with it. - (put-text-property start (point) 'font-lock-multiline t))) - sh-here-doc-syntax)) - -(defun sh-font-lock-here-doc (limit) - "Search for a heredoc marker." - ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. - (re-search-forward sh-here-doc-re limit t)) + (put-text-property start (point) 'syntax-multiline t))) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))) (defun sh-font-lock-quoted-subshell (limit) "Search for a subshell embedded in a string. @@ -1045,9 +1041,7 @@ ;; FIXME: This can (and often does) match multiple lines, yet it makes no ;; effort to handle multiline cases correctly, so it ends up being ;; rather flakey. - (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) - ;; Make sure the " we matched is an opening quote. - (eq ?\" (nth 3 (syntax-ppss)))) + (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) ;; `state' can be: double-quote, backquote, code. @@ -1082,8 +1076,7 @@ (double-quote nil) (t (setq state (pop states))))) (t (error "Internal error in sh-font-lock-quoted-subshell"))) - (forward-char 1))) - t)) + (forward-char 1))))) (defun sh-is-quoted-p (pos) @@ -1122,7 +1115,7 @@ (when (progn (backward-char 2) (if (> start (line-end-position)) (put-text-property (point) (1+ start) - 'font-lock-multiline t)) + 'syntax-multiline t)) ;; FIXME: The `in' may just be a random argument to ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the @@ -1136,40 +1129,44 @@ sh-st-punc nil)) -(defun sh-font-lock-flush-syntax-ppss-cache (limit) - ;; This should probably be a standard function provided by font-lock.el - ;; (or syntax.el). - (syntax-ppss-flush-cache (point)) - (goto-char limit) - nil) - -(defconst sh-font-lock-syntactic-keywords - ;; A `#' begins a comment when it is unquoted and at the beginning of a - ;; word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec - ;; of the shell command language (under `quoting') but with `$' removed. - `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) - ;; In a '...' the backslash is not escaping. - ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) - ;; The previous rule uses syntax-ppss, but the subsequent rules may - ;; change the syntax, so we have to tell syntax-ppss that the states it - ;; has just computed will need to be recomputed. - (sh-font-lock-flush-syntax-ppss-cache) - ;; Make sure $@ and $? are correctly recognized as sexps. - ("\\$\\([?@]\\)" 1 ,sh-st-symbol) - ;; Find HEREDOC starters and add a corresponding rule for the ender. - (sh-font-lock-here-doc - (2 (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1)) nil t) - (5 (sh-font-lock-close-heredoc - (match-beginning 0) (match-string 4) - (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) - nil t)) - ;; Distinguish the special close-paren in `case'. - (")" 0 (sh-font-lock-paren (match-beginning 0))) - ;; highlight (possibly nested) subshells inside "" quoted regions correctly. - ;; This should be at the very end because it uses syntax-ppss. - (sh-font-lock-quoted-subshell))) +(defun sh-syntax-propertize-function (start end) + (goto-char start) + (while (prog1 + (re-search-forward sh-here-doc-re end 'move) + (save-excursion + (save-match-data + (funcall + (syntax-propertize-rules + ;; A `#' begins a comment when it is unquoted and at the + ;; beginning of a word. In the shell, words are separated by + ;; metacharacters. The list of special chars is taken from + ;; the single-unix spec of the shell command language (under + ;; `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; In a '...' the backslash is not escaping. + ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) + ;; Make sure $@ and $? are correctly recognized as sexps. + ("\\$\\([?@]\\)" (1 "_")) + ;; Distinguish the special close-paren in `case'. + (")" (0 (sh-font-lock-paren (match-beginning 0)))) + ;; Highlight (possibly nested) subshells inside "" quoted + ;; regions correctly. + ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" + (1 (ignore + ;; Save excursion because we want to also apply other + ;; syntax-propertize rules within the affected region. + (save-excursion + (sh-font-lock-quoted-subshell end)))))) + (prog1 start (setq start (point))) (point))))) + (if (match-beginning 2) + ;; FIXME: actually, once we see an heredoc opener, we should just + ;; search for its ender without propertizing anything in it. + (sh-font-lock-open-heredoc + (match-beginning 0) (match-string 1) (match-beginning 2)) + (sh-font-lock-close-heredoc + (match-beginning 0) (match-string 4) + (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))) + (match-beginning 5))))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1553,9 +1550,12 @@ sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil - (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords) (font-lock-syntactic-face-function . sh-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'sh-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`))) (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p) (set (make-local-variable 'skeleton-further-elements)
--- a/lisp/progmodes/simula.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/simula.el Thu Sep 16 11:11:13 2010 +0900 @@ -163,17 +163,18 @@ (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.") -(defconst simula-font-lock-syntactic-keywords - `(;; `comment' directive. - ("\\<\\(c\\)omment\\>" 1 "<") - ;; end comments - (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" - (regexp-opt '("end" "else" "when" "otherwise")) - "\\)\\)") - (1 "< b") - (3 "> b" nil t)) - ;; non-quoted single-quote char. - ("'\\('\\)'" 1 "."))) +(defconst simula-syntax-propertize-function + (syntax-propertize-rules + ;; `comment' directive. + ("\\<\\(c\\)omment\\>" (1 "<")) + ;; end comments + ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" + (regexp-opt '("end" "else" "when" "otherwise")) + "\\)\\)") + (1 "< b") + (3 "> b")) + ;; non-quoted single-quote char. + ("'\\('\\)'" (1 ".")))) ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>. (defconst simula-font-lock-keywords-1 @@ -396,8 +397,9 @@ (setq font-lock-defaults '((simula-font-lock-keywords simula-font-lock-keywords-1 simula-font-lock-keywords-2 simula-font-lock-keywords-3) - nil t ((?_ . "w")) nil - (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords))) + nil t ((?_ . "w")))) + (set (make-local-variable 'syntax-propertize-function) + simula-syntax-propertize-function) (abbrev-mode 1)) (defun simula-indent-exp ()
--- a/lisp/progmodes/sql.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/sql.el Thu Sep 16 11:11:13 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.5 +;; Version: 2.7 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode @@ -187,10 +187,10 @@ ;; 6) Define a convienence function to invoke the SQL interpreter. -;; (defun my-sql-xyz () +;; (defun my-sql-xyz (&optional buffer) ;; "Run ixyz by XyzDB as an inferior process." -;; (interactive) -;; (sql-product-interactive 'xyz)) +;; (interactive "P") +;; (sql-product-interactive 'xyz buffer)) ;;; To Do: @@ -275,8 +275,8 @@ :group 'SQL :safe 'stringp) -(defcustom sql-port nil - "Default server or host." +(defcustom sql-port 0 + "Default port." :version "24.1" :type 'number :group 'SQL @@ -430,9 +430,9 @@ :sqli-comint-func sql-comint-postgres :prompt-regexp "^.*=[#>] " :prompt-length 5 - :prompt-cont-regexp "^.*-[#>] " + :prompt-cont-regexp "^.*[-(][#>] " :input-filter sql-remove-tabs-filter - :terminator ("\\(^[\\]g\\|;\\)" . ";")) + :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";")) (solid :name "Solid" @@ -551,7 +551,6 @@ (defvar sql-indirect-features '(:font-lock :sqli-program :sqli-options :sqli-login)) -;;;###autoload (defcustom sql-connection-alist nil "An alist of connection parameters for interacting with a SQL product. @@ -600,7 +599,6 @@ :version "24.1" :group 'SQL) -;;;###autoload (defcustom sql-product 'ansi "Select the SQL database product used so that buffers can be highlighted properly when you open them." @@ -613,6 +611,7 @@ sql-product-alist)) :group 'SQL :safe 'symbolp) +(defvaralias 'sql-dialect 'sql-product) ;; misc customization of sql.el behaviour @@ -788,7 +787,9 @@ ;; Customization for SQLite -(defcustom sql-sqlite-program "sqlite3" +(defcustom sql-sqlite-program (or (executable-find "sqlite3") + (executable-find "sqlite") + "sqlite") "Command to start SQLite. Starts `sql-interactive-mode' after doing some setup." @@ -801,7 +802,7 @@ :version "20.8" :group 'SQL) -(defcustom sql-sqlite-login-params '((database :file ".*\\.db")) +(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)")) "List of login parameters needed to connect to SQLite." :type 'sql-login-params :version "24.1" @@ -1022,9 +1023,6 @@ (defvar sql-server-history nil "History of servers used.") -(defvar sql-port-history nil - "History of ports used.") - ;; Passwords are not kept in a history. (defvar sql-buffer nil @@ -1054,6 +1052,25 @@ Used by `sql-rename-buffer'.") +(defun sql-buffer-live-p (buffer &optional product) + "Returns non-nil if the process associated with buffer is live. + +BUFFER can be a buffer object or a buffer name. The buffer must +be a live buffer, have an running process attached to it, be in +`sql-interactive-mode', and, if PRODUCT is specified, it's +`sql-product' must match." + + (when buffer + (setq buffer (get-buffer buffer)) + (and buffer + (buffer-live-p buffer) + (get-buffer-process buffer) + (comint-check-proc buffer) + (with-current-buffer buffer + (and (derived-mode-p 'sql-product-interactive) + (or (not product) + (eq product sql-product))))))) + ;; Keymap for sql-interactive-mode. (defvar sql-interactive-mode-map @@ -1091,15 +1108,11 @@ sql-mode-menu sql-mode-map "Menu for `sql-mode'." `("SQL" - ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)] ["Send Region" sql-send-region (and mark-active - (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send String" sql-send-string (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + (sql-buffer-live-p sql-buffer))] + ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)] + ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)] "--" ["Start SQLi session" sql-product-interactive :visible (not sql-connection-alist) @@ -1364,7 +1377,7 @@ ;; Oracle SQL*Plus Commands (cons (concat - "^\\(?:\\(?:" (regexp-opt '( + "^\\s-*\\(?:\\(?:" (regexp-opt '( "@" "@@" "accept" "append" "archive" "attribute" "break" "btitle" "change" "clear" "column" "connect" "copy" "define" "del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" @@ -1403,7 +1416,7 @@ "\\)\\b.*" ) 'font-lock-doc-face) - '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face) + '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil @@ -1585,81 +1598,153 @@ (defvar sql-mode-postgres-font-lock-keywords (eval-when-compile (list - ;; Postgres Functions + ;; Postgres psql commands + '("^\\s-*\\\\.*$" . font-lock-doc-face) + + ;; Postgres unreserved words but may have meaning + (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a" +"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg" +"asensitive" "atomic" "attribute" "attributes" "avg" "base64" +"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c" +"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length" +"character_length" "character_set_catalog" "character_set_name" +"character_set_schema" "characters" "checked" "class_origin" "clob" +"cobol" "collation" "collation_catalog" "collation_name" +"collation_schema" "collect" "column_name" "columns" +"command_function" "command_function_code" "completion" "condition" +"condition_number" "connect" "connection_name" "constraint_catalog" +"constraint_name" "constraint_schema" "constructor" "contains" +"control" "convert" "corr" "corresponding" "count" "covar_pop" +"covar_samp" "cube" "cume_dist" "current_default_transform_group" +"current_path" "current_transform_group_for_type" "cursor_name" +"datalink" "datetime_interval_code" "datetime_interval_precision" "db" +"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe" +"descriptor" "destroy" "destructor" "deterministic" "diagnostics" +"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete" +"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly" +"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic" +"dynamic_function" "dynamic_function_code" "element" "empty" +"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file" +"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free" +"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping" +"hex" "hierarchy" "host" "id" "ignore" "implementation" "import" +"indent" "indicator" "infix" "initialize" "instance" "instantiable" +"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag" +"last_value" "lateral" "lead" "length" "less" "library" "like_regex" +"link" "ln" "locator" "lower" "m" "map" "matched" "max" +"max_cardinality" "member" "merge" "message_length" +"message_octet_length" "message_text" "method" "min" "mod" "modifies" +"modify" "module" "more" "multiset" "mumps" "namespace" "nclob" +"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize" +"normalized" "nth_value" "ntile" "nullable" "number" +"occurrences_regex" "octet_length" "octets" "old" "open" "operation" +"ordering" "ordinality" "others" "output" "overriding" "p" "pad" +"parameter" "parameter_mode" "parameter_name" +"parameter_ordinal_position" "parameter_specific_catalog" +"parameter_specific_name" "parameter_specific_schema" "parameters" +"pascal" "passing" "passthrough" "percent_rank" "percentile_cont" +"percentile_disc" "permission" "pli" "position_regex" "postfix" +"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref" +"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept" +"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring" +"respect" "restore" "result" "return" "returned_cardinality" +"returned_length" "returned_octet_length" "returned_sqlstate" "rollup" +"routine" "routine_catalog" "routine_name" "routine_schema" +"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog" +"scope_name" "scope_schema" "section" "selective" "self" "sensitive" +"server_name" "sets" "size" "source" "space" "specific" +"specific_name" "specifictype" "sql" "sqlcode" "sqlerror" +"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static" +"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin" +"sublist" "submultiset" "substring_regex" "sum" "system_user" "t" +"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour" +"timezone_minute" "token" "top_level_count" "transaction_active" +"transactions_committed" "transactions_rolled_back" "transform" +"transforms" "translate" "translate_regex" "translation" +"trigger_catalog" "trigger_name" "trigger_schema" "trim_array" +"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri" +"usage" "user_defined_type_catalog" "user_defined_type_code" +"user_defined_type_name" "user_defined_type_schema" "var_pop" +"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within" +"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration" +"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery" +"xmlschema" "xmltable" "xmltext" "xmlvalidate" +) + + ;; Postgres non-reserved words (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan" -"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil" -"center" "char_length" "chr" "coalesce" "col_description" "convert" -"cos" "cot" "count" "current_database" "current_date" "current_schema" -"current_schemas" "current_setting" "current_time" "current_timestamp" -"current_user" "currval" "date_part" "date_trunc" "decode" "degrees" -"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte" -"has_database_privilege" "has_function_privilege" -"has_language_privilege" "has_schema_privilege" "has_table_privilege" -"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading" -"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad" -"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval" -"now" "npoints" "nullif" "obj_description" "octet_length" "overlay" -"pclose" "pg_client_encoding" "pg_function_is_visible" -"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef" -"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible" -"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible" -"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians" -"radius" "random" "repeat" "replace" "round" "rpad" "rtrim" -"session_user" "set_bit" "set_byte" "set_config" "set_masklen" -"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr" -"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date" -"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim" -"trunc" "upper" "variance" "version" "width" +"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate" +"also" "alter" "always" "assertion" "assignment" "at" "backward" +"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded" +"catalog" "chain" "characteristics" "checkpoint" "class" "close" +"cluster" "coalesce" "comment" "comments" "commit" "committed" +"configuration" "connection" "constraints" "content" "continue" +"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv" +"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec" +"declare" "defaults" "deferred" "definer" "delete" "delimiter" +"delimiters" "dictionary" "disable" "discard" "document" "domain" +"drop" "each" "enable" "encoding" "encrypted" "enum" "escape" +"exclude" "excluding" "exclusive" "execute" "exists" "explain" +"external" "extract" "family" "first" "float" "following" "force" +"forward" "function" "functions" "global" "granted" "greatest" +"handler" "header" "hold" "hour" "identity" "if" "immediate" +"immutable" "implicit" "including" "increment" "index" "indexes" +"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert" +"instead" "invoker" "isolation" "key" "language" "large" "last" +"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local" +"location" "lock" "login" "mapping" "match" "maxvalue" "minute" +"minvalue" "mode" "month" "move" "name" "names" "national" "nchar" +"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit" +"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif" +"nulls" "object" "of" "oids" "operator" "option" "options" "out" +"overlay" "owned" "owner" "parser" "partial" "partition" "password" +"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior" +"privileges" "procedural" "procedure" "quote" "range" "read" +"reassign" "recheck" "recursive" "reindex" "relative" "release" +"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict" +"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint" +"schema" "scroll" "search" "second" "security" "sequence" "sequences" +"serializable" "server" "session" "set" "setof" "share" "show" +"simple" "stable" "standalone" "start" "statement" "statistics" +"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser" +"sysid" "system" "tables" "tablespace" "temp" "template" "temporary" +"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type" +"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until" +"update" "vacuum" "valid" "validator" "value" "values" "version" +"view" "volatile" "whitespace" "work" "wrapper" "write" +"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse" +"xmlpi" "xmlroot" "xmlserialize" "year" "yes" ) + ;; Postgres Reserved (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter" -"analyze" "and" "any" "as" "asc" "assignment" "authorization" -"backward" "basetype" "before" "begin" "between" "binary" "by" "cache" -"called" "cascade" "case" "cast" "characteristics" "check" -"checkpoint" "class" "close" "cluster" "column" "comment" "commit" -"committed" "commutator" "constraint" "constraints" "conversion" -"copy" "create" "createdb" "createuser" "cursor" "cycle" "database" -"deallocate" "declare" "default" "deferrable" "deferred" "definer" -"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each" -"element" "else" "encoding" "encrypted" "end" "escape" "except" -"exclusive" "execute" "exists" "explain" "extended" "external" "false" -"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from" -"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having" -"immediate" "immutable" "implicit" "in" "increment" "index" "inherits" -"initcond" "initially" "input" "insensitive" "insert" "instead" -"internallength" "intersect" "into" "invoker" "is" "isnull" -"isolation" "join" "key" "language" "leftarg" "level" "like" "limit" -"listen" "load" "local" "location" "lock" "ltcmp" "main" "match" -"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator" -"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify" -"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or" -"order" "output" "owner" "partial" "passedbyvalue" "password" "plain" -"prepare" "primary" "prior" "privileges" "procedural" "procedure" -"public" "read" "recheck" "references" "reindex" "relative" "rename" -"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row" -"rule" "schema" "scroll" "security" "select" "sequence" "serializable" -"session" "set" "sfunc" "share" "show" "similar" "some" "sort1" -"sort2" "stable" "start" "statement" "statistics" "storage" "strict" -"stype" "sysid" "table" "temp" "template" "temporary" "then" "to" -"transaction" "trigger" "true" "truncate" "trusted" "type" -"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update" -"usage" "user" "using" "vacuum" "valid" "validator" "values" -"variable" "verbose" "view" "volatile" "when" "where" "with" "without" -"work" +"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric" +"authorization" "binary" "both" "case" "cast" "check" "collate" +"column" "concurrently" "constraint" "create" "cross" +"current_catalog" "current_date" "current_role" "current_schema" +"current_time" "current_timestamp" "current_user" "default" +"deferrable" "desc" "distinct" "do" "else" "end" "except" "false" +"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group" +"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull" +"is" "join" "leading" "left" "like" "limit" "localtime" +"localtimestamp" "natural" "notnull" "not" "null" "off" "offset" +"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary" +"references" "returning" "right" "select" "session_user" "similar" +"some" "symmetric" "table" "then" "to" "trailing" "true" "union" +"unique" "user" "using" "variadic" "verbose" "when" "where" "window" +"with" ) ;; Postgres Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char" -"character" "cidr" "circle" "cstring" "date" "decimal" "double" -"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal" -"interval" "language_handler" "line" "lseg" "macaddr" "money" -"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real" -"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure" -"regtype" "serial" "serial4" "serial8" "smallint" "text" "time" -"timestamp" "varchar" "varying" "void" "zone" +"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char" +"character" "cidr" "circle" "date" "decimal" "double" "float4" +"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line" +"lseg" "macaddr" "money" "numeric" "path" "point" "polygon" +"precision" "real" "serial" "serial4" "serial8" "smallint" "text" +"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector" +"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without" +"xml" "zone" ))) "Postgres SQL keywords used by font-lock. @@ -1979,6 +2064,9 @@ (defvar sql-mode-sqlite-font-lock-keywords (eval-when-compile (list + ;; SQLite commands + '("^[.].*$" . font-lock-doc-face) + ;; SQLite Keyword (sql-font-lock-keywords-builder 'font-lock-keyword-face nil "abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" @@ -2493,29 +2581,31 @@ ((eq token 'port) ; port (setq sql-port - (read-number "Port: " sql-port)))))) - what)) + (read-number "Port: " (if (numberp sql-port) + sql-port + 0))))))) + what)) (defun sql-find-sqli-buffer () - "Returns the current default SQLi buffer or nil. -In order to qualify, the SQLi buffer must be alive, -be in `sql-interactive-mode' and have a process." - (let ((default-buffer (default-value 'sql-buffer))) - (if (and (buffer-live-p default-buffer) - (get-buffer-process default-buffer)) - default-buffer - (save-current-buffer - (let ((buflist (buffer-list)) - (found)) - (while (not (or (null buflist) - found)) - (let ((candidate (car buflist))) - (set-buffer candidate) - (if (and (derived-mode-p 'sql-interactive-mode) - (get-buffer-process candidate)) - (setq found candidate)) - (setq buflist (cdr buflist)))) - found))))) + "Returns the name of the current default SQLi buffer or nil. +In order to qualify, the SQLi buffer must be alive, be in +`sql-interactive-mode' and have a process." + (let ((buf sql-buffer) + (prod sql-product)) + (or + ;; Current sql-buffer, if there is one. + (and (sql-buffer-live-p buf prod) + buf) + ;; Global sql-buffer + (and (setq buf (default-value 'sql-buffer)) + (sql-buffer-live-p buf prod) + buf) + ;; Look thru each buffer + (car (apply 'append + (mapcar (lambda (b) + (and (sql-buffer-live-p b prod) + (list (buffer-name b)))) + (buffer-list))))))) (defun sql-set-sqli-buffer-generally () "Set SQLi buffer for all SQL buffers that have none. @@ -2527,16 +2617,17 @@ (interactive) (save-excursion (let ((buflist (buffer-list)) - (default-sqli-buffer (sql-find-sqli-buffer))) - (setq-default sql-buffer default-sqli-buffer) + (default-buffer (sql-find-sqli-buffer))) + (setq-default sql-buffer default-buffer) (while (not (null buflist)) (let ((candidate (car buflist))) (set-buffer candidate) (if (and (derived-mode-p 'sql-mode) - (not (buffer-live-p sql-buffer))) + (not (sql-buffer-live-p sql-buffer))) (progn - (setq sql-buffer default-sqli-buffer) - (run-hooks 'sql-set-sqli-hook)))) + (setq sql-buffer default-buffer) + (when default-buffer + (run-hooks 'sql-set-sqli-hook))))) (setq buflist (cdr buflist)))))) (defun sql-set-sqli-buffer () @@ -2554,19 +2645,13 @@ (interactive) (let ((default-buffer (sql-find-sqli-buffer))) (if (null default-buffer) - (error "There is no suitable SQLi buffer")) - (let ((new-buffer - (get-buffer - (read-buffer "New SQLi buffer: " default-buffer t)))) - (if (null (get-buffer-process new-buffer)) - (error "Buffer %s has no process" (buffer-name new-buffer))) - (if (null (with-current-buffer new-buffer - (equal major-mode 'sql-interactive-mode))) - (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer))) - (if new-buffer - (progn - (setq sql-buffer new-buffer) - (run-hooks 'sql-set-sqli-hook)))))) + (error "There is no suitable SQLi buffer") + (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t))) + (if (null (sql-buffer-live-p new-buffer)) + (error "Buffer %s is not a working SQLi buffer" new-buffer) + (when new-buffer + (setq sql-buffer new-buffer) + (run-hooks 'sql-set-sqli-hook))))))) (defun sql-show-sqli-buffer () "Show the name of current SQLi buffer. @@ -2574,11 +2659,11 @@ This is the buffer SQL strings are sent to. It is stored in the variable `sql-buffer'. See `sql-help' on how to create such a buffer." (interactive) - (if (null (buffer-live-p sql-buffer)) + (if (null (buffer-live-p (get-buffer sql-buffer))) (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) (if (null (get-buffer-process sql-buffer)) - (message "Buffer %s has no process." (buffer-name sql-buffer)) - (message "Current SQLi buffer is %s." (buffer-name sql-buffer))))) + (message "Buffer %s has no process." sql-buffer) + (message "Current SQLi buffer is %s." sql-buffer)))) (defun sql-make-alternate-buffer-name () "Return a string that can be used to rename a SQLi buffer. @@ -2610,8 +2695,9 @@ (unless (string= "" sql-user) (list "/" sql-user))) ((eq token 'port) - (unless (= 0 sql-port) - (list ":" sql-port))) + (unless (or (not (numberp sql-port)) + (= 0 sql-port)) + (list ":" (number-to-string sql-port)))) ((eq token 'server) (unless (string= "" sql-server) (list "." @@ -2619,7 +2705,7 @@ (file-name-nondirectory sql-server) sql-server)))) ((eq token 'database) - (when (string= "" sql-database) + (unless (string= "" sql-database) (list "@" (if (eq type :file) (file-name-nondirectory sql-database) @@ -2649,10 +2735,32 @@ ;; Use the name we've got name)))) -(defun sql-rename-buffer () - "Rename a SQLi buffer." - (interactive) - (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t)) +(defun sql-rename-buffer (&optional new-name) + "Rename a SQL interactive buffer. + +Prompts for the new name if command is preceeded by +\\[universal-argument]. If no buffer name is provided, then the +`sql-alternate-buffer-name' is used. + +The actual buffer name set will be \"*SQL: NEW-NAME*\". If +NEW-NAME is empty, then the buffer name will be \"*SQL*\"." + (interactive "P") + + (if (not (derived-mode-p 'sql-interactive-mode)) + (message "Current buffer is not a SQL interactive buffer") + + (setq sql-alternate-buffer-name + (cond + ((stringp new-name) new-name) + ((consp new-name) + (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " + sql-alternate-buffer-name)) + (t sql-alternate-buffer-name))) + + (rename-buffer (if (string= "" sql-alternate-buffer-name) + "*SQL*" + (format "*SQL: %s*" sql-alternate-buffer-name)) + t))) (defun sql-copy-column () "Copy current column to the end of buffer. @@ -2801,7 +2909,7 @@ (let ((comint-input-sender-no-newline nil) (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str))) - (if (buffer-live-p sql-buffer) + (if (sql-buffer-live-p sql-buffer) (progn ;; Ignore the hoping around... (save-excursion @@ -2814,7 +2922,7 @@ (if sql-send-terminator (sql-send-magic-terminator sql-buffer s sql-send-terminator)) - (message "Sent string to buffer %s." (buffer-name sql-buffer)))) + (message "Sent string to buffer %s." sql-buffer))) ;; Display the sql buffer (if sql-pop-to-buffer-after-send-region @@ -2893,6 +3001,91 @@ +;;; Redirect output functions + +(defun sql-redirect (command combuf &optional outbuf save-prior) + "Execute the SQL command and send output to OUTBUF. + +COMBUF must be an active SQL interactive buffer. OUTBUF may be +an existing buffer, or the name of a non-existing buffer. If +omitted the output is sent to a temporary buffer which will be +killed after the command completes. COMMAND should be a string +of commands accepted by the SQLi program." + + (with-current-buffer combuf + (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*"))) + (proc (get-buffer-process (current-buffer))) + (comint-prompt-regexp (sql-get-product-feature sql-product + :prompt-regexp)) + (start nil)) + (with-current-buffer buf + (unless save-prior + (erase-buffer)) + (goto-char (point-max)) + (setq start (point))) + + ;; Run the command + (comint-redirect-send-command-to-process command buf proc nil t) + (while (null comint-redirect-completed) + (accept-process-output nil 1)) + + ;; Remove echo if there was one + (with-current-buffer buf + (goto-char start) + (when (looking-at (concat "^" (regexp-quote command) "[\\n]")) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char start))))) + +(defun sql-redirect-value (command combuf regexp &optional regexp-groups) + "Execute the SQL command and return part of result. + +COMBUF must be an active SQL interactive buffer. COMMAND should +be a string of commands accepted by the SQLi program. From the +output, the REGEXP is repeatedly matched and the list of +REGEXP-GROUPS submatches is returned. This behaves much like +\\[comint-redirect-results-list-from-process] but instead of +returning a single submatch it returns a list of each submatch +for each match." + + (let ((outbuf " *SQL-Redirect-values*") + (results nil)) + (sql-redirect command combuf outbuf nil) + (with-current-buffer outbuf + (while (re-search-forward regexp nil t) + (push + (cond + ;; no groups-return all of them + ((null regexp-groups) + (let ((i 1) + (r nil)) + (while (match-beginning i) + (push (match-string i) r)) + (nreverse r))) + ;; one group specified + ((numberp regexp-groups) + (match-string regexp-groups)) + ;; (buffer-substring-no-properties + ;; (match-beginning regexp-groups) + ;; (match-end regexp-groups))) + ;; list of numbers; return the specified matches only + ((consp regexp-groups) + (mapcar (lambda (c) + (cond + ((numberp c) (match-string c)) + ((stringp c) (match-substitute-replacement c)) + (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c)))) + regexp-groups)) + ;; String is specified; return replacement string + ((stringp regexp-groups) + (match-substitute-replacement regexp-groups)) + (t + (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" + regexp-groups))) + results))) + (nreverse results))) + + + ;;; SQL mode -- uses SQL interactive mode ;;;###autoload @@ -3063,7 +3256,7 @@ (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. - (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop) + (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) ;; Save the connection name (make-local-variable 'sql-connection) ;; Create a usefull name for renaming this buffer later. @@ -3248,49 +3441,57 @@ ;;; Entry functions for different SQL interpreters. ;;;###autoload -(defun sql-product-interactive (&optional product) +(defun sql-product-interactive (&optional product new-name) "Run PRODUCT interpreter as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. If buffer exists and a process is running, just switch to buffer `*SQL*'. +To specify the SQL product, prefix the call with +\\[universal-argument]. To set the buffer name as well, prefix +the call to \\[sql-product-interactive] with +\\[universal-argument] \\[universal-argument]. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" (interactive "P") + ;; Handle universal arguments if specified + (when (not (or executing-kbd-macro noninteractive)) + (when (and (consp product) + (not (cdr product)) + (numberp (car product))) + (when (>= (car product) 16) + (when (not new-name) + (setq new-name '(4))) + (setq product '(4))))) + + ;; Get the value of product that we need (setq product (cond - ((equal product '(4)) ; Universal arg, prompt for product + ((equal product '(4)) ; C-u, prompt for product (intern (completing-read "SQL product: " (mapcar (lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match - (or (and sql-product (symbol-name sql-product)) "ansi")))) + (or (and sql-product + (symbol-name sql-product)) + "ansi")))) ((and product ; Product specified (symbolp product)) product) (t sql-product))) ; Default to sql-product + ;; If we have a product and it has a interactive mode (if product (when (sql-get-product-feature product :sqli-comint-func) - (if (and sql-buffer - (buffer-live-p sql-buffer) - (comint-check-proc sql-buffer)) + ;; If no new name specified, fall back on sql-buffer if its for + ;; the same product + (if (and (not new-name) + (sql-buffer-live-p sql-buffer product)) (pop-to-buffer sql-buffer) - ;; Is the current buffer in sql-mode and - ;; there is a buffer local setting of sql-buffer - (let* ((start-buffer - (and (derived-mode-p 'sql-mode) - (current-buffer))) - (start-sql-buffer - (and start-buffer - (let (found) - (dolist (var (buffer-local-variables)) - (and (consp var) - (eq (car var) 'sql-buffer) - (buffer-live-p (cdr var)) - (get-buffer-process (cdr var)) - (setq found (cdr var)))) - found))) + ;; We have a new name or sql-buffer doesn't exist or match + ;; Start by remembering where we start + (let* ((start-buffer (current-buffer)) new-sqli-buffer) ;; Get credentials. @@ -3303,15 +3504,19 @@ (sql-get-product-feature product :sqli-options)) ;; Set SQLi mode. - (setq sql-interactive-product product - new-sqli-buffer (current-buffer) - sql-buffer new-sqli-buffer) - (sql-interactive-mode) - - ;; Set `sql-buffer' in the start buffer - (when (and start-buffer (not start-sql-buffer)) - (with-current-buffer start-buffer - (setq sql-buffer new-sqli-buffer))) + (setq new-sqli-buffer (current-buffer)) + (let ((sql-interactive-product product)) + (sql-interactive-mode)) + + ;; Set the new buffer name + (when new-name + (sql-rename-buffer new-name)) + + ;; Set `sql-buffer' in the new buffer and the start buffer + (setq sql-buffer (buffer-name new-sqli-buffer)) + (with-current-buffer start-buffer + (setq sql-buffer (buffer-name new-sqli-buffer)) + (run-hooks 'sql-set-sqli-hook)) ;; All done. (message "Login...done") @@ -3323,12 +3528,22 @@ PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments." - (let ((program (sql-get-product-feature product :sqli-program))) + (let ((program (sql-get-product-feature product :sqli-program)) + (buf-name "SQL")) + ;; Make sure buffer name is unique + (when (get-buffer (format "*%s*" buf-name)) + (setq buf-name (format "SQL-%s" product)) + (when (get-buffer (format "*%s*" buf-name)) + (let ((i 1)) + (while (get-buffer (format "*%s*" + (setq buf-name + (format "SQL-%s%d" product i)))) + (setq i (1+ i)))))) (set-buffer - (apply 'make-comint "SQL" program nil params)))) + (apply 'make-comint buf-name program nil params)))) ;;;###autoload -(defun sql-oracle () +(defun sql-oracle (&optional buffer) "Run sqlplus by Oracle as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3343,6 +3558,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-oracle]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3351,8 +3571,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'oracle)) + (interactive "P") + (sql-product-interactive 'oracle buffer)) (defun sql-comint-oracle (product options) "Create comint buffer and connect to Oracle." @@ -3375,7 +3595,7 @@ ;;;###autoload -(defun sql-sybase () +(defun sql-sybase (&optional buffer) "Run isql by Sybase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3390,6 +3610,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sybase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3398,8 +3623,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sybase)) + (interactive "P") + (sql-product-interactive 'sybase buffer)) (defun sql-comint-sybase (product options) "Create comint buffer and connect to Sybase." @@ -3419,7 +3644,7 @@ ;;;###autoload -(defun sql-informix () +(defun sql-informix (&optional buffer) "Run dbaccess by Informix as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3432,6 +3657,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-informix]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3440,8 +3670,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'informix)) + (interactive "P") + (sql-product-interactive 'informix buffer)) (defun sql-comint-informix (product options) "Create comint buffer and connect to Informix." @@ -3456,7 +3686,7 @@ ;;;###autoload -(defun sql-sqlite () +(defun sql-sqlite (&optional buffer) "Run sqlite as an inferior process. SQLite is free software. @@ -3473,6 +3703,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sqlite]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3481,8 +3716,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sqlite)) + (interactive "P") + (sql-product-interactive 'sqlite buffer)) (defun sql-comint-sqlite (product options) "Create comint buffer and connect to SQLite." @@ -3498,7 +3733,7 @@ ;;;###autoload -(defun sql-mysql () +(defun sql-mysql (&optional buffer) "Run mysql by TcX as an inferior process. Mysql versions 3.23 and up are free software. @@ -3515,6 +3750,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mysql]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3523,8 +3763,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'mysql)) + (interactive "P") + (sql-product-interactive 'mysql buffer)) (defun sql-comint-mysql (product options) "Create comint buffer and connect to MySQL." @@ -3535,7 +3775,7 @@ (setq params (append (list sql-database) params))) (if (not (string= "" sql-server)) (setq params (append (list (concat "--host=" sql-server)) params))) - (if (and sql-port (numberp sql-port)) + (if (not (= 0 sql-port)) (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) (if (not (string= "" sql-password)) (setq params (append (list (concat "--password=" sql-password)) params))) @@ -3547,7 +3787,7 @@ ;;;###autoload -(defun sql-solid () +(defun sql-solid (&optional buffer) "Run solsql by Solid as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3561,6 +3801,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-solid]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3569,8 +3814,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'solid)) + (interactive "P") + (sql-product-interactive 'solid buffer)) (defun sql-comint-solid (product options) "Create comint buffer and connect to Solid." @@ -3588,7 +3833,7 @@ ;;;###autoload -(defun sql-ingres () +(defun sql-ingres (&optional buffer) "Run sql by Ingres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3601,6 +3846,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ingres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3609,8 +3859,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ingres)) + (interactive "P") + (sql-product-interactive 'ingres buffer)) (defun sql-comint-ingres (product options) "Create comint buffer and connect to Ingres." @@ -3624,7 +3874,7 @@ ;;;###autoload -(defun sql-ms () +(defun sql-ms (&optional buffer) "Run osql by Microsoft as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3639,6 +3889,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ms]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3647,8 +3902,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ms)) + (interactive "P") + (sql-product-interactive 'ms buffer)) (defun sql-comint-ms (product options) "Create comint buffer and connect to Microsoft SQL Server." @@ -3675,7 +3930,7 @@ ;;;###autoload -(defun sql-postgres () +(defun sql-postgres (&optional buffer) "Run psql by Postgres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3690,6 +3945,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-postgres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3703,8 +3963,8 @@ '(comint-strip-ctrl-m))) \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'postgres)) + (interactive "P") + (sql-product-interactive 'postgres buffer)) (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." @@ -3725,7 +3985,7 @@ ;;;###autoload -(defun sql-interbase () +(defun sql-interbase (&optional buffer) "Run isql by Interbase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3739,6 +3999,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-interbase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3747,8 +4012,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'interbase)) + (interactive "P") + (sql-product-interactive 'interbase buffer)) (defun sql-comint-interbase (product options) "Create comint buffer and connect to Interbase." @@ -3766,7 +4031,7 @@ ;;;###autoload -(defun sql-db2 () +(defun sql-db2 (&optional buffer) "Run db2 by IBM as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3784,6 +4049,11 @@ `comint-input-sender' back to `comint-simple-send' by writing an after advice. See the elisp manual for more information. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-db2]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3792,8 +4062,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'db2)) + (interactive "P") + (sql-product-interactive 'db2 buffer)) (defun sql-comint-db2 (product options) "Create comint buffer and connect to DB2." @@ -3801,11 +4071,9 @@ ;; make-comint. (sql-comint product options) ) -;; ;; Properly escape newlines when DB2 is interactive. -;; (setq comint-input-sender 'sql-escape-newlines-and-send)) ;;;###autoload -(defun sql-linter () +(defun sql-linter (&optional buffer) "Run inl by RELEX as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3827,9 +4095,14 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-linter]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'linter)) + (interactive "P") + (sql-product-interactive 'linter buffer)) (defun sql-comint-linter (product options) "Create comint buffer and connect to Linter."
--- a/lisp/progmodes/tcl.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/tcl.el Thu Sep 16 11:11:13 2010 +0900 @@ -411,9 +411,10 @@ `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") -(defvar tcl-font-lock-syntactic-keywords - ;; Mark the few `#' that are not comment-markers. - '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) +(defconst tcl-syntax-propertize-function + (syntax-propertize-rules + ;; Mark the few `#' that are not comment-markers. + ("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) "Syntactic keywords for `tcl-mode'.") ;; FIXME need some way to recognize variables because array refs look @@ -593,9 +594,9 @@ (set (make-local-variable 'outline-level) 'tcl-outline-level) (set (make-local-variable 'font-lock-defaults) - '(tcl-font-lock-keywords nil nil nil beginning-of-defun - (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + '(tcl-font-lock-keywords nil nil nil beginning-of-defun)) + (set (make-local-variable 'syntax-propertize-function) + tcl-syntax-propertize-function) (set (make-local-variable 'imenu-generic-expression) tcl-imenu-generic-expression)
--- a/lisp/progmodes/vhdl-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/progmodes/vhdl-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -4693,8 +4693,15 @@ (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules + ;; Mark single quotes as having string quote syntax in + ;; 'c' instances. + ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'")))) + (set (make-local-variable 'font-lock-syntactic-keywords) + vhdl-font-lock-syntactic-keywords)) (unless vhdl-emacs-21 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) @@ -12914,10 +12921,9 @@ "Re-initialize fontification and fontify buffer." (interactive) (setq font-lock-defaults - (list - 'vhdl-font-lock-keywords nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + `(vhdl-font-lock-keywords + nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) + beginning-of-line)) (when (fboundp 'font-lock-unset-defaults) (font-lock-unset-defaults)) ; not implemented in XEmacs (font-lock-set-defaults)
--- a/lisp/repeat.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/repeat.el Thu Sep 16 11:11:13 2010 +0900 @@ -335,7 +335,12 @@ (setq real-last-command 'repeat) (setq repeat-undo-count 1) (unwind-protect - (while (eq (read-event) repeat-repeat-char) + (while (let ((evt (read-event))) ;FIXME: read-key maybe? + ;; For clicks, we need to strip the meta-data to + ;; check the underlying event name. + (eq (or (car-safe evt) evt) + (or (car-safe repeat-repeat-char) + repeat-repeat-char))) (repeat repeat-arg)) ;; Make sure `repeat-undo-count' is reset. (setq repeat-undo-count nil))
--- a/lisp/simple.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/simple.el Thu Sep 16 11:11:13 2010 +0900 @@ -4343,7 +4343,7 @@ (or (and (= (vertical-motion (cons (or goal-column (if (consp temporary-goal-column) - (truncate (car temporary-goal-column)) + (car temporary-goal-column) temporary-goal-column)) arg)) arg) @@ -5541,6 +5541,7 @@ (if (minibufferp) (minibuffer-message " [Unmatched parenthesis]") (message "Unmatched parenthesis")))) + ((not blinkpos) nil) ((pos-visible-in-window-p blinkpos) ;; Matching open within window, temporarily move to blinkpos but only ;; if `blink-matching-paren-on-screen' is non-nil.
--- a/lisp/subr.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/subr.el Thu Sep 16 11:11:13 2010 +0900 @@ -239,7 +239,7 @@ for the sake of consistency." (while t (signal 'error (list (apply 'format args))))) -(set-advertised-calling-convention 'error '(string &rest args)) +(set-advertised-calling-convention 'error '(string &rest args) "23.1") ;; We put this here instead of in frame.el so that it's defined even on ;; systems where frame.el isn't loaded. @@ -1039,9 +1039,10 @@ (make-obsolete 'make-variable-frame-local "explicitly check for a frame-parameter instead." "22.2") (make-obsolete 'interactive-p 'called-interactively-p "23.2") -(set-advertised-calling-convention 'called-interactively-p '(kind)) +(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1") (set-advertised-calling-convention - 'all-completions '(string collection &optional predicate)) + 'all-completions '(string collection &optional predicate) "23.1") +(set-advertised-calling-convention 'unintern '(name obarray) "23.3") ;;;; Obsolescence declarations for variables, and aliases. @@ -2064,7 +2065,7 @@ (setq read (cons t read))) (push read unread-command-events) nil)))))) -(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp)) +(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1") ;;; Atomic change groups. @@ -2592,7 +2593,7 @@ (start-process name buffer shell-file-name shell-command-switch (mapconcat 'identity args " "))) (set-advertised-calling-convention 'start-process-shell-command - '(name buffer command)) + '(name buffer command) "23.1") (defun start-file-process-shell-command (name buffer &rest args) "Start a program in a subprocess. Return the process object for it. @@ -2603,7 +2604,7 @@ (if (file-remote-p default-directory) "-c" shell-command-switch) (mapconcat 'identity args " "))) (set-advertised-calling-convention 'start-file-process-shell-command - '(name buffer command)) + '(name buffer command) "23.1") (defun call-process-shell-command (command &optional infile buffer display &rest args) @@ -3358,6 +3359,52 @@ (overlay-put ol2 'evaporate t) (overlay-put ol2 'text-clones dups))) +;;;; Misc functions moved over from the C side. + +(defun y-or-n-p (prompt) + "Ask user a \"y or n\" question. Return t if answer is \"y\". +The argument PROMPT is the string to display to ask the question. +It should end in a space; `y-or-n-p' adds `(y or n) ' to it. +No confirmation of the answer is requested; a single character is enough. +Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses +the bindings in `query-replace-map'; see the documentation of that variable +for more information. In this case, the useful bindings are `act', `skip', +`recenter', and `quit'.\) + +Under a windowing system a dialog box will be used if `last-nonmenu-event' +is nil and `use-dialog-box' is non-nil." + ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state + ;; where all the keys were unbound (i.e. it somehow got triggered + ;; within read-key, apparently). I had to kill it. + (let ((answer 'none) + (xprompt prompt)) + (if (and (display-popup-menus-p) + (listp last-nonmenu-event) + use-dialog-box) + (setq answer + (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip)))) + (while + (let* ((key + (let ((cursor-in-echo-area t)) + (when minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (read-key (propertize xprompt 'face 'minibuffer-prompt))))) + (setq answer (lookup-key query-replace-map (vector key) t)) + (cond + ((memq answer '(skip act)) nil) + ((eq answer 'recenter) (recenter) t) + ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) + (t t))) + (ding) + (discard-input) + (setq xprompt + (if (eq answer 'recenter) prompt + (concat "Please answer y or n. " prompt))))) + (let ((ret (eq answer 'act))) + (unless noninteractive + (message "%s %s" prompt (if ret "y" "n"))) + ret))) + ;;;; Mail user agents. ;; Here we include just enough for other packages to be able
--- a/lisp/textmodes/bibtex.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/bibtex.el Thu Sep 16 11:11:13 2010 +0900 @@ -3027,12 +3027,14 @@ ;; brace-delimited ones ) nil - (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) (font-lock-extra-managed-props . (category)) (font-lock-mark-block-function . (lambda () (set-mark (bibtex-end-of-entry)) (bibtex-beginning-of-entry))))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock + bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t)
--- a/lisp/textmodes/ispell.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/ispell.el Thu Sep 16 11:11:13 2010 +0900 @@ -1116,26 +1116,24 @@ (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist)) (dict-list (cons "default" nil)) - name load-dict) + name dict-bname) (dolist (dict dicts) (setq name (car dict) - load-dict (car (cdr (member "-d" (nth 5 dict))))) + dict-bname (or (car (cdr (member "-d" (nth 5 dict)))) + name)) ;; Include if the dictionary is in the library, or dir not defined. (if (and name - ;; include all dictionaries if lib directory not known. ;; For Aspell, we already know which dictionaries exist. (or ispell-really-aspell + ;; Include all dictionaries if lib directory not known. + ;; Same for Hunspell, where ispell-library-directory is nil. (not ispell-library-directory) (file-exists-p (concat ispell-library-directory - "/" name ".hash")) - (file-exists-p (concat ispell-library-directory "/" name ".has")) - (and load-dict - (or (file-exists-p (concat ispell-library-directory - "/" load-dict ".hash")) - (file-exists-p (concat ispell-library-directory - "/" load-dict ".has")))))) - (setq dict-list (cons name dict-list)))) + "/" dict-bname ".hash")) + (file-exists-p (concat ispell-library-directory + "/" dict-bname ".has")))) + (push name dict-list))) dict-list)) ;;; define commands in menu in opposite order you want them to appear. @@ -2676,24 +2674,27 @@ ispell-filter-continue nil ispell-process-directory default-directory) - ;; Kill ispell process when killing its associated buffer if using Ispell - ;; per-directory personal dictionaries. (unless (equal ispell-process-directory (expand-file-name "~/")) - (with-current-buffer - (if (and (window-minibuffer-p) - (fboundp 'minibuffer-selected-window)) ;; E.g. XEmacs. - ;; When spellchecking minibuffer contents, assign ispell - ;; process to parent buffer if known (not known for XEmacs). - ;; Use (buffer-name) otherwise. + ;; At this point, `ispell-process-directory' will be "~/" unless using + ;; Ispell with directory-specific dicts and not in XEmacs minibuffer. + ;; If not, kill ispell process when killing buffer. It may be in a + ;; removable device that would otherwise become un-mountable. + (with-current-buffer + (if (and (window-minibuffer-p) ;; In minibuffer + (fboundp 'minibuffer-selected-window)) ;; Not XEmacs. + ;; In this case kill ispell only when parent buffer is killed + ;; to avoid over and over ispell kill. (window-buffer (minibuffer-selected-window)) - (current-buffer)) - (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) - nil 'local))) + (current-buffer)) + ;; 'local does not automatically make hook buffer-local in XEmacs. + (if (featurep 'xemacs) + (make-local-hook 'kill-buffer-hook)) + (add-hook 'kill-buffer-hook + (lambda () (ispell-kill-ispell t)) nil 'local))) (if ispell-async-processp (set-process-filter ispell-process 'ispell-filter)) - ;; protect against bogus binding of `enable-multibyte-characters' in - ;; XEmacs. + ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'. (if (and (or (featurep 'xemacs) (and (boundp 'enable-multibyte-characters) enable-multibyte-characters)) @@ -2729,7 +2730,9 @@ (if extended-char-mode ; ~ extended character mode (ispell-send-string (concat extended-char-mode "\n")))) (if ispell-async-processp - (set-process-query-on-exit-flag ispell-process nil))))) + (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs + (set-process-query-on-exit-flag ispell-process nil) + (process-kill-without-query ispell-process)))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error)
--- a/lisp/textmodes/reftex.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/reftex.el Thu Sep 16 11:11:13 2010 +0900 @@ -599,7 +599,6 @@ (defvar font-lock-mode) (defvar font-lock-keywords) (defvar font-lock-fontify-region-function) -(defvar font-lock-syntactic-keywords) ;;; ========================================================================= ;;;
--- a/lisp/textmodes/sgml-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/sgml-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -293,11 +293,12 @@ (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") -(defvar sgml-font-lock-syntactic-keywords +(defconst sgml-syntax-propertize-function + (syntax-propertize-rules ;; Use the `b' style of comments to avoid interference with the -- ... -- ;; comments recognized when `sgml-specials' includes ?-. ;; FIXME: beware of <!--> blabla <!--> !! - '(("\\(<\\)!--" (1 "< b")) + ("\\(<\\)!--" (1 "< b")) ("--[ \t\n]*\\(>\\)" (1 "> b")) ;; Double quotes outside of tags should not introduce strings. ;; Be careful to call `syntax-ppss' on a position before the one we're @@ -477,9 +478,9 @@ '((sgml-font-lock-keywords sgml-font-lock-keywords-1 sgml-font-lock-keywords-2) - nil t nil nil - (font-lock-syntactic-keywords - . sgml-font-lock-syntactic-keywords))) + nil t)) + (set (make-local-variable 'syntax-propertize-function) + sgml-syntax-propertize-function) (set (make-local-variable 'facemenu-add-face-function) 'sgml-mode-facemenu-add-face-function) (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
--- a/lisp/textmodes/tex-mode.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/tex-mode.el Thu Sep 16 11:11:13 2010 +0900 @@ -488,7 +488,7 @@ ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) (list - ;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be + ;; tex-font-lock-syntactic-keywords causes the \ of \end{verbatim} to be ;; highlighted as tex-verbatim face. Let's undo that. ;; This is ugly and brittle :-( --Stef '("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t)) @@ -655,6 +655,7 @@ ;; line is re-font-locked on its own. ;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim ;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef + ;; FIXME: See gud.el for an example of a solution to a similar problem. (eval . `(,(concat "^\\(\\\\\\)end *{" (regexp-opt tex-verbatim-environments t) "}\\(.?\\)") (1 "|") (3 "<"))) @@ -1163,10 +1164,9 @@ (font-lock-syntactic-face-function . tex-font-lock-syntactic-face-function) (font-lock-unfontify-region-function - . tex-font-lock-unfontify-region) - (font-lock-syntactic-keywords - . tex-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + . tex-font-lock-unfontify-region))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock tex-font-lock-syntactic-keywords)) ;; TABs in verbatim environments don't do what you think. (set (make-local-variable 'indent-tabs-mode) nil) ;; Other vars that should be buffer-local. @@ -2850,12 +2850,12 @@ (mapcar (lambda (x) (case (car-safe x) - (font-lock-syntactic-keywords - (cons (car x) 'doctex-font-lock-syntactic-keywords)) (font-lock-syntactic-face-function (cons (car x) 'doctex-font-lock-syntactic-face-function)) (t x))) - (cdr font-lock-defaults))))) + (cdr font-lock-defaults)))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock doctex-font-lock-syntactic-keywords))) (run-hooks 'tex-mode-load-hook)
--- a/lisp/textmodes/texinfo.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/textmodes/texinfo.el Thu Sep 16 11:11:13 2010 +0900 @@ -310,10 +310,11 @@ ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.") -(defvar texinfo-font-lock-syntactic-keywords - '(("\\(@\\)c\\(omment\\)?\\>" (1 "<")) - ("^\\(@\\)ignore\\>" (1 "< b")) - ("^@end ignore\\(\n\\)" (1 "> b"))) +(defconst texinfo-syntax-propertize-function + (syntax-propertize-rules + ("\\(@\\)c\\(omment\\)?\\>" (1 "<")) + ("^\\(@\\)ignore\\>" (1 "< b")) + ("^@end ignore\\(\n\\)" (1 "> b"))) "Syntactic keywords to catch comment delimiters in `texinfo-mode'.") (defconst texinfo-environments @@ -600,9 +601,9 @@ (setq imenu-case-fold-search nil) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults - '(texinfo-font-lock-keywords nil nil nil backward-paragraph - (font-lock-syntactic-keywords - . texinfo-font-lock-syntactic-keywords))) + '(texinfo-font-lock-keywords nil nil nil backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + texinfo-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) ;; Outline settings.
--- a/lisp/url/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,20 @@ +2010-09-14 Julien Danjou <julien@danjou.info> + + * url-cache (url-store-in-cache): Make `buff' argument really optional. + +2010-09-14 Glenn Morris <rgm@gnu.org> + + * url-cookie.el (url-cookie-expired-p): Tweak previous change. + +2010-09-14 shawn boles <shawn.boles@gmail.com> (tiny change) + + * url-cookie.el (url-cookie-expired-p): Simplify and fix. (Bug#6957) + +2010-09-11 Glenn Morris <rgm@gnu.org> + + * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el: + * url-vars.el: Remove leading `*' from defcustom docs. + 2010-07-27 Michael Albinus <michael.albinus@gmx.de> * url-http (url-http-parse-headers): Disable file name handlers at
--- a/lisp/url/url-cache.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-cache.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -28,7 +28,7 @@ (defcustom url-cache-directory (expand-file-name "cache" url-configuration-directory) - "*The directory where cache files should be stored." + "The directory where cache files should be stored." :type 'directory :group 'url-file) @@ -62,14 +62,11 @@ ;;;###autoload (defun url-store-in-cache (&optional buff) "Store buffer BUFF in the cache." - (if (not (and buff (get-buffer buff))) - nil - (save-current-buffer - (and buff (set-buffer buff)) - (let* ((fname (url-cache-create-filename (url-view-url t)))) - (if (url-cache-prepare fname) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) fname nil 5))))))) + (with-current-buffer (get-buffer (or buff (current-buffer))) + (let ((fname (url-cache-create-filename (url-view-url t)))) + (if (url-cache-prepare fname) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) fname nil 5)))))) ;;;###autoload (defun url-is-cached (url) @@ -165,7 +162,7 @@ url-cache-directory)))))) (defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 - "*What function to use to create a cached filename." + "What function to use to create a cached filename." :type '(choice (const :tag "MD5 of filename (low collision rate)" :value url-cache-create-filename-using-md5) (const :tag "Human readable filenames (higher collision rate)"
--- a/lisp/url/url-cookie.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-cookie.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,7 @@ ;;; url-cookie.el --- Netscape Cookie support -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -24,7 +24,6 @@ ;;; Code: -(require 'timezone) (require 'url-util) (require 'url-parse) (eval-when-compile (require 'cl)) @@ -194,34 +193,9 @@ (setq url-cookie-storage (list (list domain tmp)))))))) (defun url-cookie-expired-p (cookie) - (let* ( - (exp (url-cookie-expires cookie)) - (cur-date (and exp (timezone-parse-date (current-time-string)))) - (exp-date (and exp (timezone-parse-date exp))) - (cur-greg (and cur-date (timezone-absolute-from-gregorian - (string-to-number (aref cur-date 1)) - (string-to-number (aref cur-date 2)) - (string-to-number (aref cur-date 0))))) - (exp-greg (and exp (timezone-absolute-from-gregorian - (string-to-number (aref exp-date 1)) - (string-to-number (aref exp-date 2)) - (string-to-number (aref exp-date 0))))) - (diff-in-days (and exp (- cur-greg exp-greg))) - ) - (cond - ((not exp) nil) ; No expiry == expires at browser quit - ((< diff-in-days 0) nil) ; Expires sometime after today - ((> diff-in-days 0) t) ; Expired before today - (t ; Expires sometime today, check times - (let* ((cur-time (timezone-parse-time (aref cur-date 3))) - (exp-time (timezone-parse-time (aref exp-date 3))) - (cur-norm (+ (* 360 (string-to-number (aref cur-time 2))) - (* 60 (string-to-number (aref cur-time 1))) - (* 1 (string-to-number (aref cur-time 0))))) - (exp-norm (+ (* 360 (string-to-number (aref exp-time 2))) - (* 60 (string-to-number (aref exp-time 1))) - (* 1 (string-to-number (aref exp-time 0)))))) - (> (- cur-norm exp-norm) 1)))))) + "Return non-nil if COOKIE is expired." + (let ((exp (url-cookie-expires cookie))) + (and exp (> (float-time) (float-time (date-to-time exp)))))) (defun url-cookie-retrieve (host &optional localpart secure) "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART."
--- a/lisp/url/url-gw.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-gw.el Thu Sep 16 11:11:13 2010 +0900 @@ -37,50 +37,50 @@ :group 'url) (defcustom url-gateway-local-host-regexp nil - "*A regular expression specifying local hostnames/machines." + "A regular expression specifying local hostnames/machines." :type '(choice (const nil) regexp) :group 'url-gateway) (defcustom url-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" - "*A regular expression matching a shell prompt." + "A regular expression matching a shell prompt." :type 'regexp :group 'url-gateway) (defcustom url-gateway-rlogin-host nil - "*What hostname to actually rlog into before doing a telnet." + "What hostname to actually rlog into before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-user-name nil - "*Username to log into the remote machine with when using rlogin." + "Username to log into the remote machine with when using rlogin." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-parameters '("telnet" "-8") - "*Parameters to `url-open-rlogin'. + "Parameters to `url-open-rlogin'. This list will be used as the parameter list given to rsh." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-host nil - "*What hostname to actually login to before doing a telnet." + "What hostname to actually login to before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") - "*Parameters to `url-open-telnet'. + "Parameters to `url-open-telnet'. This list will be executed as a command after logging in via telnet." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-login-prompt "^\r*.?login:" - "*Prompt that tells us we should send our username when loggin in w/telnet." + "Prompt that tells us we should send our username when loggin in w/telnet." :type 'regexp :group 'url-gateway) (defcustom url-gateway-telnet-password-prompt "^\r*.?password:" - "*Prompt that tells us we should send our password when loggin in w/telnet." + "Prompt that tells us we should send our password when loggin in w/telnet." :type 'regexp :group 'url-gateway) @@ -95,7 +95,7 @@ :group 'url-gateway) (defcustom url-gateway-broken-resolution nil - "*Whether to use nslookup to resolve hostnames. + "Whether to use nslookup to resolve hostnames. This should be used when your version of Emacs cannot correctly use DNS, but your machine can. This usually happens if you are running a statically linked Emacs under SunOS 4.x." @@ -103,7 +103,7 @@ :group 'url-gateway) (defcustom url-gateway-nslookup-program "nslookup" - "*If non-nil then a string naming nslookup program." + "If non-nil then a string naming nslookup program." :type '(choice (const :tag "None" :value nil) string) :group 'url-gateway)
--- a/lisp/url/url-history.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-history.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,7 @@ ;;; url-history.el --- Global history tracking for URL package -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -35,7 +35,7 @@ :group 'url) (defcustom url-history-track nil - "*Controls whether to keep a list of all the URLs being visited. + "Controls whether to keep a list of all the URLs being visited. If non-nil, the URL package will keep track of all the URLs visited. If set to t, then the list is saved to disk at the end of each Emacs session." @@ -49,14 +49,14 @@ :group 'url-history) (defcustom url-history-file nil - "*The global history file for the URL package. + "The global history file for the URL package. This file contains a list of all the URLs you have visited. This file is parsed at startup and used to provide URL completion." :type '(choice (const :tag "Default" :value nil) file) :group 'url-history) (defcustom url-history-save-interval 3600 - "*The number of seconds between automatic saves of the history list. + "The number of seconds between automatic saves of the history list. Default is 1 hour. Note that if you change this variable outside of the `customize' interface after `url-do-setup' has been run, you need to run the `url-history-setup-save-timer' function manually."
--- a/lisp/url/url-irc.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-irc.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,7 @@ ;;; url-irc.el --- IRC URL interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -22,7 +22,8 @@ ;;; Commentary: -;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt +;; IRC URLs are defined in +;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt ;;; Code: @@ -32,7 +33,7 @@ (defconst url-irc-default-port 6667 "Default port for IRC connections.") (defcustom url-irc-function 'url-irc-rcirc - "*Function to actually open an IRC connection. + "Function to actually open an IRC connection. The function should take the following arguments: HOST - the hostname of the IRC server to contact PORT - the port number of the IRC server to contact
--- a/lisp/url/url-util.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-util.el Thu Sep 16 11:11:13 2010 +0900 @@ -43,7 +43,7 @@ ;;;###autoload (defcustom url-debug nil - "*What types of debug messages from the URL library to show. + "What types of debug messages from the URL library to show. Debug messages are logged to the *URL-DEBUG* buffer. If t, all messages will be logged.
--- a/lisp/url/url-vars.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/url/url-vars.el Thu Sep 16 11:11:13 2010 +0900 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -68,7 +68,7 @@ )) (defcustom url-honor-refresh-requests t - "*Whether to do automatic page reloads. + "Whether to do automatic page reloads. These are done at the request of the document author or the server via the `Refresh' header in an HTTP response. If nil, no refresh requests will be honored. If t, all refresh requests will be honored. @@ -79,14 +79,14 @@ :group 'url-hairy) (defcustom url-automatic-caching nil - "*If non-nil, all documents will be automatically cached to the local disk." + "If non-nil, all documents will be automatically cached to the local disk." :type 'boolean :group 'url-cache) ;; Fixme: sanitize this. (defcustom url-cache-expired (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)) - "*A function determining if a cached item has expired. + "A function determining if a cached item has expired. It takes two times (numbers) as its arguments, and returns non-nil if the second time is 'too old' when compared to the first time." :type 'function @@ -96,14 +96,14 @@ "Where to send bug reports.") (defcustom url-personal-mail-address nil - "*Your full email address. + "Your full email address. This is what is sent to HTTP servers as the FROM field in an HTTP request." :type '(choice (const :tag "Unspecified" nil) string) :group 'url) (defcustom url-directory-index-file "index.html" - "*The filename to look for when indexing a directory. + "The filename to look for when indexing a directory. If this file exists, and is readable, then it will be viewed instead of using `dired' to view the directory." :type 'string @@ -166,14 +166,14 @@ (".hqx" . "x-hqx") (".Z" . "x-compress") (".bz2" . "x-bzip2")) - "*An alist of file extensions and appropriate content-transfer-encodings." + "An alist of file extensions and appropriate content-transfer-encodings." :type '(repeat (cons :format "%v" (string :tag "Extension") (string :tag "Encoding"))) :group 'url-mime) (defcustom url-mail-command 'compose-mail - "*This function will be called whenever URL needs to send mail. + "This function will be called whenever URL needs to send mail. It should enter a mail-mode-like buffer in the current window. The commands `mail-to' and `mail-subject' should still work in this buffer, and it should use `mail-header-separator' if possible." @@ -181,7 +181,7 @@ :group 'url) (defcustom url-proxy-services nil - "*An alist of schemes and proxy servers that gateway them. + "An alist of schemes and proxy servers that gateway them. Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up from the ACCESS_proxy environment variables." :type '(repeat (cons :format "%v" @@ -190,7 +190,7 @@ :group 'url) (defcustom url-standalone-mode nil - "*Rely solely on the cache?" + "Rely solely on the cache?" :type 'boolean :group 'url-cache) @@ -202,7 +202,7 @@ (defcustom url-bad-port-list '("25" "119" "19") - "*List of ports to warn the user about connecting to. + "List of ports to warn the user about connecting to. Defaults to just the mail, chargen, and NNTP ports so you cannot be tricked into sending fake mail or forging messages by a malicious HTML document." @@ -255,7 +255,7 @@ ;; Fixme: set from the locale. (defcustom url-mime-language-string nil - "*String to send in the Accept-language: field in HTTP requests. + "String to send in the Accept-language: field in HTTP requests. Specifies the preferred language when servers can serve documents in several languages. Use RFC 1766 abbreviations, e.g.: `en' for @@ -284,20 +284,20 @@ "What OS we are on.") (defcustom url-max-password-attempts 5 - "*Maximum number of times a password will be prompted for. + "Maximum number of times a password will be prompted for. Applies when a protected document is denied by the server." :type 'integer :group 'url) (defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go." + "Where temporary files go." :type 'directory :group 'url-file) (make-obsolete-variable 'url-temporary-directory 'temporary-file-directory "23.1") (defcustom url-show-status t - "*Whether to show a running total of bytes transferred. + "Whether to show a running total of bytes transferred. Can cause a large hit if using a remote X display over a slow link, or a terminal with a slow modem." :type 'boolean @@ -308,7 +308,7 @@ http://www.example.com/") (defcustom url-news-server nil - "*The default news server from which to get newsgroups/articles. + "The default news server from which to get newsgroups/articles. Applies if no server is specified in the URL. Defaults to the environment variable NNTPSERVER or \"news\" if NNTPSERVER is undefined." @@ -320,13 +320,13 @@ "A regular expression that will match an absolute URL.") (defcustom url-max-redirections 30 - "*The maximum number of redirection requests to honor in a HTTP connection. + "The maximum number of redirection requests to honor in a HTTP connection. A negative number means to honor an unlimited number of redirection requests." :type 'integer :group 'url) (defcustom url-confirmation-func 'y-or-n-p - "*What function to use for asking yes or no functions. + "What function to use for asking yes or no functions. Possible values are `yes-or-no-p' or `y-or-n-p', or any function that takes a single argument (the prompt), and returns t only if a positive answer is given." @@ -336,7 +336,7 @@ :group 'url-hairy) (defcustom url-gateway-method 'native - "*The type of gateway support to use. + "The type of gateway support to use. Should be a symbol specifying how to get a connection from the local machine. Currently supported methods:
--- a/lisp/vc/vc-hg.el Thu Sep 16 10:51:56 2010 +0900 +++ b/lisp/vc/vc-hg.el Thu Sep 16 11:11:13 2010 +0900 @@ -171,10 +171,12 @@ (let ((process-environment ;; Avoid localization of messages so we ;; can parse the output. - (append (list "TERM=dumb" "LANGUAGE=C" "HGRCPATH=") + (append (list "TERM=dumb" "LANGUAGE=C") process-environment))) (process-file "hg" nil t nil + "--config" "alias.status=status" + "--config" "defaults.status=" "status" "-A" (file-relative-name file))) ;; Some problem happened. E.g. We can't find an `hg' ;; executable. @@ -199,7 +201,7 @@ ((status nil) (default-directory (file-name-directory file)) ;; Avoid localization of messages so we can parse the output. - (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C" "HGRCPATH=") + (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C") process-environment)) (out (with-output-to-string @@ -211,6 +213,8 @@ ;; Ignore all errors. (process-file "hg" nil t nil + "--config" "alias.parents=parents" + "--config" "defaults.parents=" "parents" "--template" "{rev}" (file-relative-name file))) ;; Some problem happened. E.g. We can't find an `hg' ;; executable.
--- a/make-dist Thu Sep 16 10:51:56 2010 +0900 +++ b/make-dist Thu Sep 16 11:11:13 2010 +0900 @@ -398,10 +398,10 @@ mkdir -p ../${tempdir}/lisp/$file ln $file/[a-zA-Z0-9]*.el ../${tempdir}/lisp/$file ln $file/[a-zA-Z0-9]*.elc ../${tempdir}/lisp/$file - ## calc/README.priv, nxml/TODO + ## calc/README.priv for f in $file/[a-zA-Z]*.xpm $file/[a-zA-Z]*.[xp]bm \ $file/README $file/ChangeLog $file/ChangeLog.*[0-9] \ - $file/README.prev $file/TODO; do + $file/README.prev; do if [ -f $f ]; then ln $f ../${tempdir}/lisp/$file fi
--- a/src/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/src/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -3,6 +3,69 @@ * ftfont.c (ftfont_check_otf): Fix the case of checking just existence of GSUB or GPOS. +2010-09-14 Juanma Barranquero <lekktu@gmail.com> + + * cmds.c (syms_of_cmds) <post-self-insert-hook>: Fix typos in docstring. + +2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (parse_buffer): Renamed to parse_string(), since that's + what it does. + (parse_string): Return nil when the document can't be parsed. + +2010-09-14 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (get_current_vm_state): New function. + (do_ewmh_fullscreen): Call get_current_vm_state and compare with + want_fullscreen so set_wm_state calls are few (Bug#7013). + (x_handle_net_wm_state): Move code to get_current_vm_state and + call that function. + +2010-09-14 Courtney Bane <emacs-bugs-7626@cbane.org> (tiny change) + + * term.c (tty_set_terminal_modes): Don't initialize twice (bug#7002). + +2010-09-14 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_iso_2022): Don't optimize for ASCII if + we may use designation or locking-shift. + +2010-09-14 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding_emacs_mule): Fix checking of multibyte + sequence when the source is multibyte. + +2010-09-14 Andreas Schwab <schwab@linux-m68k.org> + + * xml.c (Fxml_parse_string, Fxml_parse_string): Revert last change. + Don't make first argument optional. Doc fix. + +2010-09-14 Leo <sdl.web@gmail.com> (tiny change) + + * xml.c (Fxml_parse_string, Fhtml_parse_string): Fix up the + parameters for the doc string. + +2010-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fhtml_parse_string, Fxml_parse_string): Mention BASE-URL. + +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (Fy_or_n_p): Move to lisp/subr.el. + (syms_of_fns): Don't defsubr Sy_or_n_p. + * lisp.h: Don't declare Fy_or_n_p. + * fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p. + +2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fxml_parse_buffer): New function to parse XML files. + +2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c: New file. + (Fhtml_parse_buffer): New function to interface to the libxml2 + html parsing function. + 2010-09-05 Juanma Barranquero <lekktu@gmail.com> * biditype.h: Regenerate. @@ -65,8 +128,8 @@ characters. * term.c (encode_terminal_code): Fix the previous change. - (produce_glyphs): Don't set it->char_to_display here. Don't - handle unibyte-display-via-language-environment here. + (produce_glyphs): Don't set it->char_to_display here. + Don't handle unibyte-display-via-language-environment here. (produce_special_glyphs): Set temp_it.char_to_display before calling produce_glyphs. @@ -85,9 +148,9 @@ (produce_stretch_glyph): Set it2.char_to_display too before calling x_produce_glyphs. (x_produce_glyphs): Simplify by using the same code for ASCII and - non-ASCII characters. Don't set it->char_to_display here. Don't - handle unibyte-display-via-language-environment here. For a - charater of no glyph, use font->space_width instead of FONT_WIDTH. + non-ASCII characters. Don't set it->char_to_display here. + Don't handle unibyte-display-via-language-environment here. For a + character of no glyph, use font->space_width instead of FONT_WIDTH. 2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> @@ -109,7 +172,7 @@ 2010-08-29 Kenichi Handa <handa@m17n.org> * term.c (encode_terminal_code): Encode byte chars to the - correspnding bytes. + corresponding bytes. 2010-08-29 Jan Djärv <jan.h.d@swipnet.se> @@ -20249,7 +20312,7 @@ * search.c (search_buffer): Give up BM search on case-fold-search if one of a target character has a case-equivalence of different - byte length even if that target charcter is an ASCII. + byte length even if that target character is an ASCII. (simple_search): Fix calculation of byte length of matched text. (boyer_moore): Fix handling of case-equivalent multibyte characters.
--- a/src/ChangeLog.10 Thu Sep 16 10:51:56 2010 +0900 +++ b/src/ChangeLog.10 Thu Sep 16 11:11:13 2010 +0900 @@ -6914,7 +6914,7 @@ * search.c (search_buffer): Give up BM search on case-fold-search if one of a target character has a case-equivalence of different - charset even if that target charcter is an ASCII. + charset even if that target character is an ASCII. * casefiddle.c (casify_object): Fix for the case that case conversion change the byte length.
--- a/src/ChangeLog.8 Thu Sep 16 10:51:56 2010 +0900 +++ b/src/ChangeLog.8 Thu Sep 16 11:11:13 2010 +0900 @@ -13869,10 +13869,10 @@ 1998-08-31 Kenichi Handa <handa@etl.go.jp> * charset.c (unibyte_char_to_multibyte): - Vnonacii_translation_table will convert a 7-bit charcater. + Vnonacii_translation_table will convert a 7-bit character. (multibyte_char_to_unibyte): Handle the case that - Vnonacii_translation_table converts a multibyte charcater to a - unibyte charcter of less than 128. + Vnonacii_translation_table converts a multibyte character to a + unibyte character of less than 128. (init_charset_once): Initialize nonascii_insert_offset and Vnonacii_translation_table.
--- a/src/Makefile.in Thu Sep 16 10:51:56 2010 +0900 +++ b/src/Makefile.in Thu Sep 16 11:11:13 2010 +0900 @@ -226,6 +226,8 @@ IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ +LIBXML2_LIBS = @LIBXML2_LIBS@ +LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ @@ -320,7 +322,8 @@ ## FIXME? MYCPPFLAGS only referenced in etc/DEBUG. ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \ ${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \ - ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} \ + ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} \ + ${LIBXML2_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ ${C_WARNINGS_SWITCH} ${CFLAGS} @@ -349,7 +352,7 @@ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ + doprnt.o strftime.o intervals.o textprop.o composite.o md5.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) ## Object files used on some machine or other. @@ -595,7 +598,8 @@ ## duplicated symbols. If the standard libraries were compiled ## with GCC, we might need LIB_GCC again after them. LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ + $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) \ + ${LIBXML2_LIBS} $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
--- a/src/buffer.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/buffer.c Thu Sep 16 11:11:13 2010 +0900 @@ -2345,7 +2345,7 @@ { c = STRING_CHAR_AND_LENGTH (p, bytes); /* Delete all bytes for this 8-bit character but the - last one, and change the last one to the charcter + last one, and change the last one to the character code. */ bytes--; del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
--- a/src/charset.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/charset.c Thu Sep 16 11:11:13 2010 +0900 @@ -427,7 +427,7 @@ /* Read a hexadecimal number (preceded by "0x") from the file FP while - paying attention to comment charcter '#'. */ + paying attention to comment character '#'. */ static INLINE unsigned read_hex (FILE *fp, int *eof)
--- a/src/cmds.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/cmds.c Thu Sep 16 11:11:13 2010 +0900 @@ -524,7 +524,7 @@ DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook, doc: /* Hook run at the end of `self-insert-command'. -This run is run after inserting the charater. */); +This is run after inserting the character. */); Vpost_self_insert_hook = Qnil; defsubr (&Sforward_point);
--- a/src/coding.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/coding.c Thu Sep 16 11:11:13 2010 +0900 @@ -2008,7 +2008,7 @@ } else { - int more_bytes = emacs_mule_bytes[*src_base] - 1; + int more_bytes = emacs_mule_bytes[c] - 1; while (more_bytes > 0) { @@ -4490,7 +4490,10 @@ charset_list = CODING_ATTR_CHARSET_LIST (attrs); coding->safe_charsets = SDATA (CODING_ATTR_SAFE_CHARSETS (attrs)); - ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); + ascii_compatible + = (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)) + && ! (CODING_ISO_FLAGS (coding) & (CODING_ISO_FLAG_DESIGNATION + | CODING_ISO_FLAG_LOCKING_SHIFT))); while (charbuf < charbuf_end) {
--- a/src/config.in Thu Sep 16 10:51:56 2010 +0900 +++ b/src/config.in Thu Sep 16 11:11:13 2010 +0900 @@ -813,6 +813,9 @@ /* Define to 1 if you have the SM library (-lSM). */ #undef HAVE_X_SM +/* Define to 1 if you have the libxml2 library (-lxml2). */ +#undef HAVE_LIBXML2 + /* Define to 1 if you want to use the X window system. */ #undef HAVE_X_WINDOWS
--- a/src/editfns.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/editfns.c Thu Sep 16 11:11:13 2010 +0900 @@ -3517,7 +3517,7 @@ int multibyte = 0; /* When we make a multibyte string, we must pay attention to the byte combining problem, i.e., a byte may be combined with a - multibyte charcter of the previous string. This flag tells if we + multibyte character of the previous string. This flag tells if we must consider such a situation or not. */ int maybe_combine_byte; unsigned char *this_format;
--- a/src/emacs.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/emacs.c Thu Sep 16 11:11:13 2010 +0900 @@ -1544,6 +1544,10 @@ #endif #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_LIBXML2 + syms_of_xml (); +#endif + syms_of_menu (); #ifdef HAVE_NTGUI
--- a/src/fileio.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/fileio.c Thu Sep 16 11:11:13 2010 +0900 @@ -1842,7 +1842,7 @@ tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); if (quick) - tem = Fy_or_n_p (tem); + tem = call1 (intern ("y-or-n-p"), tem); else tem = do_yes_or_no_p (tem); UNGCPRO;
--- a/src/fns.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/fns.c Thu Sep 16 11:11:13 2010 +0900 @@ -2444,146 +2444,6 @@ return sequence; } -/* Anything that calls this function must protect from GC! */ - -DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, - doc: /* Ask user a "y or n" question. Return t if answer is "y". -Takes one argument, which is the string to display to ask the question. -It should end in a space; `y-or-n-p' adds `(y or n) ' to it. -No confirmation of the answer is requested; a single character is enough. -Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses -the bindings in `query-replace-map'; see the documentation of that variable -for more information. In this case, the useful bindings are `act', `skip', -`recenter', and `quit'.\) - -Under a windowing system a dialog box will be used if `last-nonmenu-event' -is nil and `use-dialog-box' is non-nil. */) - (Lisp_Object prompt) -{ - register Lisp_Object obj, key, def, map; - register int answer; - Lisp_Object xprompt; - Lisp_Object args[2]; - struct gcpro gcpro1, gcpro2; - int count = SPECPDL_INDEX (); - - specbind (Qcursor_in_echo_area, Qt); - - map = Fsymbol_value (intern ("query-replace-map")); - - CHECK_STRING (prompt); - xprompt = prompt; - GCPRO2 (prompt, xprompt); - -#ifdef HAVE_WINDOW_SYSTEM - if (display_hourglass_p) - cancel_hourglass (); -#endif - - while (1) - { - -#ifdef HAVE_MENUS - if (FRAME_WINDOW_P (SELECTED_FRAME ()) - && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && have_menus_p ()) - { - Lisp_Object pane, menu; - redisplay_preserve_echo_area (3); - pane = Fcons (Fcons (build_string ("Yes"), Qt), - Fcons (Fcons (build_string ("No"), Qnil), - Qnil)); - menu = Fcons (prompt, pane); - obj = Fx_popup_dialog (Qt, menu, Qnil); - answer = !NILP (obj); - break; - } -#endif /* HAVE_MENUS */ - cursor_in_echo_area = 1; - choose_minibuf_frame (); - - { - Lisp_Object pargs[3]; - - /* Colorize prompt according to `minibuffer-prompt' face. */ - pargs[0] = build_string ("%s(y or n) "); - pargs[1] = intern ("face"); - pargs[2] = intern ("minibuffer-prompt"); - args[0] = Fpropertize (3, pargs); - args[1] = xprompt; - Fmessage (2, args); - } - - if (minibuffer_auto_raise) - { - Lisp_Object mini_frame; - - mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); - - Fraise_frame (mini_frame); - } - - temporarily_switch_to_single_kboard (SELECTED_FRAME ()); - obj = read_filtered_event (1, 0, 0, 0, Qnil); - cursor_in_echo_area = 0; - /* If we need to quit, quit with cursor_in_echo_area = 0. */ - QUIT; - - key = Fmake_vector (make_number (1), obj); - def = Flookup_key (map, key, Qt); - - if (EQ (def, intern ("skip"))) - { - answer = 0; - break; - } - else if (EQ (def, intern ("act"))) - { - answer = 1; - break; - } - else if (EQ (def, intern ("recenter"))) - { - Frecenter (Qnil); - xprompt = prompt; - continue; - } - else if (EQ (def, intern ("quit"))) - Vquit_flag = Qt; - /* We want to exit this command for exit-prefix, - and this is the only way to do it. */ - else if (EQ (def, intern ("exit-prefix"))) - Vquit_flag = Qt; - - QUIT; - - /* If we don't clear this, then the next call to read_char will - return quit_char again, and we'll enter an infinite loop. */ - Vquit_flag = Qnil; - - Fding (Qnil); - Fdiscard_input (); - if (EQ (xprompt, prompt)) - { - args[0] = build_string ("Please answer y or n. "); - args[1] = prompt; - xprompt = Fconcat (2, args); - } - } - UNGCPRO; - - if (! noninteractive) - { - cursor_in_echo_area = -1; - message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n", - xprompt, 0); - } - - unbind_to (count, Qnil); - return answer ? Qt : Qnil; -} - /* This is how C code calls `yes-or-no-p' and allows the user to redefined it. @@ -5058,7 +4918,6 @@ defsubr (&Smapcar); defsubr (&Smapc); defsubr (&Smapconcat); - defsubr (&Sy_or_n_p); defsubr (&Syes_or_no_p); defsubr (&Sload_average); defsubr (&Sfeaturep);
--- a/src/lisp.h Thu Sep 16 10:51:56 2010 +0900 +++ b/src/lisp.h Thu Sep 16 11:11:13 2010 +0900 @@ -2516,7 +2516,6 @@ EXFUN (Fnconc, MANY); EXFUN (Fmapcar, 2); EXFUN (Fmapconcat, 3); -EXFUN (Fy_or_n_p, 1); extern Lisp_Object do_yes_or_no_p (Lisp_Object); EXFUN (Frequire, 3); EXFUN (Fprovide, 2); @@ -3577,6 +3576,11 @@ EXFUN (Fmsdos_downcase_filename, 1); #endif +#ifdef HAVE_LIBXML2 +/* Defined in xml.c */ +extern void syms_of_xml (void); +#endif + #ifdef HAVE_MENUS /* Defined in (x|w32)fns.c, nsfns.m... */ extern int have_menus_p (void);
--- a/src/term.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/term.c Thu Sep 16 11:11:13 2010 +0900 @@ -247,7 +247,6 @@ cmputc ('\n'); } - OUTPUT_IF (tty, tty->TS_termcap_modes); OUTPUT_IF (tty, visible_cursor ? tty->TS_cursor_visible : tty->TS_cursor_normal); OUTPUT_IF (tty, tty->TS_keypad_mode); losecursor (tty);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/xml.c Thu Sep 16 11:11:13 2010 +0900 @@ -0,0 +1,141 @@ +/* Interface to libxml2. + Copyright (C) 2010 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +#ifdef HAVE_LIBXML2 + +#include <setjmp.h> +#include <libxml/tree.h> +#include <libxml/parser.h> +#include <libxml/HTMLparser.h> + +#include "lisp.h" +#include "buffer.h" + +Lisp_Object make_dom (xmlNode *node) +{ + if (node->type == XML_ELEMENT_NODE) { + Lisp_Object result = Fcons (intern (node->name), Qnil); + xmlNode *child; + xmlAttr *property; + + /* First add the attributes. */ + property = node->properties; + while (property != NULL) { + if (property->children && + property->children->content) { + char *pname = xmalloc (strlen (property->name) + 2); + *pname = ':'; + strcpy(pname + 1, property->name); + result = Fcons (Fcons (intern (pname), + build_string(property->children->content)), + result); + xfree (pname); + } + property = property->next; + } + /* Then add the children of the node. */ + child = node->children; + while (child != NULL) { + result = Fcons (make_dom (child), result); + child = child->next; + } + return Fnreverse (result); + } else if (node->type == XML_TEXT_NODE) { + Lisp_Object content = Qnil; + + if (node->content) + content = build_string (node->content); + + return Fcons (intern (node->name), content); + } else + return Qnil; +} + +static Lisp_Object +parse_string (Lisp_Object string, Lisp_Object base_url, int htmlp) +{ + xmlDoc *doc; + xmlNode *node; + Lisp_Object result = Qnil; + int ibeg, iend; + char *burl = ""; + + LIBXML_TEST_VERSION; + + CHECK_STRING (string); + + if (! NILP (base_url)) { + CHECK_STRING (base_url); + burl = SDATA (base_url); + } + + if (htmlp) + doc = htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + HTML_PARSE_RECOVER|HTML_PARSE_NONET| + HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR); + else + doc = xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + XML_PARSE_NONET|XML_PARSE_NOWARNING| + XML_PARSE_NOERROR); + + if (doc != NULL) { + node = xmlDocGetRootElement (doc); + if (node != NULL) + result = make_dom (node); + + xmlFreeDoc (doc); + xmlCleanupParser (); + } + + return result; +} + +DEFUN ("html-parse-string", Fhtml_parse_string, Shtml_parse_string, + 1, 2, 0, + doc: /* Parse STRING as an HTML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the HTML document. */) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_string (string, base_url, 1); +} + +DEFUN ("xml-parse-string", Fxml_parse_string, Sxml_parse_string, + 1, 2, 0, + doc: /* Parse STRING as an XML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the XML document. */) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_string (string, base_url, 0); +} + + +/*********************************************************************** + Initialization + ***********************************************************************/ +void +syms_of_xml (void) +{ + defsubr (&Shtml_parse_string); + defsubr (&Sxml_parse_string); +} + +#endif /* HAVE_LIBXML2 */
--- a/src/xterm.c Thu Sep 16 10:51:56 2010 +0900 +++ b/src/xterm.c Thu Sep 16 11:11:13 2010 +0900 @@ -8285,19 +8285,89 @@ "_NET_WM_STATE_STICKY", NULL); } +/* Return the current _NET_WM_STATE. + SIZE_STATE is set to one of the FULLSCREEN_* values. + STICKY is set to 1 if the sticky state is set, 0 if not. */ + +static void +get_current_vm_state (struct frame *f, + Window window, + int *size_state, + int *sticky) +{ + Atom actual_type; + unsigned long actual_size, bytes_remaining; + int i, rc, actual_format; + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + long max_len = 65536; + Display *dpy = FRAME_X_DISPLAY (f); + unsigned char *tmp_data = NULL; + Atom target_type = XA_ATOM; + + *sticky = 0; + *size_state = FULLSCREEN_NONE; + + BLOCK_INPUT; + x_catch_errors (dpy); + rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state, + 0, max_len, False, target_type, + &actual_type, &actual_format, &actual_size, + &bytes_remaining, &tmp_data); + + if (rc != Success || actual_type != target_type || x_had_errors_p (dpy)) + { + if (tmp_data) XFree (tmp_data); + x_uncatch_errors (); + UNBLOCK_INPUT; + return; + } + + x_uncatch_errors (); + + for (i = 0; i < actual_size; ++i) + { + Atom a = ((Atom*)tmp_data)[i]; + if (a == dpyinfo->Xatom_net_wm_state_maximized_horz) + { + if (*size_state == FULLSCREEN_HEIGHT) + *size_state = FULLSCREEN_MAXIMIZED; + else + *size_state = FULLSCREEN_WIDTH; + } + else if (a == dpyinfo->Xatom_net_wm_state_maximized_vert) + { + if (*size_state == FULLSCREEN_WIDTH) + *size_state = FULLSCREEN_MAXIMIZED; + else + *size_state = FULLSCREEN_HEIGHT; + } + else if (a == dpyinfo->Xatom_net_wm_state_fullscreen_atom) + *size_state = FULLSCREEN_BOTH; + else if (a == dpyinfo->Xatom_net_wm_state_sticky) + *sticky = 1; + } + + if (tmp_data) XFree (tmp_data); + UNBLOCK_INPUT; +} + /* Do fullscreen as specified in extended window manager hints */ static int do_ewmh_fullscreen (struct frame *f) { int have_net_atom = wm_supports (f, "_NET_WM_STATE"); + Lisp_Object lval = get_frame_param (f, Qfullscreen); + int cur, dummy; + + get_current_vm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy); /* Some window managers don't say they support _NET_WM_STATE, but they do say they support _NET_WM_STATE_FULLSCREEN. Try that also. */ if (!have_net_atom) have_net_atom = wm_supports (f, "_NET_WM_STATE_FULLSCREEN"); - if (have_net_atom) + if (have_net_atom && cur != f->want_fullscreen) { Lisp_Object frame; const char *fs = "_NET_WM_STATE_FULLSCREEN"; @@ -8306,26 +8376,41 @@ XSETFRAME (frame, f); - set_wm_state (frame, 0, fs, NULL); - set_wm_state (frame, 0, fh, NULL); - set_wm_state (frame, 0, fw, NULL); - - /* If there are _NET_ atoms we assume we have extended window manager - hints. */ + /* Keep number of calls to set_wm_state as low as possible. + Some window managers, or possible Gtk+, hangs when too many + are sent at once. */ switch (f->want_fullscreen) { case FULLSCREEN_BOTH: + if (cur == FULLSCREEN_WIDTH || cur == FULLSCREEN_MAXIMIZED + || cur == FULLSCREEN_HEIGHT) + set_wm_state (frame, 0, fw, fh); set_wm_state (frame, 1, fs, NULL); break; case FULLSCREEN_WIDTH: - set_wm_state (frame, 1, fw, NULL); + if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_HEIGHT + || cur == FULLSCREEN_MAXIMIZED) + set_wm_state (frame, 0, fs, fh); + if (cur != FULLSCREEN_MAXIMIZED) + set_wm_state (frame, 1, fw, NULL); break; case FULLSCREEN_HEIGHT: - set_wm_state (frame, 1, fh, NULL); + if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_WIDTH + || cur == FULLSCREEN_MAXIMIZED) + set_wm_state (frame, 0, fs, fw); + if (cur != FULLSCREEN_MAXIMIZED) + set_wm_state (frame, 1, fh, NULL); break; case FULLSCREEN_MAXIMIZED: + if (cur == FULLSCREEN_BOTH) + set_wm_state (frame, 0, fs, NULL); set_wm_state (frame, 1, fw, fh); break; + case FULLSCREEN_NONE: + if (cur == FULLSCREEN_BOTH) + set_wm_state (frame, 0, fs, NULL); + else + set_wm_state (frame, 0, fw, fh); } f->want_fullscreen = FULLSCREEN_NONE; @@ -8351,57 +8436,11 @@ static void x_handle_net_wm_state (struct frame *f, XPropertyEvent *event) { - Atom actual_type; - unsigned long actual_size, bytes_remaining; - int i, rc, actual_format, value = FULLSCREEN_NONE; - struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - long max_len = 65536; - Display *dpy = FRAME_X_DISPLAY (f); - unsigned char *tmp_data = NULL; - Atom target_type = XA_ATOM; + int value = FULLSCREEN_NONE; Lisp_Object lval; int sticky = 0; - BLOCK_INPUT; - x_catch_errors (dpy); - rc = XGetWindowProperty (dpy, event->window, - event->atom, 0, max_len, False, target_type, - &actual_type, &actual_format, &actual_size, - &bytes_remaining, &tmp_data); - - if (rc != Success || actual_type != target_type || x_had_errors_p (dpy)) - { - if (tmp_data) XFree (tmp_data); - x_uncatch_errors (); - UNBLOCK_INPUT; - return; - } - - x_uncatch_errors (); - - for (i = 0; i < actual_size; ++i) - { - Atom a = ((Atom*)tmp_data)[i]; - if (a == dpyinfo->Xatom_net_wm_state_maximized_horz) - { - if (value == FULLSCREEN_HEIGHT) - value = FULLSCREEN_MAXIMIZED; - else - value = FULLSCREEN_WIDTH; - } - else if (a == dpyinfo->Xatom_net_wm_state_maximized_vert) - { - if (value == FULLSCREEN_WIDTH) - value = FULLSCREEN_MAXIMIZED; - else - value = FULLSCREEN_HEIGHT; - } - else if (a == dpyinfo->Xatom_net_wm_state_fullscreen_atom) - value = FULLSCREEN_BOTH; - else if (a == dpyinfo->Xatom_net_wm_state_sticky) - sticky = 1; - } - + get_current_vm_state (f, event->window, &value, &sticky); lval = Qnil; switch (value) { @@ -8421,9 +8460,6 @@ store_frame_param (f, Qfullscreen, lval); store_frame_param (f, Qsticky, sticky ? Qt : Qnil); - - if (tmp_data) XFree (tmp_data); - UNBLOCK_INPUT; } /* Check if we need to resize the frame due to a fullscreen request.
--- a/test/ChangeLog Thu Sep 16 10:51:56 2010 +0900 +++ b/test/ChangeLog Thu Sep 16 11:11:13 2010 +0900 @@ -1,3 +1,7 @@ +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * indent/octave.m: Remove some `fixindent' not needed any more. + 2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> * indent/octave.m: New file.
--- a/test/indent/octave.m Thu Sep 16 10:51:56 2010 +0900 +++ b/test/indent/octave.m Thu Sep 16 11:11:13 2010 +0900 @@ -1415,7 +1415,7 @@ endfor # fixindent ## Search all C++ source files for PKG commands. - lst = dir (fullfile (packdir, "src", "*.cc")); # fixindent + lst = dir (fullfile (packdir, "src", "*.cc")); for i = 1:length (lst) nam = fullfile (packdir, "src", lst(i).name); fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); @@ -1451,10 +1451,10 @@ unlink (archpkg); endif endif - endif # fixindent -endfunction # fixindent + endif +endfunction -function copy_files (desc, packdir, global_install) # fixindent +function copy_files (desc, packdir, global_install) ## Create the installation directory. if (! exist (desc.dir, "dir")) [status, output] = mkdir (desc.dir);