aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2007-07-15 04:47:46 +0000
committerMiles Bader2007-07-15 04:47:46 +0000
commit8c406a9bc42ee77fcbbb4201fe8bda855eafd832 (patch)
tree14c8fa2e72341edd9db40b17079fd5208b1554c8
parent9bdeb5e9bedd773cc6845bc29a98e1e2a208f1ff (diff)
parent6f8a87c027ebd6f9cfdac5c0df97d651227bec62 (diff)
downloademacs-8c406a9bc42ee77fcbbb4201fe8bda855eafd832.tar.gz
emacs-8c406a9bc42ee77fcbbb4201fe8bda855eafd832.zip
Merge from emacs--devo--0
Patches applied: * emacs--devo--0 (patch 806-813) - Merge from emacs--rel--22 - Update from CVS * emacs--rel--22 (patch 51-58) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 233-236) - Merge from emacs--devo--0 - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-230
-rw-r--r--etc/ChangeLog21
-rw-r--r--etc/NEWS61
-rw-r--r--etc/NEWS.225
-rw-r--r--etc/PROBLEMS4
-rw-r--r--etc/orgcard.tex58
-rw-r--r--lisp/ChangeLog352
-rw-r--r--lisp/ChangeLog.104
-rw-r--r--lisp/ChangeLog.112
-rw-r--r--lisp/ChangeLog.128
-rw-r--r--lisp/autoinsert.el2
-rw-r--r--lisp/bookmark.el28
-rw-r--r--lisp/calendar/cal-bahai.el1
-rw-r--r--lisp/comint.el42
-rw-r--r--lisp/cus-start.el7
-rw-r--r--lisp/desktop.el6
-rw-r--r--lisp/emacs-lisp/advice.el2
-rw-r--r--lisp/emacs-lisp/autoload.el16
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el7
-rw-r--r--lisp/emacs-lisp/cl.el2
-rw-r--r--lisp/emacs-lisp/copyright.el2
-rw-r--r--lisp/emacs-lisp/easymenu.el40
-rw-r--r--lisp/emacs-lisp/eldoc.el120
-rw-r--r--lisp/emacs-lisp/lisp-mode.el4
-rw-r--r--lisp/files.el14
-rw-r--r--lisp/follow.el168
-rw-r--r--lisp/gnus/ChangeLog39
-rw-r--r--lisp/gnus/gnus-art.el21
-rw-r--r--lisp/gnus/gnus-srvr.el41
-rw-r--r--lisp/gnus/gnus-start.el9
-rw-r--r--lisp/gnus/gnus-sum.el3
-rw-r--r--lisp/gnus/mm-util.el34
-rw-r--r--lisp/gnus/nnrss.el7
-rw-r--r--lisp/gnus/rfc2047.el11
-rw-r--r--lisp/isearch.el1
-rw-r--r--lisp/makefile.w32-in15
-rw-r--r--lisp/menu-bar.el1
-rw-r--r--lisp/mh-e/ChangeLog5
-rw-r--r--lisp/mh-e/mh-compat.el12
-rw-r--r--lisp/net/ange-ftp.el14
-rw-r--r--lisp/net/rcompile.el3
-rw-r--r--lisp/net/tramp-cache.el317
-rw-r--r--lisp/net/tramp-fish.el1178
-rw-r--r--lisp/net/tramp-ftp.el30
-rw-r--r--lisp/net/tramp-gw.el324
-rw-r--r--lisp/net/tramp-smb.el1043
-rw-r--r--lisp/net/tramp-util.el138
-rw-r--r--lisp/net/tramp-uu.el9
-rw-r--r--lisp/net/tramp-vc.el536
-rw-r--r--lisp/net/tramp.el8612
-rw-r--r--lisp/net/trampver.el18
-rw-r--r--lisp/pcomplete.el1
-rw-r--r--lisp/pcvs-info.el4
-rw-r--r--lisp/progmodes/compile.el136
-rw-r--r--lisp/progmodes/gdb-ui.el2
-rw-r--r--lisp/progmodes/gud.el20
-rw-r--r--lisp/progmodes/python.el34
-rw-r--r--lisp/progmodes/which-func.el4
-rw-r--r--lisp/replace.el2
-rw-r--r--lisp/subr.el62
-rw-r--r--lisp/textmodes/org.el1293
-rw-r--r--lisp/textmodes/tex-mode.el24
-rw-r--r--lisp/vc-arch.el14
-rw-r--r--lisp/vc-cvs.el186
-rw-r--r--lisp/vc-hooks.el52
-rw-r--r--lisp/w32-fns.el21
-rw-r--r--lisp/window.el5
-rw-r--r--lispref/ChangeLog19
-rw-r--r--lispref/control.texi49
-rw-r--r--lispref/display.texi5
-rw-r--r--lispref/files.texi9
-rw-r--r--man/ChangeLog45
-rw-r--r--man/Makefile.in2
-rw-r--r--man/building.texi4
-rw-r--r--man/emacs-mime.texi3
-rw-r--r--man/gnus-faq.texi11
-rw-r--r--man/gnus.texi27
-rw-r--r--man/makefile.w32-in2
-rw-r--r--man/org.texi388
-rw-r--r--man/texinfo.tex35
-rw-r--r--man/tramp.texi1491
-rw-r--r--man/trampver.texi27
-rw-r--r--nt/ChangeLog11
-rw-r--r--nt/gmake.defs3
-rw-r--r--nt/inc/sys/socket.h3
-rw-r--r--nt/nmake.defs3
-rw-r--r--src/ChangeLog105
-rw-r--r--src/alloc.c13
-rw-r--r--src/editfns.c6
-rw-r--r--src/eval.c123
-rw-r--r--src/keyboard.c2
-rw-r--r--src/keymap.c55
-rw-r--r--src/keymap.h2
-rw-r--r--src/lisp.h4
-rw-r--r--src/makefile.w32-in3
-rw-r--r--src/print.c2
-rw-r--r--src/process.c299
-rw-r--r--src/process.h76
-rw-r--r--src/search.c179
-rw-r--r--src/term.c11
-rw-r--r--src/w32fns.c12
-rw-r--r--src/window.c2
101 files changed, 10757 insertions, 7531 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index b88e98af123..3b459fc952b 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,24 @@
12007-07-15 Karl Fogel <kfogel@red-bean.com>
2
3 * NEWS: Revert 2007-07-13T23:20:21Z!kfogel@red-bean.com, which
4 documented bookmark keybinding changes that were later reverted.
5
62007-07-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
7
8 * PROBLEMS: Mention gtk-engines-qt problem.
9
102007-07-13 Karl Fogel <kfogel@red-bean.com>
11
12 * NEWS: Update for recent bookmark keybinding changes.
13
142007-07-10 Michael Albinus <michael.albinus@gmx.de>
15
16 * NEWS: Add Tramp and comint-mode changes.
17
182007-07-08 Michael Albinus <michael.albinus@gmx.de>
19
20 * NEWS: `file-remote-p' has a new optional parameter CONNECTED.
21
12007-07-07 Michael Albinus <michael.albinus@gmx.de> 222007-07-07 Michael Albinus <michael.albinus@gmx.de>
2 23
3 * NEWS: New function `start-file-process'. 24 * NEWS: New function `start-file-process'.
diff --git a/etc/NEWS b/etc/NEWS
index 8006fa427ed..6b21ba4eb1a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -73,6 +73,9 @@ recenter the visited source file. Its value can be a number (for example,
73 73
74* Changes in Specialized Modes and Packages in Emacs 23.1 74* Changes in Specialized Modes and Packages in Emacs 23.1
75 75
76** compilation-auto-jump-to-first-error tells `compile' to jump to
77the first error encountered during compilations.
78
76** In the `copyright' package, you can specify your copyright holders's names. 79** In the `copyright' package, you can specify your copyright holders's names.
77Only copyright lines with holders matching copyright-names-regexp will be 80Only copyright lines with holders matching copyright-names-regexp will be
78considered for update. 81considered for update.
@@ -95,9 +98,49 @@ identify cited keys in BibTeX entries, used by `bibtex-find-crossref.
95 98
96*** Command `bibtex-url' now allows multiple URLs per entry. 99*** Command `bibtex-url' now allows multiple URLs per entry.
97 100
101+++
102** Tramp
103
104*** New connection methods.
105The new methods "plinkx", "plink2", "psftp", "sftp" and "fish" have
106been introduced. There are also new so-called gateway methods
107"tunnel" and "socks".
108
109*** Multihop syntax has been removed.
110The pseudo-method "multi" has been removed. Instead of, multi hops
111can be specified by the new variable `tramp-default-proxies-alist'.
112
113*** More default settings.
114Default values can be set via the variables `tramp-default-user',
115`tramp-default-user-alist' and `tramp-default-host'.
116
117*** Connection information is cached.
118In order to reduce connection setup, information about used
119connections are kept persistent in a file. The name of this file is
120defined in the variable `tramp-persistency-file-name'.
121
122*** Control of remote processes.
123Running processes on a remote host can be controlled by settings in
124`tramp-remote-path' and `tramp-remote-process-environment'.
125
126*** Success of remote copy is checked.
127When the variable `file-precious-flag' is set, the success of a remote
128file copy is checked via the file's checksum.
129
130** comint-mode uses `start-file-process' now (see Lisp Changes).
131If `default-directory' is a remote file name, subprocesses are started
132on the corresponding remote system.
133
98 134
99* Changes in Emacs 23.1 on non-free operating systems 135* Changes in Emacs 23.1 on non-free operating systems
100 136
137---
138** IPv6 is supported on MS-Windows.
139Emacs now supports IPv6 on Windows XP and later, and earlier versions
140of Windows with third party IPv6 stacks installed. Previously IPv6 was
141supported on other platforms, but not on Windows due to using the winsock
1421.1 header file, even though Emacs was linking to the winsock 2 library.
143
101 144
102* Incompatible Lisp Changes in Emacs 23.1 145* Incompatible Lisp Changes in Emacs 23.1
103 146
@@ -107,6 +150,16 @@ identify cited keys in BibTeX entries, used by `bibtex-find-crossref.
107 150
108* Lisp Changes in Emacs 23.1 151* Lisp Changes in Emacs 23.1
109 152
153+++
154** In `condition-case', a handler can specify "let the debugger run first".
155
156You do this by writing `debug' in the list of conditions to be handled,
157like this:
158
159 (condition-case nil
160 (foo bar)
161 ((debug error) nil))
162
110** The `require-match' argument to `completing-read' accepts a new value 163** The `require-match' argument to `completing-read' accepts a new value
111`confirm-only'. 164`confirm-only'.
112 165
@@ -126,6 +179,14 @@ with a given image specification.
126but obeys file handlers. The file handler is chosen based on 179but obeys file handlers. The file handler is chosen based on
127`default-directory'. 180`default-directory'.
128 181
182+++
183** `file-remote-p' has a new optional parameter CONNECTED.
184With this paramter passed non-nil, it is checked whether a remote
185connection has been established already.
186
187** The two new functions `looking-at-p' and `string-match-p' can do
188the same matching as `looking-at' and `string-match' without changing
189the match data.
129 190
130* New Packages for Lisp Programming in Emacs 23.1 191* New Packages for Lisp Programming in Emacs 23.1
131 192
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index 4da26ff9271..3d5ff1aff3a 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -46,6 +46,11 @@ before deleting/copying the indicated directory recursively.
46than the window, the usual keys for moving the cursor cause the image 46than the window, the usual keys for moving the cursor cause the image
47to be scrolled horizontally or vertically instead. 47to be scrolled horizontally or vertically instead.
48 48
49** Scrollbars follow the system theme on Windows XP and later.
50Windows XP introduced themed scrollbars, but applications have to take
51special steps to use them. Emacs now has the appropriate resources linked
52in to make it use the scrollbars from the system theme.
53
49* New Modes and Packages in Emacs 22.2 54* New Modes and Packages in Emacs 22.2
50 55
51** The new package css-mode.el provides a major mode for editing CSS files. 56** The new package css-mode.el provides a major mode for editing CSS files.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 0d66c375e2b..1747ae791a5 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1164,6 +1164,10 @@ present or commented out:
1164 Emacs*Foreground 1164 Emacs*Foreground
1165 Emacs*Background 1165 Emacs*Background
1166 1166
1167It is also reported that a bug in the gtk-engines-qt engine can cause this if
1168Emacs is compiled with Gtk+.
1169The bug is fixed in version 0.7 or newer of gtk-engines-qt.
1170
1167*** KDE: Emacs hangs on KDE when a large portion of text is killed. 1171*** KDE: Emacs hangs on KDE when a large portion of text is killed.
1168 1172
1169This is caused by a bug in the KDE applet `klipper' which periodically 1173This is caused by a bug in the KDE applet `klipper' which periodically
diff --git a/etc/orgcard.tex b/etc/orgcard.tex
index d9f60f62f8c..588d4523206 100644
--- a/etc/orgcard.tex
+++ b/etc/orgcard.tex
@@ -1,5 +1,5 @@
1% Reference Card for Org Mode 1% Reference Card for Org Mode
2\def\orgversionnumber{5.01} 2\def\orgversionnumber{5.03}
3\def\versionyear{2007} % latest update 3\def\versionyear{2007} % latest update
4\def\year{2007} % latest copyright year 4\def\year{2007} % latest copyright year
5 5
@@ -544,6 +544,24 @@ after ``{\tt :}'', and dictionary words elsewhere.
544\key{create sparse tree with matching tags}{C-c \\} 544\key{create sparse tree with matching tags}{C-c \\}
545\key{globally (agenda) match tags at cursor}{C-c C-o} 545\key{globally (agenda) match tags at cursor}{C-c C-o}
546 546
547\section{Properties and Column View}
548
549\key{special commands in property lines}{C-c C-c}
550\key{next/previous allowed value}{S-left/right}
551\key{turn on column view}{C-c C-x C-c}
552
553\key{quit column view}{q}
554\key{next/previous allowed value}{S-left/right}
555\key{next/previous allowed value}{n / p}
556\key{edit value}{e}
557\key{edit allowed values list}{a}
558\key{show value}{v}
559\key{make column wider/narrower}{> / <}
560\key{move column left/right}{M-left/right}
561\key{add new column}{M-S-right}
562\key{Delete current column}{M-S-left}
563
564
547\section{Timestamps} 565\section{Timestamps}
548 566
549\key{prompt for date and insert timestamp}{C-c .} 567\key{prompt for date and insert timestamp}{C-c .}
@@ -566,6 +584,8 @@ after ``{\tt :}'', and dictionary words elsewhere.
566%\key{... forward/backward one month}{M-S-LEFT/RIGT} 584%\key{... forward/backward one month}{M-S-LEFT/RIGT}
567\key{Toggle custom format display for dates/times}{C-c C-x C-t} 585\key{Toggle custom format display for dates/times}{C-c C-x C-t}
568 586
587\newcolumn
588
569{\bf Clocking time} 589{\bf Clocking time}
570 590
571\key{start clock on current item}{C-c C-x C-i} 591\key{start clock on current item}{C-c C-x C-i}
@@ -575,12 +595,6 @@ after ``{\tt :}'', and dictionary words elsewhere.
575\key{remove displayed times}{C-c C-c} 595\key{remove displayed times}{C-c C-c}
576\key{insert/update table with clock report}{C-c C-x C-r} 596\key{insert/update table with clock report}{C-c C-x C-r}
577 597
578\section{LaTeX and cdlatex-mode}
579
580\key{preview LaTeX fragment}{C-c C-x C-l}
581\key{Expand abbreviation (cdlatex-mode)}{TAB}
582\key{Insert/modify math symbol (cdlatex-mode)}{` / '}
583
584\section{Agenda Views} 598\section{Agenda Views}
585 599
586\key{add/move current file to front of agenda}{C-c [} 600\key{add/move current file to front of agenda}{C-c [}
@@ -648,6 +662,7 @@ To set categories, add lines like$^2$:
648\key{change timestamp to today}{>} 662\key{change timestamp to today}{>}
649\key{insert new entry into diary}{i} 663\key{insert new entry into diary}{i}
650 664
665\newcolumn
651\key{start the clock on current item (clock-in)}{I} 666\key{start the clock on current item (clock-in)}{I}
652\key{stop the clock (clock-out)}{O} 667\key{stop the clock (clock-out)}{O}
653\key{cancel current clock}{X} 668\key{cancel current clock}{X}
@@ -656,7 +671,6 @@ To set categories, add lines like$^2$:
656 671
657\key{Open link in current line}{C-c C-o} 672\key{Open link in current line}{C-c C-o}
658 673
659\newcolumn
660{\bf Calendar commands} 674{\bf Calendar commands}
661 675
662\key{find agenda cursor date in calendar}{c} 676\key{find agenda cursor date in calendar}{c}
@@ -678,6 +692,12 @@ Include Emacs diary entries into Org-mode agenda with:
678(setq org-agenda-include-diary t) 692(setq org-agenda-include-diary t)
679\endexample 693\endexample
680 694
695\section{LaTeX and cdlatex-mode}
696
697\key{preview LaTeX fragment}{C-c C-x C-l}
698\key{Expand abbreviation (cdlatex-mode)}{TAB}
699\key{Insert/modify math symbol (cdlatex-mode)}{` / '}
700
681\section{Exporting and Publishing} 701\section{Exporting and Publishing}
682 702
683Exporting creates files with extensions {\it .txt\/} and {\it .html\/} 703Exporting creates files with extensions {\it .txt\/} and {\it .html\/}
@@ -690,17 +710,17 @@ some other place.
690\key{insert template of export options}{C-c C-x t} 710\key{insert template of export options}{C-c C-x t}
691\key{toggle fixed width for entry or region}{C-c :} 711\key{toggle fixed width for entry or region}{C-c :}
692 712
693{\bf HTML formatting} 713%{\bf HTML formatting}
694 714
695\key{make words {\bf bold}}{*bold*} 715%\key{make words {\bf bold}}{*bold*}
696\key{make words {\it italic}}{/italic/} 716%\key{make words {\it italic}}{/italic/}
697\key{make words \underbar{underlined}}{_underlined_} 717%\key{make words \underbar{underlined}}{_underlined_}
698\key{sub- and superscripts}{x\^{}3, J_dust} 718%\key{sub- and superscripts}{x\^{}3, J_dust}
699\key{\TeX{}-like macros}{\\alpha, \\to} 719%\key{\TeX{}-like macros}{\\alpha, \\to}
700\key{typeset lines in fixed width font}{start with :} 720%\key{typeset lines in fixed width font}{start with :}
701\key{tables are exported as HTML tables}{start with |} 721%\key{tables are exported as HTML tables}{start with |}
702\key{links become HTML links}{http:... etc} 722%\key{links become HTML links}{http:... etc}
703\key{include html tags}{@<b>...@</b>} 723%\key{include html tags}{@<b>...@</b>}
704 724
705%{\bf Export options} 725%{\bf Export options}
706% 726%
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dfea40b56ba..6a568afe055 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,325 @@
12007-07-15 Karl Fogel <kfogel@red-bean.com>
2
3 * bookmark.el: Revert 2007-07-13T18:16:17Z!kfogel@red-bean.com,
4 thus restoring bookmark bindings to three slots under C-x r. See
5 http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00705.html.
6
72007-07-15 Jeff Miller <jmiller@cablespeed.com> (tiny change)
8
9 * calendar/cal-bahai.el (calendar-goto-bahai-date): Add autoload
10 cookie.
11
122007-07-15 Jason Rumney <jasonr@gnu.org>
13
14 * w32-fns.el (set-default-process-coding-system): Use dos line ends
15 for input to cmdproxy on all versions of Windows.
16 Use dos line ends for input to plink.
17
18 * comint.el (comint-simple-send): Concat newline before sending.
19 (comint-password-prompt-regexp): Recognize plink's passphrase prompt.
20
212007-07-14 Stefan Monnier <monnier@iro.umontreal.ca>
22
23 * emacs-lisp/autoload.el (generated-autoload-file): Autoload the
24 safe-local-variable setting.
25
262007-07-14 David Kastrup <dak@gnu.org>
27
28 * emacs-lisp/advice.el (defadvice): Doc fix.
29
302007-07-14 Juanma Barranquero <lekktu@gmail.com>
31
32 * subr.el (when, unless): Doc fix.
33
342007-07-13 Dan Nicolaescu <dann@ics.uci.edu>
35
36 * replace.el (match): Use yellow1 instead of yellow.
37
38 * progmodes/gdb-ui.el (breakpoint-enabled): Use red1 instead of
39 red.
40
41 * pcvs-info.el (cvs-unknown): Likewise.
42
432007-07-13 Eli Zaretskii <eliz@gnu.org>
44
45 * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets.
46 (install): Use them to copy all *.el files before *.elc.
47
482007-07-13 Drew Adams <drew.adams@oracle.com>
49
50 * bookmark.el (bookmark-jump-other-window): New function.
51 (bookmark-map): Bind it to "o".
52
53 http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html
54 and its thread contains discussion about this change.
55 The original patch was slightly tweaked by Karl Fogel
56 <kfogel@red-bean.com> before committing.
57
582007-07-13 Karl Fogel <kfogel@red-bean.com>
59
60 * bookmark.el: Shorten some comments to fit within 80 lines.
61
622007-07-13 Karl Fogel <kfogel@red-bean.com>
63
64 * bookmark.el: Don't define bookmark keys under the "C-xr" map;
65 instead, make "C-xp" a prefix for bookmark-map. Patch by Drew
66 Adams <drew.adams@oracle.com>, mildly tweaked by me. See
67 http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html.
68
692007-07-13 Carsten Dominik <dominik@science.uva.nl>
70
71 * textmodes/org.el: Bug fixes.
72 (org-end-of-line): Move to end of line if in headline without tags.
73
742007-07-13 Stefan Monnier <monnier@iro.umontreal.ca>
75
76 * vc-hooks.el: Remove spurious * in docstrings.
77 (vc-handled-backends): Add BZR.
78
79 * vc-hooks.el (vc-find-file-hook): Use with-demoted-errors.
80
812007-07-12 Davis Herring <herring@lanl.gov>
82
83 * desktop.el (desktop-buffer-info, desktop-save):
84 Use `desktop-dirname' instead of `dirname'.
85
862007-07-12 Paul Pogonyshev <pogonyshev@gmx.net>
87
88 * progmodes/which-func.el (which-func-modes): Add `python-mode'.
89
90 * progmodes/python.el (python-which-func-length-limit): New var.
91 (python-which-func): New function.
92 (python-current-defun): Add optional `length-limit' and try to fit
93 computed function name to that length.
94 (python-mode): Hook `python-which-func' up.
95
962007-07-12 Sean O'Rourke <sorourke@cs.ucsd.edu> (tiny change)
97
98 * pcomplete.el (pcomplete-entries): Obey pcomplete-ignore-case.
99
100 * comint.el (comint-dynamic-complete-as-filename):
101 Use read-file-name-completion-ignore-case.
102
1032007-07-12 Stefan Monnier <monnier@iro.umontreal.ca>
104
105 * comint.el (comint-dynamic-list-filename-completions):
106 Use read-file-name-completion-ignore-case.
107
108 * vc-cvs.el: Require CL.
109 (vc-cvs-revision-table, vc-cvs-revision-completion-table):
110 New functions to provide completion of revision names.
111
112 * vc-cvs.el (vc-functions): Clear up the cache when reloading the file.
113 (vc-cvs-annotate-first-line-re): New const.
114 (vc-cvs-annotate-process-filter): New fun.
115 (vc-cvs-annotate-command): Use them and run the command asynchronously.
116
1172007-07-12 Paul Pogonyshev <pogonyshev@gmx.net>
118
119 * emacs-lisp/eldoc.el (eldoc-last-data): Revise documentation.
120 (eldoc-print-current-symbol-info): Adjust for changed helper
121 function signatures.
122 (eldoc-get-fnsym-args-string): Add `args' argument. Use new
123 `eldoc-highlight-function-argument'.
124 (eldoc-highlight-function-argument): New function.
125 (eldoc-get-var-docstring): Format documentation with
126 `font-lock-variable-name-face'.
127 (eldoc-docstring-format-sym-doc): Add `face' argument and apply it
128 where suited.
129 (eldoc-fnsym-in-current-sexp): Return a list with argument index.
130 (eldoc-beginning-of-sexp): Return number of skipped sexps.
131
1322007-07-11 Michael Albinus <michael.albinus@gmx.de>
133
134 * progmodes/compile.el (compilation-start): `start-process' must
135 still be redefined when calling `start-process-shell-command'.
136
137 * progmodes/gud.el (gud-file-name): When `default-directory' is a
138 remote file name, prepend its remote part to the filename.
139 (gud-common-init): When `default-directory' is a remote file name,
140 make the filename relative to it.
141 Based on a patch by Nick Roberts <nickrob@snap.net.nz>.
142
1432007-07-11 Dan Nicolaescu <dann@ics.uci.edu>
144
145 * vc-hooks.el (vc-default-mode-line-string): Add a mouse face,
146 mouse binding and a tooltip.
147
1482007-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
149
150 * menu-bar.el (vc-menu-map): New defalias.
151
1522007-07-10 Richard Stallman <rms@gnu.org>
153
154 * emacs-lisp/lisp-mode.el (eval-defun):
155 Explain special handling of `defface'.
156
1572007-07-10 Jim Meyering <jim@meyering.net> (tiny change)
158
159 * emacs-lisp/copyright.el (copyright-current-gpl-version): Set to 3.
160
161 * autoinsert.el (auto-insert-alist): s/2/3/ in the generated comment.
162
1632007-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
164
165 * emacs-lisp/cl.el: Load cl-loaddefs.el quietly.
166
167 * vc-arch.el (vc-arch-complete): Remove.
168 (vc-arch-revision-completion-table): Use complete-with-action.
169
170 * subr.el (condition-case-no-debug, with-demoted-errors): New macros.
171 (complete-with-action): New function.
172 (dynamic-completion-table): Use it.
173
1742007-07-10 Michael Albinus <michael.albinus@gmx.de>
175
176 * comint.el (make-comint, make-comint-in-buffer)
177 (comint-exec-1): Replace `start-process' by `start-file-process'.
178
179 * progmodes/compile.el (compilation-start): Revert redefining
180 `start-process'.
181
1822007-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
183
184 * emacs-lisp/autoload.el (autoload-generate-file-autoloads): Be careful
185 with EOLs when generating MD5 checksums.
186
187 * follow.el: Don't change the global map from the follow-mode-map
188 defvar, but from the toplevel. Use easy-menu to unify the Emacs and
189 XEmacs code.
190 (turn-on-follow-mode, turn-off-follow-mode): Remove interactive spec
191 since `follow-mode' should be used instead for that.
192
193 * emacs-lisp/easymenu.el (easy-menu-binding): New function.
194 (easy-menu-do-define): Use it.
195 (easy-menu-do-add-item): Inline into easy-menu-add-item and then remove.
196
197 * progmodes/compile.el (compilation-auto-jump-to-first-error)
198 (compilation-auto-jump-to-next): New vars.
199 (compilation-auto-jump): New function.
200 (compilation-error-properties): Use them to jump to first error.
201 (compilation-start): Set the var if requested.
202
203 * emacs-lisp/autoload.el (update-directory-autoloads): Remove
204 duplicates without also removing entries from other directories.
205
2062007-07-10 Carsten Dominik <dominik@science.uva.nl>
207
208 * textmodes/org.el (org-agenda-day-view, org-agenda-week-view):
209 Remember span as default.
210 (org-columns-edit-value): Rename from `org-column-edit'.
211 (org-columns-display-here-title): Rename from
212 `org-overlay-columns-title'.
213 (org-columns-remove-overlays): Rename from org-remove-column-overlays.
214 (org-columns-get-autowidth-alist): Rename from
215 `org-get-columns-autowidth-alist'.
216 (org-columns-display-here): Rename from `org-overlay-columns'.
217 (org-columns-new-overlay): Rename from `org-new-column-overlay'.
218 (org-columns-quit): Rename from `org-column-quit'.
219 (org-columns-show-value): Rename from `org-column-show-value'.
220 (org-columns-content, org-columns-widen)
221 (org-columns-next-allowed-value)
222 (org-columns-edit-allowed, org-columns-store-format)
223 (org-columns-uncompile-format, org-columns-redo)
224 (org-columns-edit-attributes, org-delete-property)
225 (org-set-property, org-columns-update)
226 (org-columns-compute, org-columns-eval)
227 (org-columns-not-in-agenda, org-columns-compute-all)
228 (org-property-next-allowed-value)
229 (org-columns-compile-format)
230 (org-fill-paragraph-experimental)
231 (org-string-to-number, org-property-action)
232 (org-columns-move-left, org-columns-new )
233 (org-column-number-to-string)
234 (org-property-previous-allowed-value)
235 (org-at-property-p, org-columns-delete)
236 (org-columns-previous-allowed-value)
237 (org-columns-move-right, org-columns-narrow)
238 (org-property-get-allowed-values)
239 (org-verify-version, org-column-string-to-number)
240 (org-delete-property-globally): New functions.
241 (org-columns-current-fmt): Rename from `org-current-columns-fmt'.
242 (org-columns-overlays): Rename from `org-column-overlays'.
243 (org-columns-map): Rename from `org-column-map'.
244 (org-columns-current-maxwidths): Rename from
245 `org-current-columns-maxwidths'.
246 (org-columns-begin-marker, org-columns-current-fmt-compiled)
247 (org-previous-header-line-format)
248 (org-columns-inhibit-recalculation)
249 (org-columns-top-level-marker): New variables.
250 (org-columns-default-format): Rename from `org-default-columns-format'.
251 (org-property-re): New constant.
252
2532007-07-10 Guanpeng Xu <herberteuler@hotmail.com>
254
255 * subr.el (looking-at-p, string-match-p): New functions.
256
2572007-07-09 Reiner Steib <Reiner.Steib@gmx.de>
258
259 * textmodes/tex-mode.el (tex-fontify-script)
260 (tex-font-script-display): New variables to make display of
261 superscripts and subscripts customizable.
262 (tex-font-lock-suscript, tex-font-lock-match-suscript): Use them.
263
2642007-07-09 Richard Stallman <rms@gnu.org>
265
266 * isearch.el (isearch-edit-string): Call to isearch-push-state
267 after the search.
268
2692007-07-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
270
271 * window.el (fit-window-to-buffer): Remove setting of window-min-height
272 to 1 as enlarge-window uses the value to resize/shrink windows other
273 than WINDOW if needed.
274
2752007-07-08 Katsumi Yamaoka <yamaoka@jpl.org>
276
277 * cus-start.el (file-coding-system-alist): Fix custom type.
278
2792007-07-08 Chong Yidong <cyd@stupidchicken.com>
280
281 * longlines.el (longlines-wrap-region): Avoid marking buffer as
282 modified.
283 (longlines-auto-wrap, longlines-window-change-function):
284 Remove unnecessary calls to set-buffer-modified-p.
285
2862007-07-08 Katsumi Yamaoka <yamaoka@jpl.org>
287
288 * cus-start.el (file-coding-system-alist): Fix custom type.
289
2902007-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
291
292 * vc-cvs.el (vc-cvs-revert): Use vc-default-revert.
293 (vc-cvs-checkout): Remove last arg now unused; simplify.
294
2952007-07-08 Michael Albinus <michael.albinus@gmx.de>
296
297 * files.el (file-remote-p): Introduce optional parameter CONNECTED.
298
299 * net/tramp.el:
300 * net/tramp-ftp.el:
301 * net/tramp-smb.el:
302 * net/tramp-uu.el:
303 * net/trampver.el: Migrate to Tramp 2.1.
304
305 * net/tramp-cache.el:
306 * net/tramp-fish.el:
307 * net/tramp-gw.el: New Tramp packages.
308
309 * net/tramp-util.el:
310 * net/tramp-vc.el: Removed.
311
312 * net/ange-ftp.el: Add ange-ftp property to 'start-file-process
313 (ange-ftp-file-remote-p): Handle optional parameter CONNECTED.
314
315 * net/rcompile.el (remote-compile): Handle Tramp 2.1 arguments.
316
317 * progmodes/compile.el (compilation-start): Redefine
318 `start-process' temporarily when `default-directory' is remote.
319 Remove case of synchronous compilation, this won't happen ever.
320 (compilation-setup): Make local variable `comint-file-name-prefix'
321 for remote compilation.
322
12007-07-08 Martin Rudalics <rudalics@gmx.at> 3232007-07-08 Martin Rudalics <rudalics@gmx.at>
2 324
3 * novice.el (disabled-command-function): Fit window to buffer to 325 * novice.el (disabled-command-function): Fit window to buffer to
@@ -16,20 +338,21 @@
16 (math-bignum-digit-power-of-two): Evaluate when compiled. 338 (math-bignum-digit-power-of-two): Evaluate when compiled.
17 339
18 * calc/calc-comb.el (math-small-factorial-table) 340 * calc/calc-comb.el (math-small-factorial-table)
19 (math-init-random-base,math-prime-test): Remove unnecessary calls 341 (math-init-random-base, math-prime-test): Remove unnecessary calls
20 to `math-read-number-simple'. 342 to `math-read-number-simple'.
21 343
22 * calc/calc-ext.el (math-approx-pi,math-approx-sqrt-e) 344 * calc/calc-ext.el (math-approx-pi, math-approx-sqrt-e)
23 (math-approx-gamma-const): Add docstrings. 345 (math-approx-gamma-const): Add docstrings.
24 346
25 * calc/calc-forms.el (math-julian-date-beginning) 347 * calc/calc-forms.el (math-julian-date-beginning)
26 (math-julian-date-beginning-int) New constants. 348 (math-julian-date-beginning-int): New constants.
27 (math-format-date-part,math-parse-standard-date,calcFunc-julian): 349 (math-format-date-part, math-parse-standard-date, calcFunc-julian):
28 Use the new constants. 350 Use the new constants.
29 351
30 * calc/calc-funcs.el (math-gammap1-raw): Add docstring. 352 * calc/calc-funcs.el (math-gammap1-raw): Add docstring.
31 353
32 * calc/calc-math.el (math-approx-ln-10,math-approx-ln-2): Add docstrings. 354 * calc/calc-math.el (math-approx-ln-10, math-approx-ln-2):
355 Add docstrings.
33 356
342007-07-07 Tom Tromey <tromey@redhat.com> 3572007-07-07 Tom Tromey <tromey@redhat.com>
35 358
@@ -106,8 +429,8 @@
106 429
107 * calc/calc-bin.el (math-bignum-logb-digit-size) 430 * calc/calc-bin.el (math-bignum-logb-digit-size)
108 (math-bignum-digit-power-of-two): New constants. 431 (math-bignum-digit-power-of-two): New constants.
109 (math-and-bignum,math-or-bignum,math-xor-bignum,math-diff-bignum) 432 (math-and-bignum, math-or-bignum, math-xor-bignum, math-diff-bignum)
110 (math-not-bignum,math-clip-bignum): Use the constants 433 (math-not-bignum, math-clip-bignum): Use the constants
111 `math-bignum-digit-power-of-two' and `math-bignum-logb-digit-size' 434 `math-bignum-digit-power-of-two' and `math-bignum-logb-digit-size'
112 instead of their values. 435 instead of their values.
113 (math-clip): Use math-small-integer-size instead of its value. 436 (math-clip): Use math-small-integer-size instead of its value.
@@ -186,6 +509,11 @@
186 * calculator.el (calculator-expt): Use more cases to determine 509 * calculator.el (calculator-expt): Use more cases to determine
187 the value. 510 the value.
188 511
5122007-07-03 Dan Nicolaescu <dann@ics.uci.edu>
513
514 * progmodes/gud.el (auto-mode-alist): Match more valid gdb init
515 file names.
516
1892007-07-03 Jay Belanger <jay.p.belanger@gmail.com> 5172007-07-03 Jay Belanger <jay.p.belanger@gmail.com>
190 518
191 * calculator.el (calculator-expt, calculator-integer-p): 519 * calculator.el (calculator-expt, calculator-integer-p):
@@ -261,7 +589,7 @@
261 589
2622007-07-02 Martin Rudalics <rudalics@gmx.at> 5902007-07-02 Martin Rudalics <rudalics@gmx.at>
263 591
264 * help-mode.el (help-make-xrefs): Skip spaces too when 592 * help-mode.el (help-make-xrefs): Skip spaces too when
265 skipping tabs. 593 skipping tabs.
266 594
267 * ffap.el (dired-at-point-prompter): Improve prompt in 595 * ffap.el (dired-at-point-prompter): Improve prompt in
@@ -269,6 +597,10 @@
269 597
2702007-07-01 Richard Stallman <rms@gnu.org> 5982007-07-01 Richard Stallman <rms@gnu.org>
271 599
600 * files.el (find-file-visit-truename): Fix safe-local-variable value.
601
6022007-07-01 Richard Stallman <rms@gnu.org>
603
272 * cus-start.el (max-mini-window-height): Added. 604 * cus-start.el (max-mini-window-height): Added.
273 605
2742007-07-01 Sean O'Rourke <sorourke@cs.ucsd.edu> (tiny change) 6062007-07-01 Sean O'Rourke <sorourke@cs.ucsd.edu> (tiny change)
@@ -918,7 +1250,7 @@
918 post-command-hook. 1250 post-command-hook.
919 (rcirc-window-configuration-change-1): Update mode-line and 1251 (rcirc-window-configuration-change-1): Update mode-line and
920 overlay arrows here. 1252 overlay arrows here.
921 (rcirc-authenticate): Fix chanserv identification. 1253 (rcirc-authenticate): Fixc hanserv identification.
922 (rcirc-default-server): Remove variable. 1254 (rcirc-default-server): Remove variable.
923 (rcirc): Connect according to rcirc-connections. 1255 (rcirc): Connect according to rcirc-connections.
924 (rcirc-connections): Add variable. 1256 (rcirc-connections): Add variable.
@@ -1536,7 +1868,7 @@
1536 1868
1537 * files.el (auto-mode-alist): Open `.asd' files in lisp-mode. 1869 * files.el (auto-mode-alist): Open `.asd' files in lisp-mode.
1538 1870
15392007-05-22 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 18712007-05-22 Katsumi Yamaoka <yamaoka@jpl.org>
1540 1872
1541 * mail/mail-extr.el (mail-extract-address-components): 1873 * mail/mail-extr.el (mail-extract-address-components):
1542 Recognize non-ASCII characters except for NBSP as words. 1874 Recognize non-ASCII characters except for NBSP as words.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index d6d69c52924..d63ef8fbbd7 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -1340,7 +1340,7 @@
1340 (shell-directory-tracker): Make regexp used for skipping to next 1340 (shell-directory-tracker): Make regexp used for skipping to next
1341 command correspond to one used for command itself. 1341 command correspond to one used for command itself.
1342 1342
13432003-06-13 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 13432003-06-13 Katsumi Yamaoka <yamaoka@jpl.org>
1344 1344
1345 * textmodes/texinfmt.el (texinfo-format-scan): 1345 * textmodes/texinfmt.el (texinfo-format-scan):
1346 Silence `whitespace-cleanup'. 1346 Silence `whitespace-cleanup'.
@@ -11805,7 +11805,7 @@
11805 11805
11806 * vc-hooks.el (vc-kill-buffer-hook): Add it to kill-buffer-hook again. 11806 * vc-hooks.el (vc-kill-buffer-hook): Add it to kill-buffer-hook again.
11807 11807
118082002-08-22 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 118082002-08-22 Katsumi Yamaoka <yamaoka@jpl.org>
11809 11809
11810 * frame.el (select-frame-by-name, select-frame-set-input-focus): 11810 * frame.el (select-frame-by-name, select-frame-set-input-focus):
11811 Always call x-focus-frame, if using x. 11811 Always call x-focus-frame, if using x.
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index ac47f4eaeaa..0ef83a0ed9d 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -5295,7 +5295,7 @@
5295 (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax. 5295 (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax.
5296 (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'. 5296 (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'.
5297 5297
52982004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 52982004-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
5299 5299
5300 * mail/mail-extr.el (mail-extr-disable-voodoo): New variable. 5300 * mail/mail-extr.el (mail-extr-disable-voodoo): New variable.
5301 (mail-extr-voodoo): Check mail-extr-disable-voodoo. 5301 (mail-extr-voodoo): Check mail-extr-disable-voodoo.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index 957d9a51bb4..2d4882a8b1e 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -1092,8 +1092,8 @@
1092 North American rule. Replace "daylight savings" with "daylight 1092 North American rule. Replace "daylight savings" with "daylight
1093 saving" in doc. 1093 saving" in doc.
1094 1094
1095 * calendar/cal-china.el,cal-dst.el,calendar.el,diary-lib.el: 1095 * calendar/cal-china.el, cal-dst.el, calendar.el, diary-lib.el:
1096 * calendar/lunar.el,solar.el: Replace "daylight savings" with 1096 * calendar/lunar.el, solar.el: Replace "daylight savings" with
1097 "daylight saving" in text. 1097 "daylight saving" in text.
1098 1098
1099 * woman.el (woman-change-fonts): Tweak previous change by using 1099 * woman.el (woman-change-fonts): Tweak previous change by using
@@ -8709,7 +8709,7 @@
8709 * term.el (term-handle-scroll, term-delete-lines) 8709 * term.el (term-handle-scroll, term-delete-lines)
8710 (term-insert-lines): Fix off by one errors. 8710 (term-insert-lines): Fix off by one errors.
8711 8711
87122006-06-15 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 87122006-06-15 Katsumi Yamaoka <yamaoka@jpl.org>
8713 8713
8714 * net/tramp.el (tramp-touch): Use UTC to express time. 8714 * net/tramp.el (tramp-touch): Use UTC to express time.
8715 8715
@@ -22969,7 +22969,7 @@
22969 22969
22970 * menu-bar.el (menu-bar-showhide-menu): Add `showhide-battery'. 22970 * menu-bar.el (menu-bar-showhide-menu): Add `showhide-battery'.
22971 22971
229722005-08-09 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) 229722005-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
22973 22973
22974 * net/ange-ftp.el (ange-ftp-send-cmd): Make it work properly with 22974 * net/ange-ftp.el (ange-ftp-send-cmd): Make it work properly with
22975 uploading files. 22975 uploading files.
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 3f615dcfbd3..dcacc6a99ff 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -188,7 +188,7 @@ If this contains a %s, that will be replaced by the matching rule."
188 188
189\;; This file is free software; you can redistribute it and/or modify 189\;; This file is free software; you can redistribute it and/or modify
190\;; it under the terms of the GNU General Public License as published by 190\;; it under the terms of the GNU General Public License as published by
191\;; the Free Software Foundation; either version 2, or (at your option) 191\;; the Free Software Foundation; either version 3, or (at your option)
192\;; any later version. 192\;; any later version.
193 193
194\;; This file is distributed in the hope that it will be useful, 194\;; This file is distributed in the hope that it will be useful,
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 3c1469fef97..75c4826ae0b 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -240,12 +240,13 @@ functions have a binding in this keymap.")
240 240
241;; Read the help on all of these functions for details... 241;; Read the help on all of these functions for details...
242;;;###autoload (define-key bookmark-map "x" 'bookmark-set) 242;;;###autoload (define-key bookmark-map "x" 'bookmark-set)
243;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark" 243;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark
244;;;###autoload (define-key bookmark-map "j" 'bookmark-jump) 244;;;###autoload (define-key bookmark-map "j" 'bookmark-jump)
245;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go" 245;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ;"g"o
246;;;###autoload (define-key bookmark-map "o" 'bookmark-jump-other-window)
246;;;###autoload (define-key bookmark-map "i" 'bookmark-insert) 247;;;###autoload (define-key bookmark-map "i" 'bookmark-insert)
247;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks) 248;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks)
248;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find" 249;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ;"f"ind
249;;;###autoload (define-key bookmark-map "r" 'bookmark-rename) 250;;;###autoload (define-key bookmark-map "r" 'bookmark-rename)
250;;;###autoload (define-key bookmark-map "d" 'bookmark-delete) 251;;;###autoload (define-key bookmark-map "d" 'bookmark-delete)
251;;;###autoload (define-key bookmark-map "l" 'bookmark-load) 252;;;###autoload (define-key bookmark-map "l" 'bookmark-load)
@@ -1083,6 +1084,27 @@ of the old one in the permanent bookmark record."
1083 (bookmark-show-annotation bookmark))))) 1084 (bookmark-show-annotation bookmark)))))
1084 1085
1085 1086
1087;;;###autoload
1088(defun bookmark-jump-other-window (bookmark)
1089 "Jump to BOOKMARK (a point in some file) in another window.
1090See `bookmark-jump'."
1091 (interactive
1092 (let ((bkm (bookmark-completing-read "Jump to bookmark (in another window)"
1093 bookmark-current-bookmark)))
1094 (if (> emacs-major-version 21)
1095 (list bkm) bkm)))
1096 (when bookmark
1097 (bookmark-maybe-historicize-string bookmark)
1098 (let ((cell (bookmark-jump-noselect bookmark)))
1099 (and cell
1100 (switch-to-buffer-other-window (car cell))
1101 (goto-char (cdr cell))
1102 (if bookmark-automatically-show-annotations
1103 ;; if there is an annotation for this bookmark,
1104 ;; show it in a buffer.
1105 (bookmark-show-annotation bookmark))))))
1106
1107
1086(defun bookmark-file-or-variation-thereof (file) 1108(defun bookmark-file-or-variation-thereof (file)
1087 "Return FILE (a string) if it exists, or return a reasonable 1109 "Return FILE (a string) if it exists, or return a reasonable
1088variation of FILE if that exists. Reasonable variations are checked 1110variation of FILE if that exists. Reasonable variations are checked
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 06703e3b73b..7bf90ec5d11 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -149,6 +149,7 @@ Defaults to today's date if DATE is not given."
149 (message "Baha'i date: %s" 149 (message "Baha'i date: %s"
150 (calendar-bahai-date-string (calendar-cursor-to-date t)))) 150 (calendar-bahai-date-string (calendar-cursor-to-date t))))
151 151
152;;;###autoload
152(defun calendar-goto-bahai-date (date &optional noecho) 153(defun calendar-goto-bahai-date (date &optional noecho)
153 "Move cursor to Baha'i date DATE. 154 "Move cursor to Baha'i date DATE.
154Echo Baha'i date unless NOECHO is t." 155Echo Baha'i date unless NOECHO is t."
diff --git a/lisp/comint.el b/lisp/comint.el
index 7d81f357e22..17ab13337aa 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -333,12 +333,13 @@ This variable is buffer-local."
333;; kinit prints a prompt like `Password for devnull@GNU.ORG: '. 333;; kinit prints a prompt like `Password for devnull@GNU.ORG: '.
334;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '. 334;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '.
335;; ssh-add prints a prompt like `Enter passphrase: '. 335;; ssh-add prints a prompt like `Enter passphrase: '.
336;; plink prints a prompt like `Passphrase for key "root@GNU.ORG": '.
336;; Some implementations of passwd use "Password (again)" as the 2nd prompt. 337;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
337(defcustom comint-password-prompt-regexp 338(defcustom comint-password-prompt-regexp
338 "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\ 339 "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
339Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\ 340Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\
340\[Pp]assword\\( (again)\\)?\\|\ 341\[Pp]assword\\( (again)\\)?\\|\
341pass phrase\\|\\(Enter\\|Repeat\\|Bad\\) passphrase\\)\ 342pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\
342\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'" 343\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'"
343 "*Regexp matching prompts for passwords in the inferior process. 344 "*Regexp matching prompts for passwords in the inferior process.
344This is used by `comint-watch-for-password-prompt'." 345This is used by `comint-watch-for-password-prompt'."
@@ -670,13 +671,13 @@ BUFFER can be either a buffer or the name of one."
670 "Make a Comint process NAME in BUFFER, running PROGRAM. 671 "Make a Comint process NAME in BUFFER, running PROGRAM.
671If BUFFER is nil, it defaults to NAME surrounded by `*'s. 672If BUFFER is nil, it defaults to NAME surrounded by `*'s.
672PROGRAM should be either a string denoting an executable program to create 673PROGRAM should be either a string denoting an executable program to create
673via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP 674via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
674connection to be opened via `open-network-stream'. If there is already a 675a TCP connection to be opened via `open-network-stream'. If there is already
675running process in that buffer, it is not restarted. Optional fourth arg 676a running process in that buffer, it is not restarted. Optional fourth arg
676STARTFILE is the name of a file to send the contents of to the process. 677STARTFILE is the name of a file to send the contents of to the process.
677 678
678If PROGRAM is a string, any more args are arguments to PROGRAM." 679If PROGRAM is a string, any more args are arguments to PROGRAM."
679 (or (fboundp 'start-process) 680 (or (fboundp 'start-file-process)
680 (error "Multi-processing is not supported for this system")) 681 (error "Multi-processing is not supported for this system"))
681 (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) 682 (setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
682 ;; If no process, or nuked process, crank up a new one and put buffer in 683 ;; If no process, or nuked process, crank up a new one and put buffer in
@@ -693,9 +694,9 @@ If PROGRAM is a string, any more args are arguments to PROGRAM."
693 "Make a Comint process NAME in a buffer, running PROGRAM. 694 "Make a Comint process NAME in a buffer, running PROGRAM.
694The name of the buffer is made by surrounding NAME with `*'s. 695The name of the buffer is made by surrounding NAME with `*'s.
695PROGRAM should be either a string denoting an executable program to create 696PROGRAM should be either a string denoting an executable program to create
696via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP 697via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
697connection to be opened via `open-network-stream'. If there is already a 698a TCP connection to be opened via `open-network-stream'. If there is already
698running process in that buffer, it is not restarted. Optional third arg 699a running process in that buffer, it is not restarted. Optional third arg
699STARTFILE is the name of a file to send the contents of the process to. 700STARTFILE is the name of a file to send the contents of the process to.
700 701
701If PROGRAM is a string, any more args are arguments to PROGRAM." 702If PROGRAM is a string, any more args are arguments to PROGRAM."
@@ -781,17 +782,17 @@ buffer. The hook `comint-exec-hook' is run after each exec."
781 ;; If the command has slashes, make sure we 782 ;; If the command has slashes, make sure we
782 ;; first look relative to the current directory. 783 ;; first look relative to the current directory.
783 (cons default-directory exec-path) exec-path))) 784 (cons default-directory exec-path) exec-path)))
784 (setq proc (apply 'start-process name buffer command switches))) 785 (setq proc (apply 'start-file-process name buffer command switches)))
785 (let ((coding-systems (process-coding-system proc))) 786 (let ((coding-systems (process-coding-system proc)))
786 (setq decoding (car coding-systems) 787 (setq decoding (car coding-systems)
787 encoding (cdr coding-systems))) 788 encoding (cdr coding-systems)))
788 ;; If start-process decided to use some coding system for decoding 789 ;; If start-file-process decided to use some coding system for decoding
789 ;; data sent from the process and the coding system doesn't 790 ;; data sent from the process and the coding system doesn't
790 ;; specify EOL conversion, we had better convert CRLF to LF. 791 ;; specify EOL conversion, we had better convert CRLF to LF.
791 (if (vectorp (coding-system-eol-type decoding)) 792 (if (vectorp (coding-system-eol-type decoding))
792 (setq decoding (coding-system-change-eol-conversion decoding 'dos) 793 (setq decoding (coding-system-change-eol-conversion decoding 'dos)
793 changed t)) 794 changed t))
794 ;; Even if start-process left the coding system for encoding data 795 ;; Even if start-file-process left the coding system for encoding data
795 ;; sent from the process undecided, we had better use the same one 796 ;; sent from the process undecided, we had better use the same one
796 ;; as what we use for decoding. But, we should suppress EOL 797 ;; as what we use for decoding. But, we should suppress EOL
797 ;; conversion. 798 ;; conversion.
@@ -1953,11 +1954,16 @@ If this takes us past the end of the current line, don't skip at all."
1953 "Default function for sending to PROC input STRING. 1954 "Default function for sending to PROC input STRING.
1954This just sends STRING plus a newline. To override this, 1955This just sends STRING plus a newline. To override this,
1955set the hook `comint-input-sender'." 1956set the hook `comint-input-sender'."
1956 (comint-send-string proc string) 1957 (let ((send-string
1957 (if comint-input-sender-no-newline 1958 (if comint-input-sender-no-newline
1958 (if (not (string-equal string "")) 1959 string
1959 (process-send-eof)) 1960 ;; Sending as two separate strings does not work
1960 (comint-send-string proc "\n"))) 1961 ;; on Windows, so concat the \n before sending.
1962 (concat string "\n"))))
1963 (comint-send-string proc send-string))
1964 (if (and comint-input-sender-no-newline
1965 (not (string-equal string "")))
1966 (process-send-eof)))
1961 1967
1962(defun comint-line-beginning-position () 1968(defun comint-line-beginning-position ()
1963 "Return the buffer position of the beginning of the line, after any prompt. 1969 "Return the buffer position of the beginning of the line, after any prompt.
@@ -2805,7 +2811,7 @@ Returns t if successful."
2805(defun comint-dynamic-complete-as-filename () 2811(defun comint-dynamic-complete-as-filename ()
2806 "Dynamically complete at point as a filename. 2812 "Dynamically complete at point as a filename.
2807See `comint-dynamic-complete-filename'. Returns t if successful." 2813See `comint-dynamic-complete-filename'. Returns t if successful."
2808 (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) 2814 (let* ((completion-ignore-case read-file-name-completion-ignore-case)
2809 (completion-ignored-extensions comint-completion-fignore) 2815 (completion-ignored-extensions comint-completion-fignore)
2810 ;; If we bind this, it breaks remote directory tracking in rlogin.el. 2816 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
2811 ;; I think it was originally bound to solve file completion problems, 2817 ;; I think it was originally bound to solve file completion problems,
@@ -2934,7 +2940,7 @@ See also `comint-dynamic-complete-filename'."
2934(defun comint-dynamic-list-filename-completions () 2940(defun comint-dynamic-list-filename-completions ()
2935 "List in help buffer possible completions of the filename at point." 2941 "List in help buffer possible completions of the filename at point."
2936 (interactive) 2942 (interactive)
2937 (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) 2943 (let* ((completion-ignore-case read-file-name-completion-ignore-case)
2938 ;; If we bind this, it breaks remote directory tracking in rlogin.el. 2944 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
2939 ;; I think it was originally bound to solve file completion problems, 2945 ;; I think it was originally bound to solve file completion problems,
2940 ;; but subsequent changes may have made this unnecessary. sm. 2946 ;; but subsequent changes may have made this unnecessary. sm.
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index e003e4f4622..3f2bd91ca84 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -125,8 +125,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
125 :value (undecided . undecided) 125 :value (undecided . undecided)
126 (coding-system :tag "Decoding") 126 (coding-system :tag "Decoding")
127 (coding-system :tag "Encoding")) 127 (coding-system :tag "Encoding"))
128 (coding-system :tag "Single coding system" 128 (coding-system
129 :value undecided) 129 :tag "Single coding system"
130 :value undecided
131 :match (lambda (widget value)
132 (and value (not (functionp value)))))
130 (function :value ignore)))) 133 (function :value ignore))))
131 (selection-coding-system mule coding-system) 134 (selection-coding-system mule coding-system)
132 ;; dired.c 135 ;; dired.c
diff --git a/lisp/desktop.el b/lisp/desktop.el
index ca5ed9290b0..4f6524ec3f6 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -652,7 +652,7 @@ is nil, ask the user where to save the desktop."
652 (set-buffer buffer) 652 (set-buffer buffer)
653 (list 653 (list
654 ;; basic information 654 ;; basic information
655 (desktop-file-name (buffer-file-name) dirname) 655 (desktop-file-name (buffer-file-name) desktop-dirname)
656 (buffer-name) 656 (buffer-name)
657 major-mode 657 major-mode
658 ;; minor modes 658 ;; minor modes
@@ -673,7 +673,7 @@ is nil, ask the user where to save the desktop."
673 buffer-read-only 673 buffer-read-only
674 ;; auxiliary information 674 ;; auxiliary information
675 (when (functionp desktop-save-buffer) 675 (when (functionp desktop-save-buffer)
676 (funcall desktop-save-buffer dirname)) 676 (funcall desktop-save-buffer desktop-dirname))
677 ;; local variables 677 ;; local variables
678 (let ((locals desktop-locals-to-save) 678 (let ((locals desktop-locals-to-save)
679 (loclist (buffer-local-variables)) 679 (loclist (buffer-local-variables))
@@ -897,7 +897,7 @@ See also `desktop-base-file-name'."
897 (insert "\n " (desktop-value-to-string e))) 897 (insert "\n " (desktop-value-to-string e)))
898 (insert ")\n\n"))) 898 (insert ")\n\n")))
899 899
900 (setq default-directory dirname) 900 (setq default-directory desktop-dirname)
901 (let ((coding-system-for-write 'emacs-mule)) 901 (let ((coding-system-for-write 'emacs-mule))
902 (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) 902 (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
903 ;; We remember when it was modified (which is presumably just now). 903 ;; We remember when it was modified (which is presumably just now).
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 8023bc58a53..0123124b26d 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -3759,7 +3759,7 @@ The syntax of `defadvice' is as follows:
3759 3759
3760 \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) 3760 \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
3761 [DOCSTRING] [INTERACTIVE-FORM] 3761 [DOCSTRING] [INTERACTIVE-FORM]
3762 BODY... ) 3762 BODY...)
3763 3763
3764FUNCTION ::= Name of the function to be advised. 3764FUNCTION ::= Name of the function to be advised.
3765CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. 3765CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 93ba83bb729..6495ca2a5e9 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -41,6 +41,7 @@
41A `.el' file can set this in its local variables section to make its 41A `.el' file can set this in its local variables section to make its
42autoloads go somewhere else. The autoload file is assumed to contain a 42autoloads go somewhere else. The autoload file is assumed to contain a
43trailer starting with a FormFeed character.") 43trailer starting with a FormFeed character.")
44;;;###autoload
44(put 'generated-autoload-file 'safe-local-variable 'stringp) 45(put 'generated-autoload-file 'safe-local-variable 'stringp)
45 46
46;; This feels like it should be a defconst, but MH-E sets it to 47;; This feels like it should be a defconst, but MH-E sets it to
@@ -432,7 +433,10 @@ Return non-nil iff FILE adds no autoloads to OUTFILE
432 ;; checksum in secondary autoload files where we do 433 ;; checksum in secondary autoload files where we do
433 ;; not need the time-stamp optimization because it is 434 ;; not need the time-stamp optimization because it is
434 ;; already provided by the primary autoloads file. 435 ;; already provided by the primary autoloads file.
435 (md5 secondary-autoloads-file-buf nil nil 'emacs-mule) 436 (md5 secondary-autoloads-file-buf
437 ;; We'd really want to just use
438 ;; `emacs-internal' instead.
439 nil nil 'emacs-mule-unix)
436 (nth 5 (file-attributes relfile)))) 440 (nth 5 (file-attributes relfile))))
437 (insert ";;; Generated autoloads from " relfile "\n")) 441 (insert ";;; Generated autoloads from " relfile "\n"))
438 (insert generate-autoload-section-trailer)))) 442 (insert generate-autoload-section-trailer))))
@@ -559,6 +563,7 @@ directory or directories specified."
559 (directory-files (expand-file-name dir) 563 (directory-files (expand-file-name dir)
560 t files-re)) 564 t files-re))
561 dirs))) 565 dirs)))
566 (done ())
562 (this-time (current-time)) 567 (this-time (current-time))
563 ;; Files with no autoload cookies or whose autoloads go to other 568 ;; Files with no autoload cookies or whose autoloads go to other
564 ;; files because of file-local autoload-generated-file settings. 569 ;; files because of file-local autoload-generated-file settings.
@@ -592,10 +597,10 @@ directory or directories specified."
592 (push file no-autoloads) 597 (push file no-autoloads)
593 (setq files (delete file files))))))) 598 (setq files (delete file files)))))))
594 ((not (stringp file))) 599 ((not (stringp file)))
595 ((not (and (file-exists-p file) 600 ((or (not (file-exists-p file))
596 ;; Remove duplicates as well, just in case. 601 ;; Remove duplicates as well, just in case.
597 (member file files))) 602 (member file done))
598 ;; Remove the obsolete section. 603 ;; Remove the obsolete section.
599 (autoload-remove-section (match-beginning 0))) 604 (autoload-remove-section (match-beginning 0)))
600 ((not (time-less-p (nth 4 form) 605 ((not (time-less-p (nth 4 form)
601 (nth 5 (file-attributes file)))) 606 (nth 5 (file-attributes file))))
@@ -606,6 +611,7 @@ directory or directories specified."
606 (if (autoload-generate-file-autoloads 611 (if (autoload-generate-file-autoloads
607 file (current-buffer) buffer-file-name) 612 file (current-buffer) buffer-file-name)
608 (push file no-autoloads)))) 613 (push file no-autoloads))))
614 (push file done)
609 (setq files (delete file files))))) 615 (setq files (delete file files)))))
610 ;; Elements remaining in FILES have no existing autoload sections yet. 616 ;; Elements remaining in FILES have no existing autoload sections yet.
611 (dolist (file files) 617 (dolist (file files)
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 65cb0754446..1589e19cbb2 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -10,8 +10,7 @@
10;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p 10;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
11;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively 11;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
12;;;;;; notevery notany every some mapcon mapcan mapl maplist map 12;;;;;; notevery notany every some mapcon mapcan mapl maplist map
13;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" (18050 13;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "47c92504dda976a632c2c10bedd4b6a4")
14;;;;;; 46455))
15;;; Generated autoloads from cl-extra.el 14;;; Generated autoloads from cl-extra.el
16 15
17(autoload (quote coerce) "cl-extra" "\ 16(autoload (quote coerce) "cl-extra" "\
@@ -284,7 +283,7 @@ Not documented
284;;;;;; do* do loop return-from return block etypecase typecase ecase 283;;;;;; do* do loop return-from return block etypecase typecase ecase
285;;;;;; case load-time-value eval-when destructuring-bind function* 284;;;;;; case load-time-value eval-when destructuring-bind function*
286;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" 285;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs"
287;;;;;; "cl-macs.el" (18051 52572)) 286;;;;;; "cl-macs.el" "7ccc827d272482ca276937ca18a7895a")
288;;; Generated autoloads from cl-macs.el 287;;; Generated autoloads from cl-macs.el
289 288
290(autoload (quote cl-compile-time-init) "cl-macs" "\ 289(autoload (quote cl-compile-time-init) "cl-macs" "\
@@ -746,7 +745,7 @@ Not documented
746;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not 745;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
747;;;;;; substitute-if substitute delete-duplicates remove-duplicates 746;;;;;; substitute-if substitute delete-duplicates remove-duplicates
748;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* 747;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
749;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" (18050 45841)) 748;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "8805f76626399794931f5db36ddf855f")
750;;; Generated autoloads from cl-seq.el 749;;; Generated autoloads from cl-seq.el
751 750
752(autoload (quote reduce) "cl-seq" "\ 751(autoload (quote reduce) "cl-seq" "\
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 233df65ac91..f8b178ac07c 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -628,7 +628,7 @@ If ALIST is non-nil, the new pairs are prepended to it."
628(fmakunbound 'dolist) 628(fmakunbound 'dolist)
629(fmakunbound 'dotimes) 629(fmakunbound 'dotimes)
630(fmakunbound 'declare) 630(fmakunbound 'declare)
631(load "cl-loaddefs") 631(load "cl-loaddefs" nil 'quiet)
632 632
633;; This goes here so that cl-macs can find it if it loads right now. 633;; This goes here so that cl-macs can find it if it loads right now.
634(provide 'cl-19) ; usage: (require 'cl-19 "cl") 634(provide 'cl-19) ; usage: (require 'cl-19 "cl")
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index d4501bd57b0..41a3144f91a 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -77,7 +77,7 @@ When this is `function', only ask when called non-interactively."
77 77
78 78
79;; when modifying this, also modify the comment generated by autoinsert.el 79;; when modifying this, also modify the comment generated by autoinsert.el
80(defconst copyright-current-gpl-version "2" 80(defconst copyright-current-gpl-version "3"
81 "String representing the current version of the GPL or nil.") 81 "String representing the current version of the GPL or nil.")
82 82
83(defvar copyright-update t) 83(defvar copyright-update t)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index d1ec5a1fe39..19df1a16a11 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -152,6 +152,21 @@ A menu item can be a list with the same format as MENU. This is a submenu."
152 ,(if symbol `(defvar ,symbol nil ,doc)) 152 ,(if symbol `(defvar ,symbol nil ,doc))
153 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) 153 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
154 154
155(defun easy-menu-binding (menu &optional item-name)
156 "Return a binding suitable to pass to `define-key'.
157This is expected to be bound to a mouse event."
158 ;; Under Emacs this is almost trivial, whereas under XEmacs this may
159 ;; involve defining a function that calls popup-menu.
160 (let ((props (if (symbolp menu)
161 (prog1 (get menu 'menu-prop)
162 (setq menu (symbol-function menu))))))
163 (cons 'menu-item
164 (cons (or item-name
165 (if (keymapp menu)
166 (keymap-prompt menu))
167 "")
168 (cons menu props)))))
169
155;;;###autoload 170;;;###autoload
156(defun easy-menu-do-define (symbol maps doc menu) 171(defun easy-menu-do-define (symbol maps doc menu)
157 ;; We can't do anything that might differ between Emacs dialects in 172 ;; We can't do anything that might differ between Emacs dialects in
@@ -173,15 +188,10 @@ A menu item can be a list with the same format as MENU. This is a submenu."
173 'identity) 188 'identity)
174 (symbol-function ,symbol))) 189 (symbol-function ,symbol)))
175 ,symbol))))) 190 ,symbol)))))
176 (mapcar (lambda (map) 191 (dolist (map (if (keymapp maps) (list maps) maps))
177 (define-key map (vector 'menu-bar (easy-menu-intern (car menu))) 192 (define-key map
178 (cons 'menu-item 193 (vector 'menu-bar (easy-menu-intern (car menu)))
179 (cons (car menu) 194 (easy-menu-binding keymap (car menu))))))
180 (if (not (symbolp keymap))
181 (list keymap)
182 (cons (symbol-function keymap)
183 (get keymap 'menu-prop)))))))
184 (if (keymapp maps) (list maps) maps))))
185 195
186(defun easy-menu-filter-return (menu &optional name) 196(defun easy-menu-filter-return (menu &optional name)
187 "Convert MENU to the right thing to return from a menu filter. 197 "Convert MENU to the right thing to return from a menu filter.
@@ -249,10 +259,6 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
249(defvar easy-menu-button-prefix 259(defvar easy-menu-button-prefix
250 '((radio . :radio) (toggle . :toggle))) 260 '((radio . :radio) (toggle . :toggle)))
251 261
252(defun easy-menu-do-add-item (menu item &optional before)
253 (setq item (easy-menu-convert-item item))
254 (easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before))
255
256(defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) 262(defvar easy-menu-converted-items-table (make-hash-table :test 'equal))
257 263
258(defun easy-menu-convert-item (item) 264(defun easy-menu-convert-item (item)
@@ -269,7 +275,7 @@ would always fail because the key is `equal' but not `eq'."
269(defun easy-menu-convert-item-1 (item) 275(defun easy-menu-convert-item-1 (item)
270 "Parse an item description and convert it to a menu keymap element. 276 "Parse an item description and convert it to a menu keymap element.
271ITEM defines an item as in `easy-menu-define'." 277ITEM defines an item as in `easy-menu-define'."
272 (let (name command label prop remove help) 278 (let (name command label prop remove)
273 (cond 279 (cond
274 ((stringp item) ; An item or separator. 280 ((stringp item) ; An item or separator.
275 (setq label item)) 281 (setq label item))
@@ -536,7 +542,8 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'."
536 (setq item (symbol-value item)))) 542 (setq item (symbol-value item))))
537 ;; Item is a keymap, find the prompt string and use as item name. 543 ;; Item is a keymap, find the prompt string and use as item name.
538 (setq item (cons (keymap-prompt item) item))) 544 (setq item (cons (keymap-prompt item) item)))
539 (easy-menu-do-add-item map item before))) 545 (setq item (easy-menu-convert-item item))
546 (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
540 547
541(defun easy-menu-item-present-p (map path name) 548(defun easy-menu-item-present-p (map path name)
542 "In submenu of MAP with path PATH, return non-nil iff item NAME is present. 549 "In submenu of MAP with path PATH, return non-nil iff item NAME is present.
@@ -615,7 +622,8 @@ In some cases we use that to select between the local and global maps."
615 (catch 'found 622 (catch 'found
616 (if (and map (symbolp map) (not (keymapp map))) 623 (if (and map (symbolp map) (not (keymapp map)))
617 (setq map (symbol-value map))) 624 (setq map (symbol-value map)))
618 (let ((maps (if map (list map) (current-active-maps)))) 625 (let ((maps (if map (if (keymapp map) (list map) map)
626 (current-active-maps))))
619 ;; Look for PATH in each map. 627 ;; Look for PATH in each map.
620 (unless map (push 'menu-bar path)) 628 (unless map (push 'menu-bar path))
621 (dolist (name path) 629 (dolist (name path)
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 85b150b6ae5..37e2eb351f2 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -124,8 +124,8 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
124(defconst eldoc-last-data (make-vector 3 nil) 124(defconst eldoc-last-data (make-vector 3 nil)
125 "Bookkeeping; elements are as follows: 125 "Bookkeeping; elements are as follows:
126 0 - contains the last symbol read from the buffer. 126 0 - contains the last symbol read from the buffer.
127 1 - contains the string last displayed in the echo area for that 127 1 - contains the string last displayed in the echo area for variables,
128 symbol, so it can be printed again if necessary without reconsing. 128 or argument string for functions.
129 2 - 'function if function args, 'variable if variable documentation.") 129 2 - 'function if function args, 'variable if variable documentation.")
130(defvar eldoc-last-message nil) 130(defvar eldoc-last-message nil)
131 131
@@ -249,12 +249,16 @@ Emacs Lisp mode) that support Eldoc.")
249 (let* ((current-symbol (eldoc-current-symbol)) 249 (let* ((current-symbol (eldoc-current-symbol))
250 (current-fnsym (eldoc-fnsym-in-current-sexp)) 250 (current-fnsym (eldoc-fnsym-in-current-sexp))
251 (doc (cond 251 (doc (cond
252 ((eq current-symbol current-fnsym) 252 ((null current-fnsym)
253 (or (eldoc-get-fnsym-args-string current-fnsym) 253 nil)
254 ((eq current-symbol (car current-fnsym))
255 (or (apply 'eldoc-get-fnsym-args-string
256 current-fnsym)
254 (eldoc-get-var-docstring current-symbol))) 257 (eldoc-get-var-docstring current-symbol)))
255 (t 258 (t
256 (or (eldoc-get-var-docstring current-symbol) 259 (or (eldoc-get-var-docstring current-symbol)
257 (eldoc-get-fnsym-args-string current-fnsym)))))) 260 (apply 'eldoc-get-fnsym-args-string
261 current-fnsym))))))
258 (eldoc-message doc)))) 262 (eldoc-message doc))))
259 ;; This is run from post-command-hook or some idle timer thing, 263 ;; This is run from post-command-hook or some idle timer thing,
260 ;; so we need to be careful that errors aren't ignored. 264 ;; so we need to be careful that errors aren't ignored.
@@ -263,24 +267,62 @@ Emacs Lisp mode) that support Eldoc.")
263;; Return a string containing the function parameter list, or 1-line 267;; Return a string containing the function parameter list, or 1-line
264;; docstring if function is a subr and no arglist is obtainable from the 268;; docstring if function is a subr and no arglist is obtainable from the
265;; docstring or elsewhere. 269;; docstring or elsewhere.
266(defun eldoc-get-fnsym-args-string (sym) 270(defun eldoc-get-fnsym-args-string (sym argument-index)
267 (let ((args nil) 271 (let ((args nil)
268 (doc nil)) 272 (doc nil))
269 (cond ((not (and sym (symbolp sym) (fboundp sym)))) 273 (cond ((not (and sym (symbolp sym) (fboundp sym))))
270 ((and (eq sym (aref eldoc-last-data 0)) 274 ((and (eq sym (aref eldoc-last-data 0))
271 (eq 'function (aref eldoc-last-data 2))) 275 (eq 'function (aref eldoc-last-data 2)))
272 (setq doc (aref eldoc-last-data 1))) 276 (setq args (aref eldoc-last-data 1)))
273 ((setq doc (help-split-fundoc (documentation sym t) sym)) 277 ((setq doc (help-split-fundoc (documentation sym t) sym))
274 (setq args (car doc)) 278 (setq args (car doc))
275 (string-match "\\`[^ )]* ?" args) 279 (string-match "\\`[^ )]* ?" args)
276 (setq args (concat "(" (substring args (match-end 0))))) 280 (setq args (concat "(" (substring args (match-end 0))))
281 (eldoc-last-data-store sym args 'function))
277 (t 282 (t
278 (setq args (eldoc-function-argstring sym)))) 283 (setq args (eldoc-function-argstring sym))))
279 (cond (args 284 (when args
280 (setq doc (eldoc-docstring-format-sym-doc sym args)) 285 (setq doc (eldoc-highlight-function-argument sym args argument-index)))
281 (eldoc-last-data-store sym doc 'function)))
282 doc)) 286 doc))
283 287
288;; Highlight argument INDEX in ARGS list for SYM.
289(defun eldoc-highlight-function-argument (sym args index)
290 (let ((start nil)
291 (end 0)
292 (argument-face 'bold))
293 ;; Find the current argument in the argument string. We need to
294 ;; handle `&rest' and informal `...' properly.
295 ;;
296 ;; FIXME: What to do with optional arguments, like in
297 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
298 ;; The problem is there is no robust way to determine if
299 ;; the current argument is indeed a docstring.
300 (while (>= index 1)
301 (if (string-match "[^ ()]+" args end)
302 (progn
303 (setq start (match-beginning 0)
304 end (match-end 0))
305 (let ((argument (match-string 0 args)))
306 (cond ((string= argument "&rest")
307 ;; All the rest arguments are the same.
308 (setq index 1))
309 ((string= argument "&optional"))
310 ((string-match "\\.\\.\\.$" argument)
311 (setq index 0))
312 (t
313 (setq index (1- index))))))
314 (setq end (length args)
315 start (1- end)
316 argument-face 'font-lock-warning-face
317 index 0)))
318 (let ((doc args))
319 (when start
320 (setq doc (copy-sequence args))
321 (add-text-properties start end (list 'face argument-face) doc))
322 (setq doc (eldoc-docstring-format-sym-doc
323 sym doc 'font-lock-function-name-face))
324 doc)))
325
284;; Return a string containing a brief (one-line) documentation string for 326;; Return a string containing a brief (one-line) documentation string for
285;; the variable. 327;; the variable.
286(defun eldoc-get-var-docstring (sym) 328(defun eldoc-get-var-docstring (sym)
@@ -292,7 +334,8 @@ Emacs Lisp mode) that support Eldoc.")
292 (let ((doc (documentation-property sym 'variable-documentation t))) 334 (let ((doc (documentation-property sym 'variable-documentation t)))
293 (cond (doc 335 (cond (doc
294 (setq doc (eldoc-docstring-format-sym-doc 336 (setq doc (eldoc-docstring-format-sym-doc
295 sym (eldoc-docstring-first-line doc))) 337 sym (eldoc-docstring-first-line doc)
338 'font-lock-variable-name-face))
296 (eldoc-last-data-store sym doc 'variable))) 339 (eldoc-last-data-store sym doc 'variable)))
297 doc))))) 340 doc)))))
298 341
@@ -316,7 +359,7 @@ Emacs Lisp mode) that support Eldoc.")
316;; If the entire line cannot fit in the echo area, the symbol name may be 359;; If the entire line cannot fit in the echo area, the symbol name may be
317;; truncated or eliminated entirely from the output to make room for the 360;; truncated or eliminated entirely from the output to make room for the
318;; description. 361;; description.
319(defun eldoc-docstring-format-sym-doc (sym doc) 362(defun eldoc-docstring-format-sym-doc (sym doc face)
320 (save-match-data 363 (save-match-data
321 (let* ((name (symbol-name sym)) 364 (let* ((name (symbol-name sym))
322 (ea-multi eldoc-echo-area-use-multiline-p) 365 (ea-multi eldoc-echo-area-use-multiline-p)
@@ -328,7 +371,7 @@ Emacs Lisp mode) that support Eldoc.")
328 (cond ((or (<= strip 0) 371 (cond ((or (<= strip 0)
329 (eq ea-multi t) 372 (eq ea-multi t)
330 (and ea-multi (> (length doc) ea-width))) 373 (and ea-multi (> (length doc) ea-width)))
331 (format "%s: %s" sym doc)) 374 (format "%s: %s" (propertize name 'face face) doc))
332 ((> (length doc) ea-width) 375 ((> (length doc) ea-width)
333 (substring (format "%s" doc) 0 ea-width)) 376 (substring (format "%s" doc) 0 ea-width))
334 ((>= strip (length name)) 377 ((>= strip (length name))
@@ -338,27 +381,44 @@ Emacs Lisp mode) that support Eldoc.")
338 ;; than the beginning, since the former is more likely 381 ;; than the beginning, since the former is more likely
339 ;; to be unique given package namespace conventions. 382 ;; to be unique given package namespace conventions.
340 (setq name (substring name strip)) 383 (setq name (substring name strip))
341 (format "%s: %s" name doc)))))) 384 (format "%s: %s" (propertize name 'face face) doc))))))
342 385
343 386
387;; Return a list of current function name and argument index.
344(defun eldoc-fnsym-in-current-sexp () 388(defun eldoc-fnsym-in-current-sexp ()
345 (let ((p (point))) 389 (save-excursion
346 (eldoc-beginning-of-sexp) 390 (let ((argument-index (1- (eldoc-beginning-of-sexp))))
347 (prog1 391 ;; If we are at the beginning of function name, this will be -1.
348 ;; Don't do anything if current word is inside a string. 392 (when (< argument-index 0)
349 (if (= (or (char-after (1- (point))) 0) ?\") 393 (setq argument-index 0))
350 nil 394 ;; Don't do anything if current word is inside a string.
351 (eldoc-current-symbol)) 395 (if (= (or (char-after (1- (point))) 0) ?\")
352 (goto-char p)))) 396 nil
353 397 (list (eldoc-current-symbol) argument-index)))))
398
399;; Move to the beginnig of current sexp. Return the number of nested
400;; sexp the point was over or after.
354(defun eldoc-beginning-of-sexp () 401(defun eldoc-beginning-of-sexp ()
355 (let ((parse-sexp-ignore-comments t)) 402 (let ((parse-sexp-ignore-comments t)
403 (num-skipped-sexps 0))
356 (condition-case err 404 (condition-case err
357 (while (progn 405 (progn
358 (forward-sexp -1) 406 ;; First account for the case the point is directly over a
359 (or (= (char-before) ?\") 407 ;; beginning of a nested sexp.
360 (> (point) (point-min))))) 408 (condition-case err
361 (error nil)))) 409 (let ((p (point)))
410 (forward-sexp -1)
411 (forward-sexp 1)
412 (when (< (point) p)
413 (setq num-skipped-sexps 1)))
414 (error))
415 (while
416 (let ((p (point)))
417 (forward-sexp -1)
418 (when (< (point) p)
419 (setq num-skipped-sexps (1+ num-skipped-sexps))))))
420 (error))
421 num-skipped-sexps))
362 422
363;; returns nil unless current word is an interned symbol. 423;; returns nil unless current word is an interned symbol.
364(defun eldoc-current-symbol () 424(defun eldoc-current-symbol ()
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 73379a816d7..374d3ae2327 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -730,7 +730,9 @@ If the current defun is actually a call to `defvar' or `defcustom',
730evaluating it this way resets the variable using its initial value 730evaluating it this way resets the variable using its initial value
731expression even if the variable already has some other value. 731expression even if the variable already has some other value.
732\(Normally `defvar' and `defcustom' do not alter the value if there 732\(Normally `defvar' and `defcustom' do not alter the value if there
733already is one.) 733already is one.) In an analogous way, evaluating a `defface'
734overrides any customizations of the face, so that it becomes
735defined exactly as the `defface' expression says.
734 736
735If `eval-expression-debug-on-error' is non-nil, which is the default, 737If `eval-expression-debug-on-error' is non-nil, which is the default,
736this command arranges for all errors to enter the debugger. 738this command arranges for all errors to enter the debugger.
diff --git a/lisp/files.el b/lisp/files.el
index 69ed54c5633..849d09b4215 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -162,7 +162,7 @@ The truename of a file is found by chasing all links
162both at the file level and at the levels of the containing directories." 162both at the file level and at the levels of the containing directories."
163 :type 'boolean 163 :type 'boolean
164 :group 'find-file) 164 :group 'find-file)
165(put 'find-file-visit-truename 'safe-local-variable 'boolean) 165(put 'find-file-visit-truename 'safe-local-variable 'booleanp)
166 166
167(defcustom revert-without-query nil 167(defcustom revert-without-query nil
168 "Specify which files should be reverted without query. 168 "Specify which files should be reverted without query.
@@ -727,17 +727,23 @@ This is an interface to the function `load'."
727 (cons load-path (get-load-suffixes))))) 727 (cons load-path (get-load-suffixes)))))
728 (load library)) 728 (load library))
729 729
730(defun file-remote-p (file) 730(defun file-remote-p (file &optional connected)
731 "Test whether FILE specifies a location on a remote system. 731 "Test whether FILE specifies a location on a remote system.
732Return an identification of the system if the location is indeed 732Return an identification of the system if the location is indeed
733remote. The identification of the system may comprise a method 733remote. The identification of the system may comprise a method
734to access the system and its hostname, amongst other things. 734to access the system and its hostname, amongst other things.
735 735
736For example, the filename \"/user@host:/foo\" specifies a location 736For example, the filename \"/user@host:/foo\" specifies a location
737on the system \"/user@host:\"." 737on the system \"/user@host:\".
738
739If CONNECTED is non-nil, the function returns an identification only
740if FILE is located on a remote system, and a connection is established
741to that remote system.
742
743`file-remote-p' will never open a connection on its own."
738 (let ((handler (find-file-name-handler file 'file-remote-p))) 744 (let ((handler (find-file-name-handler file 'file-remote-p)))
739 (if handler 745 (if handler
740 (funcall handler 'file-remote-p file) 746 (funcall handler 'file-remote-p file connected)
741 nil))) 747 nil)))
742 748
743(defun file-local-copy (file) 749(defun file-local-copy (file)
diff --git a/lisp/follow.el b/lisp/follow.el
index 048db9bf11a..15d263d300d 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -336,123 +336,45 @@ After that, changing the prefix key requires manipulating keymaps."
336 ;; the look and feel of Follow mode.) 336 ;; the look and feel of Follow mode.)
337 (define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer) 337 (define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
338 338
339 ;;
340 ;; The menu.
341 ;;
342
343 (if (not (featurep 'xemacs))
344
345 ;;
346 ;; Emacs
347 ;;
348 (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
349 "Follow"))
350 (count 0)
351 id)
352 (mapcar
353 (function
354 (lambda (item)
355 (setq id
356 (or (cdr item)
357 (progn
358 (setq count (+ count 1))
359 (intern (format "separator-%d" count)))))
360 (define-key menumap (vector id) item)
361 (or (eq id 'follow-mode)
362 (put id 'menu-enable 'follow-mode))))
363 ;; In reverse order:
364 '(("Toggle Follow mode" . follow-mode)
365 ("--")
366 ("Recenter" . follow-recenter)
367 ("--")
368 ("Previous Window" . follow-previous-window)
369 ("Next Windows" . follow-next-window)
370 ("Last Window" . follow-last-window)
371 ("First Window" . follow-first-window)
372 ("--")
373 ("Switch To Buffer (all windows)"
374 . follow-switch-to-buffer-all)
375 ("Switch To Buffer" . follow-switch-to-buffer)
376 ("--")
377 ("Delete Other Windows and Split"
378 . follow-delete-other-windows-and-split)
379 ("--")
380 ("Scroll Down" . follow-scroll-down)
381 ("Scroll Up" . follow-scroll-up)))
382
383 ;; If there is a `tools' menu, we use it. However, we can't add a
384 ;; minor-mode specific item to it (it's broken), so we make the
385 ;; contents ghosted when not in use, and add ourselves to the
386 ;; global map. If no `tools' menu is present, just make a
387 ;; top-level menu visible when the mode is activated.
388
389 (let ((tools-map (lookup-key (current-global-map) [menu-bar tools]))
390 (last nil))
391 (if (sequencep tools-map)
392 (progn
393 ;; Find the last entry in the menu and store it in `last'.
394 (mapcar (function
395 (lambda (x)
396 (setq last (or (cdr-safe
397 (cdr-safe
398 (cdr-safe x)))
399 last))))
400 tools-map)
401 (if last
402 (progn
403 (funcall (symbol-function 'define-key-after)
404 tools-map [separator-follow] '("--") last)
405 (funcall (symbol-function 'define-key-after)
406 tools-map [follow] (cons "Follow" menumap)
407 'separator-follow))
408 ;; Didn't find the last item, Adding to the top of
409 ;; tools. (This will probably never happend...)
410 (define-key (current-global-map) [menu-bar tools follow]
411 (cons "Follow" menumap))))
412 ;; No tools menu, add "Follow" to the menubar.
413 (define-key mainmap [menu-bar follow]
414 (cons "Follow" menumap)))))
415
416 ;;
417 ;; XEmacs.
418 ;;
419
420 ;; place the menu in the `Tools' menu.
421 (let ((menu '("Follow"
422 :filter follow-menu-filter
423 ["Scroll Up" follow-scroll-up t]
424 ["Scroll Down" follow-scroll-down t]
425 ["Delete Other Windows and Split"
426 follow-delete-other-windows-and-split t]
427 ["Switch To Buffer" follow-switch-to-buffer t]
428 ["Switch To Buffer (all windows)"
429 follow-switch-to-buffer-all t]
430 ["First Window" follow-first-window t]
431 ["Last Window" follow-last-window t]
432 ["Next Windows" follow-next-window t]
433 ["Previous Window" follow-previous-window t]
434 ["Recenter" follow-recenter t]
435 ["Deactivate" follow-mode t])))
436
437 ;; Why not just `(set-buffer-menubar current-menubar)'? The
438 ;; question is a very good question. The reason is that under
439 ;; Emacs, neither `set-buffer-menubar' nor
440 ;; `current-menubar' is defined, hence the byte-compiler will
441 ;; warn.
442 (funcall (symbol-function 'set-buffer-menubar)
443 (symbol-value 'current-menubar))
444 (funcall (symbol-function 'add-submenu) '("Tools") menu))
445
446 ;; When the mode is not activated, only one item is visible:
447 ;; "Activate".
448 (defun follow-menu-filter (menu)
449 (if follow-mode
450 menu
451 '(["Activate " follow-mode t]))))
452
453 mainmap) 339 mainmap)
454 "Minor mode keymap for Follow mode.") 340 "Minor mode keymap for Follow mode.")
455 341
342;; When the mode is not activated, only one item is visible to activate
343;; the mode.
344(defun follow-menu-filter (menu)
345 (if (bound-and-true-p 'follow-mode)
346 menu
347 '(["Follow mode " follow-mode
348 :style toggle :selected follow-mode])))
349
350;; If there is a `tools' menu, we use it. However, we can't add a
351;; minor-mode specific item to it (it's broken), so we make the
352;; contents ghosted when not in use, and add ourselves to the
353;; global map.
354(easy-menu-add-item nil '("Tools")
355 '("Follow"
356 ;; The Emacs code used to just grey out operations when follow-mode was
357 ;; not enabled, whereas the XEmacs code used to remove it altogether.
358 ;; Not sure which is preferable, but clearly the preference should not
359 ;; depend on the flavor.
360 :filter follow-menu-filter
361 ["Scroll Up" follow-scroll-up follow-mode]
362 ["Scroll Down" follow-scroll-down follow-mode]
363 "--"
364 ["Delete Other Windows and Split" follow-delete-other-windows-and-split follow-mode]
365 "--"
366 ["Switch To Buffer" follow-switch-to-buffer follow-mode]
367 ["Switch To Buffer (all windows)" follow-switch-to-buffer-all follow-mode]
368 "--"
369 ["First Window" follow-first-window follow-mode]
370 ["Last Window" follow-last-window follow-mode]
371 ["Next Window" follow-next-window follow-mode]
372 ["Previous Window" follow-previous-window follow-mode]
373 "--"
374 ["Recenter" follow-recenter follow-mode]
375 "--"
376 ["Follow mode" follow-mode :style toggle :selected follow-mode]))
377
456;;}}} 378;;}}}
457 379
458(defcustom follow-mode-line-text " Follow" 380(defcustom follow-mode-line-text " Follow"
@@ -553,14 +475,12 @@ Used by `follow-window-size-change'.")
553;;;###autoload 475;;;###autoload
554(defun turn-on-follow-mode () 476(defun turn-on-follow-mode ()
555 "Turn on Follow mode. Please see the function `follow-mode'." 477 "Turn on Follow mode. Please see the function `follow-mode'."
556 (interactive)
557 (follow-mode 1)) 478 (follow-mode 1))
558 479
559 480
560;;;###autoload 481;;;###autoload
561(defun turn-off-follow-mode () 482(defun turn-off-follow-mode ()
562 "Turn off Follow mode. Please see the function `follow-mode'." 483 "Turn off Follow mode. Please see the function `follow-mode'."
563 (interactive)
564 (follow-mode -1)) 484 (follow-mode -1))
565 485
566(put 'follow-mode 'permanent-local t) 486(put 'follow-mode 'permanent-local t)
@@ -2084,8 +2004,8 @@ report this using the `report-emacs-bug' function."
2084 2004
2085(defun follow-window-size-change (frame) 2005(defun follow-window-size-change (frame)
2086 "Redraw all windows in FRAME, when in Follow mode." 2006 "Redraw all windows in FRAME, when in Follow mode."
2087 ;; Below, we call `post-command-hook'. This makes sure that we 2007 ;; Below, we call `post-command-hook'. This makes sure that we
2088 ;; doesn't start a mutally recursive endless loop. 2008 ;; don't start a mutually recursive endless loop.
2089 (if follow-inside-post-command-hook 2009 (if follow-inside-post-command-hook
2090 nil 2010 nil
2091 (let ((buffers '()) 2011 (let ((buffers '())
@@ -2109,12 +2029,12 @@ report this using the `report-emacs-bug' function."
2109 (setq windows (follow-all-followers win)) 2029 (setq windows (follow-all-followers win))
2110 (if (memq orig-window windows) 2030 (if (memq orig-window windows)
2111 (progn 2031 (progn
2112 ;; Make sure we're redrawing around the 2032 ;; Make sure we're redrawing around the
2113 ;; selected window. 2033 ;; selected window.
2114 ;; 2034 ;;
2115 ;; We must be really careful not to do this 2035 ;; We must be really careful not to do this
2116 ;; when we are (indirectly) called by 2036 ;; when we are (indirectly) called by
2117 ;; `post-command-hook'. 2037 ;; `post-command-hook'.
2118 (select-window orig-window) 2038 (select-window orig-window)
2119 (follow-post-command-hook) 2039 (follow-post-command-hook)
2120 (setq orig-window (selected-window))) 2040 (setq orig-window (selected-window)))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 0e9da63da1a..6a66ebbf756 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,42 @@
12007-07-14 David Kastrup <dak@gnu.org>
2
3 * gnus-art.el (gnus-mime-delete-part): Don't go through article-edit
4 finishing actions if we did not edit the article.
5
62007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
7
8 * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
9 (gnus-server-closed-face, gnus-server-denied-face)
10 (gnus-server-offline-face): Remove variable.
11 (gnus-server-font-lock-keywords): Use faces that are not aliases.
12
13 * mm-util.el (mm-decode-coding-string, mm-encode-coding-string)
14 (mm-decode-coding-region, mm-encode-coding-region): Don't modify string
15 if the coding-system argument is nil for XEmacs.
16
17 * nnrss.el (nnrss-compatible-encoding-alist): Inherit the value of
18 mm-charset-override-alist.
19
20 * rfc2047.el: Don't require base64; require rfc2045 for the function
21 rfc2045-encode-string.
22 (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not
23 to quote the parameter value.
24
252007-07-04 Katsumi Yamaoka <yamaoka@jpl.org>
26
27 * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles
28 as unfetched articles.
29
302007-07-02 Reiner Steib <Reiner.Steib@gmx.de>
31
32 * gnus-start.el (gnus-level-unsubscribed): Improve doc string.
33
342007-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
35
36 * gnus-art.el (gnus-article-summary-command-nosave)
37 (gnus-article-read-summary-keys): Don't set the 3rd arg of
38 pop-to-buffer for XEmacs.
39
12007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> 402007-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
2 41
3 * gnus-agent.el (gnus-agent-fetch-headers) 42 * gnus-agent.el (gnus-agent-fetch-headers)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 90af0740318..020bd283189 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4408,11 +4408,11 @@ Deleting parts may malfunction or destroy the article; continue? ")
4408 (gnus-summary-edit-article-done 4408 (gnus-summary-edit-article-done
4409 ,(or (mail-header-references gnus-current-headers) "") 4409 ,(or (mail-header-references gnus-current-headers) "")
4410 ,(gnus-group-read-only-p) 4410 ,(gnus-group-read-only-p)
4411 ,gnus-summary-buffer no-highlight))))) 4411 ,gnus-summary-buffer no-highlight))))
4412 ;; Not in `gnus-mime-save-part-and-strip': 4412 ;; Not in `gnus-mime-save-part-and-strip':
4413 (gnus-article-edit-done) 4413 (gnus-article-edit-done)
4414 (gnus-summary-expand-window) 4414 (gnus-summary-expand-window)
4415 (gnus-summary-show-article)) 4415 (gnus-summary-show-article)))
4416 4416
4417(defun gnus-mime-save-part () 4417(defun gnus-mime-save-part ()
4418 "Save the MIME part under point." 4418 "Save the MIME part under point."
@@ -5607,7 +5607,7 @@ not have a face in `gnus-article-boring-faces'."
5607 "Execute the last keystroke in the summary buffer." 5607 "Execute the last keystroke in the summary buffer."
5608 (interactive) 5608 (interactive)
5609 (let (func) 5609 (let (func)
5610 (pop-to-buffer gnus-article-current-summary nil 'norecord) 5610 (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs)))
5611 (setq func (lookup-key (current-local-map) (this-command-keys))) 5611 (setq func (lookup-key (current-local-map) (this-command-keys)))
5612 (call-interactively func))) 5612 (call-interactively func)))
5613 5613
@@ -5646,7 +5646,8 @@ not have a face in `gnus-article-boring-faces'."
5646 (member keys nosave-in-article)) 5646 (member keys nosave-in-article))
5647 (let (func) 5647 (let (func)
5648 (save-window-excursion 5648 (save-window-excursion
5649 (pop-to-buffer gnus-article-current-summary nil 'norecord) 5649 (pop-to-buffer gnus-article-current-summary
5650 nil (not (featurep 'xemacs)))
5650 ;; We disable the pick minor mode commands. 5651 ;; We disable the pick minor mode commands.
5651 (let (gnus-pick-mode) 5652 (let (gnus-pick-mode)
5652 (setq func (lookup-key (current-local-map) keys)))) 5653 (setq func (lookup-key (current-local-map) keys))))
@@ -5658,14 +5659,16 @@ not have a face in `gnus-article-boring-faces'."
5658 (call-interactively func) 5659 (call-interactively func)
5659 (setq new-sum-point (point))) 5660 (setq new-sum-point (point)))
5660 (when (member keys nosave-but-article) 5661 (when (member keys nosave-but-article)
5661 (pop-to-buffer gnus-article-buffer nil 'norecord))) 5662 (pop-to-buffer gnus-article-buffer
5663 nil (not (featurep 'xemacs)))))
5662 ;; These commands should restore window configuration. 5664 ;; These commands should restore window configuration.
5663 (let ((obuf (current-buffer)) 5665 (let ((obuf (current-buffer))
5664 (owin (current-window-configuration)) 5666 (owin (current-window-configuration))
5665 (opoint (point)) 5667 (opoint (point))
5666 win func in-buffer selected new-sum-start new-sum-hscroll) 5668 win func in-buffer selected new-sum-start new-sum-hscroll)
5667 (cond (not-restore-window 5669 (cond (not-restore-window
5668 (pop-to-buffer gnus-article-current-summary nil 'norecord)) 5670 (pop-to-buffer gnus-article-current-summary
5671 nil (not (featurep 'xemacs))))
5669 ((setq win (get-buffer-window gnus-article-current-summary)) 5672 ((setq win (get-buffer-window gnus-article-current-summary))
5670 (select-window win)) 5673 (select-window win))
5671 (t 5674 (t
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index f6804f3b114..0d5443f576c 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -214,43 +214,12 @@ If nil, a faster, but more primitive, buffer is used instead."
214;; backward-compatibility alias 214;; backward-compatibility alias
215(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) 215(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline)
216 216
217(defcustom gnus-server-agent-face 'gnus-server-agent
218 "Face name to use on AGENTIZED servers."
219 :version "22.1"
220 :group 'gnus-server-visual
221 :type 'face)
222
223(defcustom gnus-server-opened-face 'gnus-server-opened
224 "Face name to use on OPENED servers."
225 :version "22.1"
226 :group 'gnus-server-visual
227 :type 'face)
228
229(defcustom gnus-server-closed-face 'gnus-server-closed
230 "Face name to use on CLOSED servers."
231 :version "22.1"
232 :group 'gnus-server-visual
233 :type 'face)
234
235(defcustom gnus-server-denied-face 'gnus-server-denied
236 "Face name to use on DENIED servers."
237 :version "22.1"
238 :group 'gnus-server-visual
239 :type 'face)
240
241(defcustom gnus-server-offline-face 'gnus-server-offline
242 "Face name to use on OFFLINE servers."
243 :version "22.1"
244 :group 'gnus-server-visual
245 :type 'face)
246
247(defvar gnus-server-font-lock-keywords 217(defvar gnus-server-font-lock-keywords
248 (list 218 '(("(\\(agent\\))" 1 gnus-server-agent)
249 '("(\\(agent\\))" 1 gnus-server-agent-face) 219 ("(\\(opened\\))" 1 gnus-server-opened)
250 '("(\\(opened\\))" 1 gnus-server-opened-face) 220 ("(\\(closed\\))" 1 gnus-server-closed)
251 '("(\\(closed\\))" 1 gnus-server-closed-face) 221 ("(\\(offline\\))" 1 gnus-server-offline)
252 '("(\\(offline\\))" 1 gnus-server-offline-face) 222 ("(\\(denied\\))" 1 gnus-server-denied)))
253 '("(\\(denied\\))" 1 gnus-server-denied-face)))
254 223
255(defun gnus-server-mode () 224(defun gnus-server-mode ()
256 "Major mode for listing and editing servers. 225 "Major mode for listing and editing servers.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 276b028843a..17876302cfb 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -178,8 +178,13 @@ properly with all servers."
178 178
179(defconst gnus-level-unsubscribed 7 179(defconst gnus-level-unsubscribed 7
180 "Groups with levels less than or equal to this variable are unsubscribed. 180 "Groups with levels less than or equal to this variable are unsubscribed.
181Groups with levels less than `gnus-level-subscribed', which should be 181
182less than this variable, are subscribed.") 182Groups with levels less than `gnus-level-subscribed', which
183should be less than this variable, are subscribed. Groups with
184levels from `gnus-level-subscribed' (exclusive) upto this
185variable (inclusive) are unsubscribed. See also
186`gnus-level-zombie', `gnus-level-killed' and the Info node `Group
187Levels' for details.")
183 188
184(defconst gnus-level-zombie 8 189(defconst gnus-level-zombie 8
185 "Groups with this level are zombie groups.") 190 "Groups with this level are zombie groups.")
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index b1b6c8b760b..56c5fffb7e5 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -10514,7 +10514,8 @@ The number of articles marked as read is returned."
10514 (gnus-sorted-nunion 10514 (gnus-sorted-nunion
10515 (gnus-sorted-intersection gnus-newsgroup-unreads 10515 (gnus-sorted-intersection gnus-newsgroup-unreads
10516 gnus-newsgroup-downloadable) 10516 gnus-newsgroup-downloadable)
10517 gnus-newsgroup-unfetched))) 10517 (gnus-sorted-difference gnus-newsgroup-unfetched
10518 gnus-newsgroup-cached))))
10518 ;; We actually mark all articles as canceled, which we 10519 ;; We actually mark all articles as canceled, which we
10519 ;; have to do when using auto-expiry or adaptive scoring. 10520 ;; have to do when using auto-expiry or adaptive scoring.
10520 (gnus-summary-show-all-threads) 10521 (gnus-summary-show-all-threads)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 3508c1ac406..b08517170d4 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -36,11 +36,7 @@
36 (if (fboundp (car elem)) 36 (if (fboundp (car elem))
37 (defalias nfunc (car elem)) 37 (defalias nfunc (car elem))
38 (defalias nfunc (cdr elem))))) 38 (defalias nfunc (cdr elem)))))
39 '((decode-coding-string . (lambda (s a) s)) 39 '((coding-system-list . ignore)
40 (encode-coding-string . (lambda (s a) s))
41 (encode-coding-region . ignore)
42 (coding-system-list . ignore)
43 (decode-coding-region . ignore)
44 (char-int . identity) 40 (char-int . identity)
45 (coding-system-equal . equal) 41 (coding-system-equal . equal)
46 (annotationp . ignore) 42 (annotationp . ignore)
@@ -97,6 +93,34 @@
97 (multibyte-char-to-unibyte . identity)))) 93 (multibyte-char-to-unibyte . identity))))
98 94
99(eval-and-compile 95(eval-and-compile
96 (if (featurep 'xemacs)
97 (if (featurep 'file-coding)
98 ;; Don't modify string if CODING-SYSTEM is nil.
99 (progn
100 (defun mm-decode-coding-string (str coding-system)
101 (if coding-system
102 (decode-coding-string str coding-system)
103 str))
104 (defun mm-encode-coding-string (str coding-system)
105 (if coding-system
106 (encode-coding-string str coding-system)
107 str))
108 (defun mm-decode-coding-region (start end coding-system)
109 (if coding-system
110 (decode-coding-region start end coding-system)))
111 (defun mm-encode-coding-region (start end coding-system)
112 (if coding-system
113 (encode-coding-region start end coding-system))))
114 (defun mm-decode-coding-string (str coding-system) str)
115 (defun mm-encode-coding-string (str coding-system) str)
116 (defalias 'mm-decode-coding-region 'ignore)
117 (defalias 'mm-encode-coding-region 'ignore))
118 (defalias 'mm-decode-coding-string 'decode-coding-string)
119 (defalias 'mm-encode-coding-string 'encode-coding-string)
120 (defalias 'mm-decode-coding-region 'decode-coding-region)
121 (defalias 'mm-encode-coding-region 'encode-coding-region)))
122
123(eval-and-compile
100 (cond 124 (cond
101 ((fboundp 'replace-in-string) 125 ((fboundp 'replace-in-string)
102 (defalias 'mm-replace-in-string 'replace-in-string)) 126 (defalias 'mm-replace-in-string 'replace-in-string))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 996783e69b6..1f7e5ba1de9 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -85,7 +85,12 @@ ARTICLE is the article number of the current headline.")
85(defvar nnrss-file-coding-system mm-universal-coding-system 85(defvar nnrss-file-coding-system mm-universal-coding-system
86 "Coding system used when reading and writing files.") 86 "Coding system used when reading and writing files.")
87 87
88(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252)) 88(defvar nnrss-compatible-encoding-alist
89 (delq nil (mapcar (lambda (elem)
90 (if (and (mm-coding-system-p (car elem))
91 (mm-coding-system-p (cdr elem)))
92 elem))
93 mm-charset-override-alist))
89 "Alist of encodings and those supersets. 94 "Alist of encodings and those supersets.
90The cdr of each element is used to decode data if it is available when 95The cdr of each element is used to decode data if it is available when
91the car is what the data specify as the encoding. Or, the car is used 96the car is what the data specify as the encoding. Or, the car is used
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index b7d25d87c68..1d489d80e60 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -55,7 +55,7 @@ Value is what BODY returns."
55(require 'ietf-drums) 55(require 'ietf-drums)
56;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. 56;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
57(require 'mail-prsvr) 57(require 'mail-prsvr)
58(require 'base64) 58(require 'rfc2045) ;; rfc2045-encode-string
59(autoload 'mm-body-7-or-8 "mm-bodies") 59(autoload 'mm-body-7-or-8 "mm-bodies")
60 60
61(eval-and-compile 61(eval-and-compile
@@ -834,12 +834,9 @@ it, put the following line in your ~/.gnus.el file:
834 834
835\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter) 835\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
836" 836"
837 (let* ((rfc2047-encoding-type 'mime) 837 (let ((rfc2047-encoding-type 'mime)
838 (rfc2047-encode-max-chars nil) 838 (rfc2047-encode-max-chars nil))
839 (string (rfc2047-encode-string value))) 839 (rfc2045-encode-string param (rfc2047-encode-string value))))
840 (if (string-match (concat "[" ietf-drums-tspecials "]") string)
841 (format "%s=%S" param string)
842 (concat param "=" string))))
843 840
844;;; 841;;;
845;;; Functions for decoding RFC2047 messages 842;;; Functions for decoding RFC2047 messages
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 4258c33f3d0..57e995a8811 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1065,6 +1065,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
1065 1065
1066 ;; Reinvoke the pending search. 1066 ;; Reinvoke the pending search.
1067 (isearch-search) 1067 (isearch-search)
1068 (isearch-push-state)
1068 (isearch-update) 1069 (isearch-update)
1069 (if isearch-nonincremental 1070 (if isearch-nonincremental
1070 (progn 1071 (progn
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index 4aa1ad1b3f8..c12b7e52cf7 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -411,7 +411,7 @@ install:
411 - $(DEL) "$(INSTALL_DIR)/same-dir.tst" 411 - $(DEL) "$(INSTALL_DIR)/same-dir.tst"
412 echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst" 412 echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst"
413#ifdef COPY_LISP_SOURCE 413#ifdef COPY_LISP_SOURCE
414 $(IFNOTSAMEDIR) $(CP_DIR) . "$(INSTALL_DIR)/lisp" $(ENDIF) 414 $(IFNOTSAMEDIR) $(MAKE) $(MFLAGS) install-lisp-$(SHELLTYPE) $(ENDIF)
415#else 415#else
416# $(IFNOTSAMEDIR) $(CP_DIR) *.elc "$(INSTALL_DIR)/lisp" $(ENDIF) 416# $(IFNOTSAMEDIR) $(CP_DIR) *.elc "$(INSTALL_DIR)/lisp" $(ENDIF)
417# $(IFNOTSAMEDIR) $(CP) cus-load.el "$(INSTALL_DIR)/lisp" $(ENDIF) 417# $(IFNOTSAMEDIR) $(CP) cus-load.el "$(INSTALL_DIR)/lisp" $(ENDIF)
@@ -428,6 +428,19 @@ install:
428 - $(DEL) ../same-dir.tst 428 - $(DEL) ../same-dir.tst
429 - $(DEL) "$(INSTALL_DIR)/same-dir.tst" 429 - $(DEL) "$(INSTALL_DIR)/same-dir.tst"
430 430
431# Need to copy *.el files first, to avoid "source file is newer" annoyance
432# since cp does not preserve time stamps
433install-lisp-SH:
434 cp -f *.el "$(INSTALL_DIR)/lisp"
435 for dir in $(WINS); do mkdir "$(INSTALL_DIR)/lisp/$$dir" && cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done
436 for dir in . $(WINS); do cp $$dir/*.elc "$(INSTALL_DIR)/lisp/$$dir"; done
437
438install-lisp-CMD:
439 cp -f *.el "$(INSTALL_DIR)/lisp"
440 for %%f in ($(WINS)) do mkdir "$(INSTALL_DIR)/lisp/%%f"
441 for %%f in ($(WINS)) do cp -f %%f/*.el "$(INSTALL_DIR)/lisp/%%f"
442 for %%f in (. $(WINS)) do cp -f %%f/*.elc "$(INSTALL_DIR)/lisp/%%f"
443
431# 444#
432# Maintenance 445# Maintenance
433# 446#
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 7ad91dffa9f..5fae6382e28 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1161,6 +1161,7 @@ mail status in mode line"))
1161 '("--")) 1161 '("--"))
1162 1162
1163(defvar vc-menu-map (make-sparse-keymap "Version Control")) 1163(defvar vc-menu-map (make-sparse-keymap "Version Control"))
1164(defalias 'vc-menu-map vc-menu-map)
1164(define-key menu-bar-tools-menu [pcl-cvs] 1165(define-key menu-bar-tools-menu [pcl-cvs]
1165 '(menu-item "PCL-CVS" cvs-global-menu)) 1166 '(menu-item "PCL-CVS" cvs-global-menu))
1166(define-key menu-bar-tools-menu [vc] 1167(define-key menu-bar-tools-menu [vc]
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 3d3a08e0528..97ccda6e048 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,8 @@
12007-07-11 Bill Wohler <wohler@newt.com>
2
3 * mh-compat.el (mh-display-color-cells): Fix on XEmacs 21.5b28.
4 Thanks to Henrique Martins for the help (closes SF #1749774).
5
12007-06-06 Juanma Barranquero <lekktu@gmail.com> 62007-06-06 Juanma Barranquero <lekktu@gmail.com>
2 7
3 * mh-mime.el (mh-mh-directive-present-p): 8 * mh-mime.el (mh-mh-directive-present-p):
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 2f57e1763ab..a1382a8298e 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -77,13 +77,17 @@ introduced in Emacs 22."
77 'cancel-timer 77 'cancel-timer
78 'delete-itimer)) 78 'delete-itimer))
79 79
80(defun-mh mh-display-color-cells display-color-cells (&optional display) 80(defun mh-display-color-cells (&optional display)
81 "Return the number of color cells supported by DISPLAY. 81 "Return the number of color cells supported by DISPLAY.
82This function is used by XEmacs to return 2 when 82This function is used by XEmacs to return 2 when `device-color-cells'
83`device-color-cells' returns nil. This happens when compiling or 83or `display-color-cells' returns nil. This happens when compiling or
84running on a tty and causes errors since `display-color-cells' is 84running on a tty and causes errors since `display-color-cells' is
85expected to return an integer." 85expected to return an integer."
86 (or (device-color-cells display) 2)) 86 (cond ((fboundp 'display-color-cells) ; GNU Emacs, XEmacs 21.5b28
87 (or (display-color-cells display) 2))
88 ((fboundp 'device-color-cells) ; XEmacs 21.4
89 (or (device-color-cells display) 2))
90 (t 2)))
87 91
88(defmacro mh-display-completion-list (completions &optional common-substring) 92(defmacro mh-display-completion-list (completions &optional common-substring)
89 "Display the list of COMPLETIONS. 93 "Display the list of COMPLETIONS.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 898f9a23515..3fa75102b32 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4132,8 +4132,15 @@ directory, so that Emacs will know its current contents."
4132 (format "Getting %s" fn1)) 4132 (format "Getting %s" fn1))
4133 tmp1)))) 4133 tmp1))))
4134 4134
4135(defun ange-ftp-file-remote-p (file) 4135(defun ange-ftp-file-remote-p (file &optional connected)
4136 (ange-ftp-replace-name-component file "")) 4136 (and (or (not connected)
4137 (let* ((parsed (ange-ftp-ftp-name file))
4138 (host (nth 0 parsed))
4139 (user (nth 1 parsed))
4140 (proc (get-process (ange-ftp-ftp-process-buffer host user))))
4141 (and proc (processp proc)
4142 (memq (process-status proc) '(run open)))))
4143 (ange-ftp-replace-name-component file "")))
4137 4144
4138(defun ange-ftp-load (file &optional noerror nomessage nosuffix) 4145(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
4139 (if (ange-ftp-ftp-name file) 4146 (if (ange-ftp-ftp-name file)
@@ -4360,7 +4367,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
4360;; This returns nil for any file name as argument. 4367;; This returns nil for any file name as argument.
4361(put 'vc-registered 'ange-ftp 'null) 4368(put 'vc-registered 'ange-ftp 'null)
4362 4369
4370;; We can handle process-file in a restricted way (just for chown).
4371;; Nothing possible for start-file-process.
4363(put 'process-file 'ange-ftp 'ange-ftp-process-file) 4372(put 'process-file 'ange-ftp 'ange-ftp-process-file)
4373(put 'start-file-process 'ange-ftp 'ignore)
4364(put 'shell-command 'ange-ftp 'ange-ftp-shell-command) 4374(put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
4365 4375
4366;;; Define ways of getting at unmodified Emacs primitives, 4376;;; Define ways of getting at unmodified Emacs primitives,
diff --git a/lisp/net/rcompile.el b/lisp/net/rcompile.el
index c262a129adc..9eecb8e4481 100644
--- a/lisp/net/rcompile.el
+++ b/lisp/net/rcompile.el
@@ -188,8 +188,7 @@ See \\[compile]."
188 (when (featurep 'tramp) 188 (when (featurep 'tramp)
189 (set (make-local-variable 'comint-file-name-prefix) 189 (set (make-local-variable 'comint-file-name-prefix)
190 (funcall (symbol-function 'tramp-make-tramp-file-name) 190 (funcall (symbol-function 'tramp-make-tramp-file-name)
191 nil ;; multi-method. To be removed with Tramp 2.1. 191 nil ;; method.
192 nil
193 remote-compile-user 192 remote-compile-user
194 remote-compile-host 193 remote-compile-host
195 "")))))) 194 ""))))))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
new file mode 100644
index 00000000000..96c4b3ecb9b
--- /dev/null
+++ b/lisp/net/tramp-cache.el
@@ -0,0 +1,317 @@
1;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
2;;; tramp-cache.el --- file information caching for Tramp
3
4;; Copyright (C) 2000, 2005, 2006, 2007 by Free Software Foundation, Inc.
5
6;; Author: Daniel Pittman <daniel@inanna.danann.net>
7;; Michael Albinus <michael.albinus@gmx.de>
8;; Keywords: comm, processes
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, see
24;; <http://www.gnu.org/licenses/>.
25
26;;; Commentary:
27
28;; An implementation of information caching for remote files.
29
30;; Each connection, identified by a vector [method user host
31;; localname] or by a process, has a unique cache. We distinguish 3
32;; kind of caches, depending on the key:
33;;
34;; - localname is NIL. This are reusable properties. Examples:
35;; "remote-shell" identifies the POSIX shell to be called on the
36;; remote host, or "perl" is the command to be called on the remote
37;; host, when starting a Perl script. These properties are saved in
38;; the file `tramp-persistency-file-name'.
39;;
40;; - localname is a string. This are temporary properties, which are
41;; related to the file localname is referring to. Examples:
42;; "file-exists-p" is t or nile, depending on the file existence, or
43;; "file-attributes" caches the result of the function
44;; `file-attributes'.
45;;
46;; - The key is a process. This are temporary properties related to
47;; an open connection. Examples: "scripts" keeps shell script
48;; definitions already sent to the remote shell, "last-cmd-time" is
49;; the time stamp a command has been sent to the remote process.
50
51;;; Code:
52
53;; Pacify byte-compiler.
54(eval-when-compile
55 (require 'cl)
56 (autoload 'tramp-message "tramp")
57 (autoload 'tramp-tramp-file-p "tramp")
58 ;; We cannot autoload macro `with-parsed-tramp-file-name', it
59 ;; results in problems of byte-compiled code.
60 (autoload 'tramp-dissect-file-name "tramp")
61 (autoload 'tramp-file-name-method "tramp")
62 (autoload 'tramp-file-name-user "tramp")
63 (autoload 'tramp-file-name-host "tramp")
64 (autoload 'tramp-file-name-localname "tramp")
65 (autoload 'time-stamp-string "time-stamp"))
66
67;;; -- Cache --
68
69(defvar tramp-cache-data (make-hash-table :test 'equal)
70 "Hash table for remote files properties.")
71
72(defcustom tramp-persistency-file-name
73 (cond
74 ;; GNU Emacs.
75 ((and (boundp 'user-emacs-directory)
76 (stringp (symbol-value 'user-emacs-directory))
77 (file-directory-p (symbol-value 'user-emacs-directory)))
78 (expand-file-name "tramp" (symbol-value 'user-emacs-directory)))
79 ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
80 "~/.emacs.d/tramp")
81 ;; XEmacs.
82 ((and (boundp 'user-init-directory)
83 (stringp (symbol-value 'user-init-directory))
84 (file-directory-p (symbol-value 'user-init-directory)))
85 (expand-file-name "tramp" (symbol-value 'user-init-directory)))
86 ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
87 "~/.xemacs/tramp")
88 ;; For users without `~/.emacs.d/' or `~/.xemacs/'.
89 (t "~/.tramp"))
90 "File which keeps connection history for Tramp connections."
91 :group 'tramp
92 :type 'file)
93
94(defun tramp-get-file-property (vec file property default)
95 "Get the PROPERTY of FILE from the cache context of VEC.
96Returns DEFAULT if not set."
97 ;; Unify localname.
98 (setq vec (copy-sequence vec))
99 (aset vec 3 (directory-file-name file))
100 (let* ((hash (or (gethash vec tramp-cache-data)
101 (puthash vec (make-hash-table :test 'equal)
102 tramp-cache-data)))
103 (value (if (hash-table-p hash)
104 (gethash property hash default)
105 default)))
106 (tramp-message vec 8 "%s %s %s" file property value)
107 value))
108
109(defun tramp-set-file-property (vec file property value)
110 "Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
111Returns VALUE."
112 ;; Unify localname.
113 (setq vec (copy-sequence vec))
114 (aset vec 3 (directory-file-name file))
115 (let ((hash (or (gethash vec tramp-cache-data)
116 (puthash vec (make-hash-table :test 'equal)
117 tramp-cache-data))))
118 (puthash property value hash)
119 (tramp-message vec 8 "%s %s %s" file property value)
120 value))
121
122(defun tramp-flush-file-property (vec file)
123 "Remove all properties of FILE in the cache context of VEC."
124 ;; Unify localname.
125 (setq vec (copy-sequence vec))
126 (aset vec 3 (directory-file-name file))
127 (tramp-message vec 8 "%s" file)
128 (remhash vec tramp-cache-data))
129
130(defun tramp-flush-directory-property (vec directory)
131 "Remove all properties of DIRECTORY in the cache context of VEC.
132Remove also properties of all files in subdirectories."
133 (let ((directory (directory-file-name directory)))
134 (tramp-message vec 8 "%s" directory)
135 (maphash
136 '(lambda (key value)
137 (when (and (stringp key)
138 (string-match directory (tramp-file-name-localname key)))
139 (remhash key tramp-cache-data)))
140 tramp-cache-data)))
141
142(defun tramp-cache-print (table)
143 "Prints hash table TABLE."
144 (when (hash-table-p table)
145 (let (result tmp)
146 (maphash
147 '(lambda (key value)
148 (setq tmp (format
149 "(%s %s)"
150 (if (processp key)
151 (prin1-to-string (prin1-to-string key))
152 (prin1-to-string key))
153 (if (hash-table-p value)
154 (tramp-cache-print value)
155 (if (bufferp value)
156 (prin1-to-string (prin1-to-string value))
157 (prin1-to-string value))))
158 result (if result (concat result " " tmp) tmp)))
159 table)
160 result)))
161
162;; Reverting or killing a buffer should also flush file properties.
163;; They could have been changed outside Tramp.
164(defun tramp-flush-file-function ()
165 "Flush all Tramp cache properties from buffer-file-name."
166 (let ((bfn (buffer-file-name)))
167 (when (and (stringp bfn) (tramp-tramp-file-p bfn))
168 (let* ((v (tramp-dissect-file-name bfn))
169 (localname (tramp-file-name-localname v)))
170 (tramp-flush-file-property v localname)))))
171
172(add-hook 'before-revert-hook 'tramp-flush-file-function)
173(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
174(add-hook 'tramp-cache-unload-hook
175 '(lambda ()
176 (remove-hook 'before-revert-hook
177 'tramp-flush-file-function)
178 (remove-hook 'kill-buffer-hook
179 'tramp-flush-file-function)))
180
181;;; -- Properties --
182
183(defun tramp-get-connection-property (key property default)
184 "Get the named PROPERTY for the connection.
185KEY identifies the connection, it is either a process or a vector.
186If the value is not set for the connection, returns DEFAULT."
187 ;; Unify key by removing localname from vector. Work with a copy in
188 ;; order to avoid side effects.
189 (when (vectorp key)
190 (setq key (copy-sequence key))
191 (aset key 3 nil))
192 (let* ((hash (gethash key tramp-cache-data))
193 (value (if (hash-table-p hash)
194 (gethash property hash default)
195 default)))
196 (tramp-message key 7 "%s %s" property value)
197 value))
198
199(defun tramp-set-connection-property (key property value)
200 "Set the named PROPERTY of a connection to VALUE.
201KEY identifies the connection, it is either a process or a vector.
202PROPERTY is set persistent when KEY is a vector."
203 ;; Unify key by removing localname from vector. Work with a copy in
204 ;; order to avoid side effects.
205 (when (vectorp key)
206 (setq key (copy-sequence key))
207 (aset key 3 nil))
208 (let ((hash (or (gethash key tramp-cache-data)
209 (puthash key (make-hash-table :test 'equal)
210 tramp-cache-data))))
211 (puthash property value hash)
212 ;; This function is called also during initialization of
213 ;; tramp-cache.el. `tramp-message´ is not defined yet at this
214 ;; time, so we ignore the corresponding error.
215 (condition-case nil
216 (tramp-message key 7 "%s %s" property value)
217 (error nil))
218 value))
219
220(defun tramp-flush-connection-property (key event)
221 "Remove all properties identified by KEY.
222KEY identifies the connection, it is either a process or a
223vector. EVENT is not used, it is just applied because this
224function is intended to run also as process sentinel."
225 ;; Unify key by removing localname from vector. Work with a copy in
226 ;; order to avoid side effects.
227 (when (vectorp key)
228 (setq key (copy-sequence key))
229 (aset key 3 nil))
230; (tramp-message key 7 "%s" event)
231 (remhash key tramp-cache-data))
232
233(defun tramp-dump-connection-properties ()
234"Writes persistent connection properties into file
235`tramp-persistency-file-name'."
236 ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
237 (condition-case nil
238 (when (and (hash-table-p tramp-cache-data)
239 (not (zerop (hash-table-count tramp-cache-data)))
240 (stringp tramp-persistency-file-name))
241 (let ((cache (copy-hash-table tramp-cache-data)))
242 ;; Remove temporary data.
243 (maphash
244 '(lambda (key value)
245 (if (and (vectorp key) (not (tramp-file-name-localname key)))
246 (progn
247 (remhash "process-name" value)
248 (remhash "process-buffer" value))
249 (remhash key cache)))
250 cache)
251 ;; Dump it.
252 (with-temp-buffer
253 (insert
254 ";; -*- emacs-lisp -*-"
255 ;; `time-stamp-string' might not exist in all (X)Emacs flavors.
256 (condition-case nil
257 (progn
258 (format
259 " <%s %s>\n"
260 (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
261 tramp-persistency-file-name))
262 (error "\n"))
263 ";; Tramp connection history. Don't change this file.\n"
264 ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
265 (with-output-to-string
266 (pp (read (format "(%s)" (tramp-cache-print cache))))))
267 (write-region
268 (point-min) (point-max) tramp-persistency-file-name))))
269 (error nil)))
270
271(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
272(add-hook 'tramp-cache-unload-hook
273 '(lambda ()
274 (remove-hook 'kill-emacs-hook
275 'tramp-dump-connection-properties)))
276
277(defun tramp-parse-connection-properties (method)
278 "Return a list of (user host) tuples allowed to access for METHOD.
279This function is added always in `tramp-get-completion-function'
280for all methods. Resulting data are derived from connection
281history."
282 (let (res)
283 (maphash
284 '(lambda (key value)
285 (if (and (vectorp key)
286 (string-equal method (tramp-file-name-method key))
287 (not (tramp-file-name-localname key)))
288 (push (list (tramp-file-name-user key)
289 (tramp-file-name-host key))
290 res)))
291 tramp-cache-data)
292 res))
293
294;; Read persistent connection history. Applied with
295;; `load-in-progress', because it shall be evaluated only once.
296(when load-in-progress
297 (condition-case err
298 (with-temp-buffer
299 (insert-file-contents tramp-persistency-file-name)
300 (let ((list (read (current-buffer)))
301 element key item)
302 (while (setq element (pop list))
303 (setq key (pop element))
304 (while (setq item (pop element))
305 (tramp-set-connection-property key (pop item) (car item))))))
306 (file-error
307 ;; Most likely because the file doesn't exist yet. No message.
308 (clrhash tramp-cache-data))
309 (error
310 ;; File is corrupted.
311 (message "%s" (error-message-string err))
312 (clrhash tramp-cache-data))))
313
314(provide 'tramp-cache)
315
316;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
317;;; tramp-cache.el ends here
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el
new file mode 100644
index 00000000000..e370c54f902
--- /dev/null
+++ b/lisp/net/tramp-fish.el
@@ -0,0 +1,1178 @@
1;;; -*- coding: iso-8859-1; -*-
2;;; tramp-fish.el --- Tramp access functions for FISH protocol
3
4;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Michael Albinus <michael.albinus@gmx.de>
7;; Keywords: comm, processes
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, see
23;; <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Access functions for FIles transferred over SHell protocol from Tramp.
28
29;; FISH is a protocol developped for the GNU Midnight Commander
30;; <https://savannah.gnu.org/projects/mc>. A client connects to a
31;; remote host via ssh (or rsh, shall be configurable), and starts
32;; there a fish server via the command "start_fish_server". All
33;; commands from the client have the form "#FISH_COMMAND\n" (always
34;; one line), followed by equivalent shell commands in case there is
35;; no fish server running.
36
37;; The fish server (or the equivalent shell commands) must return the
38;; response, which is finished by a line "### xxx <optional text>\n".
39;; "xxx" stands for 3 digits, representing a return code. Return
40;; codes "# 000" and "# 001" are reserved for fallback implementation
41;; with native shell commands; they are not used inside the server. See
42;; <http://cvs.savannah.gnu.org/viewcvs/mc/vfs/README.fish?root=mc&view=markup>
43;; for details of original specification.
44
45;; The GNU Midnight Commander implements the original fish protocol
46;; version 0.0.2. The KDE Konqueror has its own implementation, which
47;; can be found at
48;; <http://websvn.kde.org/branches/KDE/3.5/kdebase/kioslave/fish>. It
49;; implements an extended protocol version 0.0.3. Additionally, it
50;; provides a fish server implementation in Perl (which is the only
51;; implementation I've heard of). The following command reference is
52;; based on that implementation.
53
54;; All commands return either "### 2xx\n" (OK) or "### 5xx <optional text>\n"
55;; (NOK). Return codes are mentioned only if they are different from this.
56;; Spaces in any parameter must be escaped by "\ ".
57
58;; Command/Return Code Comment
59;;
60;; #FISH initial connection, not used
61;; in .fishsrv.pl
62;; ### 100 transfer fish server missing server, or wrong checksum
63;; version 0.0.3 only
64
65;; #VER a.b.c <commands requested>
66;; VER x.y.z <commands offered> .fishsrv.pl response is not uptodate
67
68;; #PWD
69;; /path/to/file
70
71;; #CWD /some/path
72
73;; #COPY /path/a /path/b version 0.0.3 only
74
75;; #RENAME /path/a /path/b
76
77;; #SYMLINK /path/a /path/b
78
79;; #LINK /path/a /path/b
80
81;; #DELE /some/path
82
83;; #MKD /some/path
84
85;; #RMD /some/path
86
87;; #CHOWN user /file/name
88
89;; #CHGRP group /file/name
90
91;; #CHMOD 1234 file
92
93;; #READ <offset> <size> /path/and/filename
94;; ### 291 successful exit when reading
95;; ended at eof
96;; ### 292 successful exit when reading
97;; did not end at eof
98
99;; #WRITE <offset> <size> /path/and/filename
100
101;; #APPEND <size> /path/and/filename version 0.0.3 only
102
103;; #LIST /directory
104;; <number of entries> version 0.0.3 only
105;; ### 100 version 0.0.3 only
106;; P<unix permissions> <owner>.<group>
107;; S<size>
108;; d<3-letters month name> <day> <year or HH:MM>
109;; D<year> <month> <day> <hour> <minute> <second>[.1234]
110;; E<major-of-device>,<minor>
111;; :<filename>
112;; L<filename symlink points to>
113;; M<mimetype> version 0.0.3 only
114;; <blank line to separate items>
115
116;; #STAT /file version 0.0.3 only
117;; like #LIST except for directories
118;; <number of entries>
119;; ### 100
120;; P<unix permissions> <owner>.<group>
121;; S<size>
122;; d<3-letters month name> <day> <year or HH:MM>
123;; D<year> <month> <day> <hour> <minute> <second>[.1234]
124;; E<major-of-device>,<minor>
125;; :<filename>
126;; L<filename symlink points to>
127;; <blank line to separate items>
128
129;; #RETR /some/name
130;; <filesize>
131;; ### 100
132;; <binary data> exactly filesize bytes
133;; ### 200 with no preceding newline
134
135;; #STOR <size> /file/name
136;; ### 100
137;; <data> exactly size bytes
138;; ### 001 partial success
139
140;; #EXEC <command> <tmpfile> version 0.0.3 only
141;; <tmpfile> must not exists. It contains the output of <command>.
142;; It can be retrieved afterwards. Last line is
143;; ###RESULT: <returncode>
144
145;; This implementation is meant as proof of the concept, whether there
146;; is a better performance compared with the native ssh method. It
147;; looks like the file information retrieval is slower, especially the
148;; #LIST command. On the other hand, the file contents transmission
149;; seems to perform better than other inline methods, because there is
150;; no need for data encoding/decoding, and it supports the APPEND
151;; parameter of `write-region'. Transfer of binary data fails due to
152;; Emacs' process input/output handling.
153
154
155;;; Code:
156
157(require 'tramp)
158(require 'tramp-cache)
159
160;; Pacify byte-compiler
161(eval-when-compile
162 (require 'cl)
163 (require 'custom))
164
165;; Avoid byte-compiler warnings if the byte-compiler supports this.
166;; Currently, XEmacs supports this.
167(eval-when-compile
168 (when (featurep 'xemacs)
169 (byte-compiler-options (warnings (- unused-vars)))))
170
171;; `directory-sep-char' is an obsolete variable in Emacs. But it is
172;; used in XEmacs, so we set it here and there. The following is needed
173;; to pacify Emacs byte-compiler.
174(eval-when-compile
175 (unless (boundp 'byte-compile-not-obsolete-var)
176 (defvar byte-compile-not-obsolete-var nil))
177 (setq byte-compile-not-obsolete-var 'directory-sep-char))
178
179;; Define FISH method ...
180(defcustom tramp-fish-method "fish"
181 "*Method to connect via FISH protocol."
182 :group 'tramp
183 :type 'string)
184
185;; ... and add it to the method list.
186(add-to-list 'tramp-methods (cons tramp-fish-method nil))
187
188;; Add a default for `tramp-default-user-alist'. Default is the local user.
189(add-to-list 'tramp-default-user-alist
190 `(,tramp-fish-method nil ,(user-login-name)))
191
192;; Add completion function for FISH method.
193(tramp-set-completion-function
194 tramp-fish-method tramp-completion-function-alist-ssh)
195
196(defconst tramp-fish-continue-prompt-regexp "^### 100.*\n"
197 "FISH return code OK.")
198
199;; It cannot be a defconst, occasionally we bind it locally.
200(defvar tramp-fish-ok-prompt-regexp "^### 200\n"
201 "FISH return code OK.")
202
203(defconst tramp-fish-error-prompt-regexp "^### \\(4\\|5\\)[0-9]+.*\n"
204 "Regexp for possible error strings of FISH servers.
205Used instead of analyzing error codes of commands.")
206
207(defcustom tramp-fish-start-fish-server-command
208 (concat "stty intr \"\" quit \"\" erase \"\" kill \"\" eof \"\" eol \"\" eol2 \"\" swtch \"\" start \"\" stop \"\" susp \"\" rprnt \"\" werase \"\" lnext \"\" flush \"\"; "
209 "perl .fishsrv.pl "
210 "`grep 'ARGV\\[0\\]' .fishsrv.pl | "
211 "sed -e 's/^[^\"]*\"//' -e 's/\"[^\"]*$//'`; "
212 "exit")
213 "*Command to connect via FISH protocol."
214 :group 'tramp
215 :type 'string)
216
217;; New handlers should be added here.
218(defconst tramp-fish-file-name-handler-alist
219 '(
220 ;; `access-file' performed by default handler
221 (add-name-to-file . tramp-fish-handle-add-name-to-file)
222 ;; `byte-compiler-base-file-name' performed by default handler
223 (copy-file . tramp-fish-handle-copy-file)
224 (delete-directory . tramp-fish-handle-delete-directory)
225 (delete-file . tramp-fish-handle-delete-file)
226 ;; `diff-latest-backup-file' performed by default handler
227 (directory-file-name . tramp-handle-directory-file-name)
228 (directory-files . tramp-handle-directory-files)
229 (directory-files-and-attributes . tramp-fish-handle-directory-files-and-attributes)
230 ;; `dired-call-process' performed by default handler
231 ;; `dired-compress-file' performed by default handler
232 ;; `dired-uncache' performed by default handler
233 (expand-file-name . tramp-fish-handle-expand-file-name)
234 ;; `file-accessible-directory-p' performed by default handler
235 (file-attributes . tramp-fish-handle-file-attributes)
236 (file-directory-p . tramp-fish-handle-file-directory-p)
237 (file-executable-p . tramp-fish-handle-file-executable-p)
238 (file-exists-p . tramp-fish-handle-file-exists-p)
239 (file-local-copy . tramp-fish-handle-file-local-copy)
240 (file-remote-p . tramp-handle-file-remote-p)
241 (file-modes . tramp-handle-file-modes)
242 (file-name-all-completions . tramp-fish-handle-file-name-all-completions)
243 ;; `file-name-as-directory' performed by default handler
244 (file-name-completion . tramp-handle-file-name-completion)
245 (file-name-directory . tramp-handle-file-name-directory)
246 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
247 ;; `file-name-sans-versions' performed by default handler
248 (file-newer-than-file-p . tramp-fish-handle-file-newer-than-file-p)
249 (file-ownership-preserved-p . ignore)
250 (file-readable-p . tramp-fish-handle-file-readable-p)
251 (file-regular-p . tramp-handle-file-regular-p)
252 (file-symlink-p . tramp-handle-file-symlink-p)
253 ;; `file-truename' performed by default handler
254 (file-writable-p . tramp-fish-handle-file-writable-p)
255 (find-backup-file-name . tramp-handle-find-backup-file-name)
256 ;; `find-file-noselect' performed by default handler
257 ;; `get-file-buffer' performed by default handler
258 (insert-directory . tramp-fish-handle-insert-directory)
259 (insert-file-contents . tramp-fish-handle-insert-file-contents)
260 (load . tramp-handle-load)
261 (make-directory . tramp-fish-handle-make-directory)
262 (make-directory-internal . tramp-fish-handle-make-directory-internal)
263 (make-symbolic-link . tramp-fish-handle-make-symbolic-link)
264 (rename-file . tramp-fish-handle-rename-file)
265 (set-file-modes . tramp-fish-handle-set-file-modes)
266 (set-visited-file-modtime . ignore)
267 (shell-command . tramp-handle-shell-command)
268 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
269 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
270 (vc-registered . ignore)
271 (verify-visited-file-modtime . ignore)
272 (write-region . tramp-fish-handle-write-region)
273 (executable-find . tramp-fish-handle-executable-find)
274 (start-process . ignore)
275 (call-process . tramp-fish-handle-call-process)
276 (process-file . tramp-handle-process-file)
277)
278 "Alist of handler functions for Tramp FISH method.
279Operations not mentioned here will be handled by the default Emacs primitives.")
280
281(defun tramp-fish-file-name-p (filename)
282 "Check if it's a filename for FISH protocol."
283 (let ((v (tramp-dissect-file-name filename)))
284 (string= (tramp-file-name-method v) tramp-fish-method)))
285
286(defun tramp-fish-file-name-handler (operation &rest args)
287 "Invoke the FISH related OPERATION.
288First arg specifies the OPERATION, second arg is a list of arguments to
289pass to the OPERATION."
290 (let ((fn (assoc operation tramp-fish-file-name-handler-alist)))
291 (if fn
292 (save-match-data (apply (cdr fn) args))
293 (tramp-run-real-handler operation args))))
294
295(add-to-list 'tramp-foreign-file-name-handler-alist
296 (cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler))
297
298
299;; File name primitives
300
301(defun tramp-fish-handle-add-name-to-file
302 (filename newname &optional ok-if-already-exists)
303 "Like `add-name-to-file' for Tramp files."
304 (unless (tramp-equal-remote filename newname)
305 (with-parsed-tramp-file-name
306 (if (tramp-tramp-file-p filename) filename newname) nil
307 (tramp-error
308 v 'file-error
309 "add-name-to-file: %s"
310 "only implemented for same method, same user, same host")))
311 (with-parsed-tramp-file-name filename v1
312 (with-parsed-tramp-file-name newname v2
313 (when (and (not ok-if-already-exists)
314 (file-exists-p newname)
315 (not (numberp ok-if-already-exists))
316 (y-or-n-p
317 (format
318 "File %s already exists; make it a new name anyway? "
319 newname)))
320 (tramp-error
321 v2 'file-error
322 "add-name-to-file: file %s already exists" newname))
323 (tramp-flush-file-property v2 v2-localname)
324 (unless (tramp-fish-send-command-and-check
325 v1 (format "#LINK %s %s" v1-localname v2-localname))
326 (tramp-error
327 v1 'file-error "Error with add-name-to-file %s" newname)))))
328
329(defun tramp-fish-handle-copy-file
330 (filename newname &optional ok-if-already-exists keep-date)
331 "Like `copy-file' for Tramp files."
332 (tramp-fish-do-copy-or-rename-file
333 'copy filename newname ok-if-already-exists keep-date))
334
335(defun tramp-fish-handle-delete-directory (directory)
336 "Like `delete-directory' for Tramp files."
337 (when (file-exists-p directory)
338 (with-parsed-tramp-file-name
339 (directory-file-name (expand-file-name directory)) nil
340 (tramp-flush-directory-property v localname)
341 (tramp-fish-send-command-and-check v (format "#RMD %s" localname)))))
342
343(defun tramp-fish-handle-delete-file (filename)
344 "Like `delete-file' for Tramp files."
345 (when (file-exists-p filename)
346 (with-parsed-tramp-file-name (expand-file-name filename) nil
347 (tramp-flush-file-property v localname)
348 (tramp-fish-send-command-and-check v (format "#DELE %s" localname)))))
349
350(defun tramp-fish-handle-directory-files-and-attributes
351 (directory &optional full match nosort id-format)
352 "Like `directory-files-and-attributes' for Tramp files."
353 (mapcar
354 (lambda (x)
355 ;; We cannot call `file-attributes' for backward compatibility reasons.
356 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
357 (cons x (tramp-fish-handle-file-attributes
358 (if full x (expand-file-name x directory)) id-format)))
359 (directory-files directory full match nosort)))
360
361(defun tramp-fish-handle-expand-file-name (name &optional dir)
362 "Like `expand-file-name' for Tramp files."
363 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
364 (setq dir (or dir default-directory "/"))
365 ;; Unless NAME is absolute, concat DIR and NAME.
366 (unless (file-name-absolute-p name)
367 (setq name (concat (file-name-as-directory dir) name)))
368 ;; If NAME is not a tramp file, run the real handler
369 (if (or (tramp-completion-mode) (not (tramp-tramp-file-p name)))
370 (tramp-drop-volume-letter
371 (tramp-run-real-handler 'expand-file-name (list name nil)))
372 ;; Dissect NAME.
373 (with-parsed-tramp-file-name name nil
374 (unless (file-name-absolute-p localname)
375 (setq localname (concat "~/" localname)))
376 ;; Tilde expansion if necessary.
377 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
378 (let ((uname (match-string 1 localname))
379 (fname (match-string 2 localname)))
380 ;; We cannot apply "~user/", because this is not supported
381 ;; by the FISH protocol.
382 (unless (string-equal uname "~")
383 (tramp-error
384 v 'file-error "Tilde expansion not supported for %s" name))
385 (setq uname
386 (with-connection-property v uname
387 (tramp-fish-send-command-and-check v "#PWD")
388 (with-current-buffer (tramp-get-buffer v)
389 (goto-char (point-min))
390 (buffer-substring (point) (tramp-line-end-position)))))
391 (setq localname (concat uname fname))))
392 ;; There might be a double slash, for example when "~/"
393 ;; expands to "/". Remove this.
394 (while (string-match "//" localname)
395 (setq localname (replace-match "/" t t localname)))
396 ;; No tilde characters in file name, do normal
397 ;; expand-file-name (this does "/./" and "/../"). We bind
398 ;; `directory-sep-char' here for XEmacs on Windows, which
399 ;; would otherwise use backslash. `default-directory' is
400 ;; bound, because on Windows there would be problems with UNC
401 ;; shares or Cygwin mounts.
402 (tramp-let-maybe directory-sep-char ?/
403 (let ((default-directory (tramp-temporary-file-directory)))
404 (tramp-make-tramp-file-name
405 method user host
406 (tramp-drop-volume-letter
407 (tramp-run-real-handler 'expand-file-name
408 (list localname)))))))))
409
410(defun tramp-fish-handle-file-attributes (filename &optional id-format)
411 "Like `file-attributes' for Tramp files."
412 (with-parsed-tramp-file-name (expand-file-name filename) nil
413 (with-file-property v localname (format "file-attributes-%s" id-format)
414 (cdr (car (tramp-fish-get-file-entries v localname nil))))))
415
416(defun tramp-fish-handle-file-directory-p (filename)
417 "Like `file-directory-p' for Tramp files."
418 (let ((attributes (file-attributes filename)))
419 (and attributes
420 (or (string-match "d" (nth 8 attributes))
421 (and (file-symlink-p filename)
422 (with-parsed-tramp-file-name filename nil
423 (file-directory-p
424 (tramp-make-tramp-file-name
425 method user host (nth 0 attributes))))))
426 t)))
427
428(defun tramp-fish-handle-file-exists-p (filename)
429 "Like `file-exists-p' for Tramp files."
430 (and (file-attributes filename) t))
431
432(defun tramp-fish-handle-file-executable-p (filename)
433 "Like `file-executable-p' for Tramp files."
434 (with-parsed-tramp-file-name (expand-file-name filename) nil
435 (with-file-property v localname "file-executable-p"
436 (when (file-exists-p filename)
437 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
438 (home-directory
439 (tramp-make-tramp-file-name
440 method user host
441 (tramp-get-connection-property v "home-directory" nil))))
442 (or (and (char-equal (aref mode-chars 3) ?x)
443 (equal (nth 2 (file-attributes filename))
444 (nth 2 (file-attributes home-directory))))
445 (and (char-equal (aref mode-chars 6) ?x)
446 (equal (nth 3 (file-attributes filename))
447 (nth 3 (file-attributes home-directory))))
448 (char-equal (aref mode-chars 9) ?x)))))))
449
450(defun tramp-fish-handle-file-readable-p (filename)
451 "Like `file-readable-p' for Tramp files."
452 (with-parsed-tramp-file-name (expand-file-name filename) nil
453 (with-file-property v localname "file-readable-p"
454 (when (file-exists-p filename)
455 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
456 (home-directory
457 (tramp-make-tramp-file-name
458 method user host
459 (tramp-get-connection-property v "home-directory" nil))))
460 (or (and (char-equal (aref mode-chars 1) ?r)
461 (equal (nth 2 (file-attributes filename))
462 (nth 2 (file-attributes home-directory))))
463 (and (char-equal (aref mode-chars 4) ?r)
464 (equal (nth 3 (file-attributes filename))
465 (nth 3 (file-attributes home-directory))))
466 (char-equal (aref mode-chars 7) ?r)))))))
467
468(defun tramp-fish-handle-file-writable-p (filename)
469 "Like `file-writable-p' for Tramp files."
470 (with-parsed-tramp-file-name (expand-file-name filename) nil
471 (with-file-property v localname "file-writable-p"
472 (if (not (file-exists-p filename))
473 ;; If file doesn't exist, check if directory is writable.
474 (and (file-directory-p (file-name-directory filename))
475 (file-writable-p (file-name-directory filename)))
476 ;; Existing files must be writable.
477 (let ((mode-chars (string-to-vector (nth 8 (file-attributes filename))))
478 (home-directory
479 (tramp-make-tramp-file-name
480 method user host
481 (tramp-get-connection-property v "home-directory" nil))))
482 (or (and (char-equal (aref mode-chars 2) ?w)
483 (equal (nth 2 (file-attributes filename))
484 (nth 2 (file-attributes home-directory))))
485 (and (char-equal (aref mode-chars 5) ?w)
486 (equal (nth 3 (file-attributes filename))
487 (nth 3 (file-attributes home-directory))))
488 (char-equal (aref mode-chars 8) ?w)))))))
489
490(defun tramp-fish-handle-file-local-copy (filename)
491 "Like `file-local-copy' for Tramp files."
492 (with-parsed-tramp-file-name (expand-file-name filename) nil
493 (unless (file-exists-p filename)
494 (tramp-error
495 v 'file-error
496 "Cannot make local copy of non-existing file `%s'" filename))
497 (let ((tmpfil (tramp-make-temp-file filename)))
498 (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfil)
499 (when (tramp-fish-retrieve-data v)
500 ;; Save file
501 (with-current-buffer (tramp-get-buffer v)
502 (write-region (point-min) (point-max) tmpfil))
503 (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfil)
504 tmpfil))))
505
506;; This function should return "foo/" for directories and "bar" for
507;; files.
508(defun tramp-fish-handle-file-name-all-completions (filename directory)
509 "Like `file-name-all-completions' for Tramp files."
510 (all-completions
511 filename
512 (with-parsed-tramp-file-name (expand-file-name directory) nil
513 (with-file-property v localname "file-name-all-completions"
514 (save-match-data
515 (let ((entries
516 (with-file-property v localname "file-entries"
517 (tramp-fish-get-file-entries v localname t))))
518 (mapcar
519 (lambda (x)
520 (list
521 (if (string-match "d" (nth 9 x))
522 (file-name-as-directory (nth 0 x))
523 (nth 0 x))))
524 entries)))))))
525
526(defun tramp-fish-handle-file-newer-than-file-p (file1 file2)
527 "Like `file-newer-than-file-p' for Tramp files."
528 (cond
529 ((not (file-exists-p file1)) nil)
530 ((not (file-exists-p file2)) t)
531 (t (tramp-time-less-p (nth 5 (file-attributes file2))
532 (nth 5 (file-attributes file1))))))
533
534(defun tramp-fish-handle-insert-directory
535 (filename switches &optional wildcard full-directory-p)
536 "Like `insert-directory' for Tramp files.
537WILDCARD and FULL-DIRECTORY-P are not handled."
538 (setq filename (expand-file-name filename))
539 (when (file-directory-p filename)
540 ;; This check is a little bit strange, but in `dired-add-entry'
541 ;; this function is called with a non-directory ...
542 (setq filename (file-name-as-directory filename)))
543
544 (with-parsed-tramp-file-name filename nil
545 (tramp-flush-file-property v localname)
546 (save-match-data
547 (let ((entries
548 (with-file-property v localname "file-entries"
549 (tramp-fish-get-file-entries v localname t))))
550
551 ;; Sort entries
552 (setq entries
553 (sort
554 entries
555 (lambda (x y)
556 (if (string-match "t" switches)
557 ;; Sort by date.
558 (tramp-time-less-p (nth 6 y) (nth 6 x))
559 ;; Sort by name.
560 (string-lessp (nth 0 x) (nth 0 y))))))
561
562 ;; Print entries.
563 (mapcar
564 (lambda (x)
565 (insert
566 (format
567 "%10s %3d %-8s %-8s %8s %s %s%s\n"
568 (nth 9 x) ; mode
569 1 ; hardlinks
570 (nth 3 x) ; uid
571 (nth 4 x) ; gid
572 (nth 8 x) ; size
573 (format-time-string
574 (if (tramp-time-less-p
575 (tramp-time-subtract (current-time) (nth 6 x))
576 tramp-half-a-year)
577 "%b %e %R"
578 "%b %e %Y")
579 (nth 6 x)) ; date
580 (nth 0 x) ; file name
581 (if (stringp (nth 1 x)) (format " -> %s" (nth 1 x)) "")))
582 (forward-line)
583 (beginning-of-line))
584 entries)))))
585
586(defun tramp-fish-handle-insert-file-contents
587 (filename &optional visit beg end replace)
588 "Like `insert-file-contents' for Tramp files."
589 (barf-if-buffer-read-only)
590 (when visit
591 (setq buffer-file-name (expand-file-name filename))
592 (set-visited-file-modtime)
593 (set-buffer-modified-p nil))
594
595 (with-parsed-tramp-file-name filename nil
596 (if (not (file-exists-p filename))
597 (tramp-error
598 v 'file-error "File %s not found on remote host" filename)
599
600 (let ((point (point))
601 size)
602 (tramp-message v 4 "Fetching file %s..." filename)
603 (when (tramp-fish-retrieve-data v)
604 ;; Insert file
605 (insert
606 (with-current-buffer (tramp-get-buffer v)
607 (let ((beg (or beg (point-min)))
608 (end (min (or end (point-max)) (point-max))))
609 (setq size (- end beg))
610 (buffer-substring beg end))))
611 (goto-char point))
612 (tramp-message v 4 "Fetching file %s...done" filename)
613
614 (list (expand-file-name filename) size)))))
615
616(defun tramp-fish-handle-make-directory (dir &optional parents)
617 "Like `make-directory' for Tramp files."
618 (setq dir (directory-file-name (expand-file-name dir)))
619 (unless (file-name-absolute-p dir)
620 (setq dir (expand-file-name dir default-directory)))
621 (with-parsed-tramp-file-name dir nil
622 (save-match-data
623 (let ((ldir (file-name-directory dir)))
624 ;; Make missing directory parts
625 (when (and parents (not (file-directory-p ldir)))
626 (make-directory ldir parents))
627 ;; Just do it
628 (when (file-directory-p ldir)
629 (make-directory-internal dir))
630 (unless (file-directory-p dir)
631 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
632
633(defun tramp-fish-handle-make-directory-internal (directory)
634 "Like `make-directory-internal' for Tramp files."
635 (setq directory (directory-file-name (expand-file-name directory)))
636 (unless (file-name-absolute-p directory)
637 (setq directory (expand-file-name directory default-directory)))
638 (when (file-directory-p (file-name-directory directory))
639 (with-parsed-tramp-file-name directory nil
640 (save-match-data
641 (unless
642 (tramp-fish-send-command-and-check v (format "#MKD %s" localname))
643 (tramp-error
644 v 'file-error "Couldn't make directory %s" directory))))))
645
646(defun tramp-fish-handle-make-symbolic-link
647 (filename linkname &optional ok-if-already-exists)
648 "Like `make-symbolic-link' for Tramp files.
649If LINKNAME is a non-Tramp file, it is used verbatim as the target of
650the symlink. If LINKNAME is a Tramp file, only the localname component is
651used as the target of the symlink.
652
653If LINKNAME is a Tramp file and the localname component is relative, then
654it is expanded first, before the localname component is taken. Note that
655this can give surprising results if the user/host for the source and
656target of the symlink differ."
657 (with-parsed-tramp-file-name linkname nil
658 ;; Do the 'confirm if exists' thing.
659 (when (file-exists-p linkname)
660 ;; What to do?
661 (if (or (null ok-if-already-exists) ; not allowed to exist
662 (and (numberp ok-if-already-exists)
663 (not (yes-or-no-p
664 (format
665 "File %s already exists; make it a link anyway? "
666 localname)))))
667 (tramp-error
668 v 'file-already-exists "File %s already exists" localname)
669 (delete-file linkname)))
670
671 ;; If FILENAME is a Tramp name, use just the localname component.
672 (when (tramp-tramp-file-p filename)
673 (setq filename (tramp-file-name-localname
674 (tramp-dissect-file-name (expand-file-name filename)))))
675
676 ;; Right, they are on the same host, regardless of user, method, etc.
677 ;; We now make the link on the remote machine. This will occur as the user
678 ;; that FILENAME belongs to.
679 (unless
680 (tramp-fish-send-command-and-check
681 v (format "#SYMLINK %s %s" filename localname))
682 (tramp-error v 'file-error "Error creating symbolic link %s" linkname))))
683
684(defun tramp-fish-handle-rename-file
685 (filename newname &optional ok-if-already-exists)
686 "Like `rename-file' for Tramp files."
687 (tramp-fish-do-copy-or-rename-file
688 'rename filename newname ok-if-already-exists t))
689
690(defun tramp-fish-handle-set-file-modes (filename mode)
691 "Like `set-file-modes' for Tramp files."
692 (with-parsed-tramp-file-name filename nil
693 (tramp-flush-file-property v localname)
694 (unless (tramp-fish-send-command-and-check
695 v (format "#CHMOD %s %s"
696 (tramp-decimal-to-octal mode)
697 (tramp-shell-quote-argument localname)))
698 (tramp-error
699 v 'file-error "Error while changing file's mode %s" filename))))
700
701(defun tramp-fish-handle-write-region
702 (start end filename &optional append visit lockname confirm)
703 "Like `write-region' for Tramp files."
704 (setq filename (expand-file-name filename))
705 (with-parsed-tramp-file-name filename nil
706 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
707 (when (and (not (featurep 'xemacs))
708 confirm (file-exists-p filename))
709 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
710 filename))
711 (tramp-error v 'file-error "File not overwritten")))
712
713 (tramp-flush-file-property v localname)
714
715 ;; Send command
716 (let ((tramp-fish-ok-prompt-regexp
717 (concat
718 tramp-fish-ok-prompt-regexp "\\|"
719 tramp-fish-continue-prompt-regexp)))
720 (tramp-fish-send-command
721 v (format "%s %d %s\n### 100"
722 (if append "#APPEND" "#STOR") (- end start) localname)))
723
724 ;; Send data, if there are any.
725 (when (> end start)
726 (tramp-fish-send-command v (buffer-substring-no-properties start end)))
727
728 (when (eq visit t)
729 (set-visited-file-modtime))))
730
731(defun tramp-fish-handle-executable-find (command)
732 "Like `executable-find' for Tramp files."
733 (with-temp-buffer
734 (if (zerop (call-process "which" nil t nil command))
735 (progn
736 (goto-char (point-min))
737 (buffer-substring (point-min) (tramp-line-end-position))))))
738
739(defun tramp-fish-handle-call-process
740 (program &optional infile destination display &rest args)
741 "Like `call-process' for Tramp files."
742 ;; The implementation is not complete yet.
743 (when (and (numberp destination) (zerop destination))
744 (error "Implementation does not handle immediate return"))
745
746 (with-parsed-tramp-file-name default-directory nil
747 (let ((temp-name-prefix (tramp-make-tramp-temp-file v))
748 command input output stderr outbuf tmpfil ret)
749 ;; Compute command.
750 (setq command (mapconcat 'tramp-shell-quote-argument
751 (cons program args) " "))
752 ;; Determine input.
753 (if (null infile)
754 (setq input "/dev/null")
755 (setq infile (expand-file-name infile))
756 (if (tramp-equal-remote default-directory infile)
757 ;; INFILE is on the same remote host.
758 (setq input (with-parsed-tramp-file-name infile nil localname))
759 ;; INFILE must be copied to remote host.
760 (setq input (concat temp-name-prefix ".in"))
761 (copy-file
762 infile
763 (tramp-make-tramp-file-name method user host input)
764 t)))
765 (when input (setq command (format "%s <%s" command input)))
766
767 ;; Determine output.
768 (setq output (concat temp-name-prefix ".out"))
769 (cond
770 ;; Just a buffer
771 ((bufferp destination)
772 (setq outbuf destination))
773 ;; A buffer name
774 ((stringp destination)
775 (setq outbuf (get-buffer-create destination)))
776 ;; (REAL-DESTINATION ERROR-DESTINATION)
777 ((consp destination)
778 ;; output
779 (cond
780 ((bufferp (car destination))
781 (setq outbuf (car destination)))
782 ((stringp (car destination))
783 (setq outbuf (get-buffer-create (car destination)))))
784 ;; stderr
785 (cond
786 ((stringp (cadr destination))
787 (setcar (cdr destination) (expand-file-name (cadr destination)))
788 (if (tramp-equal-remote default-directory (cadr destination))
789 ;; stderr is on the same remote host.
790 (setq stderr (with-parsed-tramp-file-name
791 (cadr destination) nil localname))
792 ;; stderr must be copied to remote host. The temporary
793 ;; file must be deleted after execution.
794 (setq stderr (concat temp-name-prefix ".err"))))
795 ;; stderr to be discarded
796 ((null (cadr destination))
797 (setq stderr "/dev/null"))))
798 ;; 't
799 (destination
800 (setq outbuf (current-buffer))))
801 (when stderr (setq command (format "%s 2>%s" command stderr)))
802
803 ;; If we have a temporary file, it must be removed after operation.
804 (when (and input (string-match temp-name-prefix input))
805 (setq command (format "%s; rm %s" command input)))
806 ;; Goto working directory.
807 (unless
808 (tramp-fish-send-command-and-check
809 v (format "#CWD %s" (tramp-shell-quote-argument localname)))
810 (tramp-error v 'file-error "No such directory: %s" default-directory))
811 ;; Send the command. It might not return in time, so we protect it.
812 (condition-case nil
813 (unwind-protect
814 (unless (tramp-fish-send-command-and-check
815 v (format
816 "#EXEC %s %s"
817 (tramp-shell-quote-argument command) output))
818 (error))
819 ;; Check return code.
820 (setq tmpfil (file-local-copy
821 (tramp-make-tramp-file-name method user host output)))
822 (with-temp-buffer
823 (insert-file-contents tmpfil)
824 (goto-char (point-max))
825 (forward-line -1)
826 (looking-at "^###RESULT: \\([0-9]+\\)")
827 (setq ret (string-to-number (match-string 1)))
828 (delete-region (point) (point-max))
829 (write-region (point-min) (point-max) tmpfil))
830 ;; We should show the output anyway.
831 (when outbuf
832 (with-current-buffer outbuf (insert-file-contents tmpfil))
833 (when display (display-buffer outbuf)))
834 ;; Remove output file.
835 (delete-file (tramp-make-tramp-file-name method user host output)))
836 ;; When the user did interrupt, we should do it also.
837 (error (setq ret 1)))
838 (unless ret
839 ;; Provide error file.
840 (when (and stderr (string-match temp-name-prefix stderr))
841 (rename-file (tramp-make-tramp-file-name method user host stderr)
842 (cadr destination) t)))
843 ;; Return exit status.
844 ret)))
845
846
847;; Internal file name functions
848
849(defun tramp-fish-do-copy-or-rename-file
850 (op filename newname &optional ok-if-already-exists keep-date)
851 "Copy or rename a remote file.
852OP must be `copy' or `rename' and indicates the operation to
853perform. FILENAME specifies the file to copy or rename, NEWNAME
854is the name of the new file (for copy) or the new name of the
855file (for rename). OK-IF-ALREADY-EXISTS means don't barf if
856NEWNAME exists already. KEEP-DATE means to make sure that
857NEWNAME has the same timestamp as FILENAME.
858
859This function is invoked by `tramp-fish-handle-copy-file' and
860`tramp-fish-handle-rename-file'. It is an error if OP is neither
861of `copy' and `rename'. FILENAME and NEWNAME must be absolute
862file names."
863 (unless (memq op '(copy rename))
864 (error "Unknown operation `%s', must be `copy' or `rename'" op))
865 (let ((t1 (tramp-tramp-file-p filename))
866 (t2 (tramp-tramp-file-p newname)))
867
868 (unless ok-if-already-exists
869 (when (and t2 (file-exists-p newname))
870 (with-parsed-tramp-file-name newname nil
871 (tramp-error
872 v 'file-already-exists "File %s already exists" newname))))
873
874 (prog1
875 (cond
876 ;; Both are Tramp files.
877 ((and t1 t2)
878 (cond
879 ;; Shortcut: if method, host, user are the same for both
880 ;; files, we invoke `cp' or `mv' on the remote host
881 ;; directly.
882 ((tramp-equal-remote filename newname)
883 (tramp-fish-do-copy-or-rename-file-directly
884 op filename newname keep-date))
885 ;; No shortcut was possible. So we copy the
886 ;; file first. If the operation was `rename', we go
887 ;; back and delete the original file (if the copy was
888 ;; successful). The approach is simple-minded: we
889 ;; create a new buffer, insert the contents of the
890 ;; source file into it, then write out the buffer to
891 ;; the target file. The advantage is that it doesn't
892 ;; matter which filename handlers are used for the
893 ;; source and target file.
894 (t
895 (tramp-do-copy-or-rename-file-via-buffer
896 op filename newname keep-date))))
897
898 ;; One file is a Tramp file, the other one is local.
899 ((or t1 t2)
900 ;; Use the generic method via a Tramp buffer.
901 (tramp-do-copy-or-rename-file-via-buffer
902 op filename newname keep-date))
903
904 (t
905 ;; One of them must be a Tramp file.
906 (error "Tramp implementation says this cannot happen")))
907 ;; When newname did exist, we have wrong cached values.
908 (when t2
909 (with-parsed-tramp-file-name newname nil
910 (tramp-flush-file-property v localname)
911 (tramp-flush-file-property v (file-name-directory localname)))))))
912
913(defun tramp-fish-do-copy-or-rename-file-directly
914 (op filename newname keep-date)
915 "Invokes `COPY' or `RENAME' on the remote system.
916OP must be one of `copy' or `rename', indicating `cp' or `mv',
917respectively. VEC specifies the connection. LOCALNAME1 and
918LOCALNAME2 specify the two arguments of `cp' or `mv'. If
919KEEP-DATE is non-nil, preserve the time stamp when copying."
920 (with-parsed-tramp-file-name filename v1
921 (with-parsed-tramp-file-name newname v2
922 (tramp-fish-send-command
923 v1
924 (format "%s %s %s"
925 (if (eq op 'copy) "#COPY" "#RENAME")
926 (tramp-shell-quote-argument v1-localname)
927 (tramp-shell-quote-argument v2-localname)))))
928 ;; KEEP-DATE handling.
929 (when keep-date
930 (let ((modtime (nth 5 (file-attributes filename))))
931 (when (and (not (null modtime))
932 (not (equal modtime '(0 0))))
933 (tramp-touch newname modtime))))
934 ;; Set the mode.
935 (set-file-modes newname (file-modes filename)))
936
937(defun tramp-fish-get-file-entries (vec localname list)
938 "Read entries returned by FISH server.
939When LIST is true, a #LIST command will be sent, including all entries
940of a directory. Otherwise, #STAT is sent for just one entry.
941Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
942SIZE MODE WEIRD INODE DEVICE)."
943 (block nil
944 (with-current-buffer (tramp-get-buffer vec)
945 ;; #LIST does not work properly with trailing "/", at least in .fishsrv.pl
946 (when (string-match "/$" localname)
947 (setq localname (concat localname ".")))
948
949 (let ((command (format "%s %s" (if list "#LIST" "#STAT") localname))
950 buffer-read-only num res)
951
952 ;; Send command
953 (tramp-fish-send-command vec command)
954
955 ;; Read number of entries
956 (goto-char (point-min))
957 (condition-case nil
958 (unless (integerp (setq num (read (current-buffer)))) (error))
959 (error (return nil)))
960 (forward-line)
961 (delete-region (point-min) (point))
962
963 ;; Read return code
964 (goto-char (point-min))
965 (condition-case nil
966 (unless (looking-at tramp-fish-continue-prompt-regexp) (error))
967 (error (return nil)))
968 (forward-line)
969 (delete-region (point-min) (point))
970
971 ;; Loop the listing
972 (dotimes (i num)
973 (let ((item (tramp-fish-read-file-entry)))
974 ;; Add inode and device.
975 (add-to-list
976 'res (append item
977 (list (tramp-get-inode (car item))
978 (tramp-get-device vec))))))
979
980 ;; Read return code
981 (goto-char (point-min))
982 (condition-case nil
983 (unless (looking-at tramp-fish-ok-prompt-regexp) (error))
984 (error (tramp-error
985 vec 'file-error
986 "`%s' does not return a valid Lisp expression: `%s'"
987 command (buffer-string))))
988 (forward-line)
989 (delete-region (point-min) (point))
990
991 res))))
992
993(defun tramp-fish-read-file-entry ()
994 "Parse entry in output buffer.
995Result is the list (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
996SIZE MODE WEIRD)."
997 ;; We are called from `tramp-fish-get-file-entries', which sets the
998 ;; current buffer.
999 (let (buffer-read-only localname link uid gid mtime size mode)
1000 (block nil
1001 (while t
1002 (cond
1003 ;; P<unix permissions> <owner>.<group>
1004 ((looking-at "^P\\(.+\\)\\s-\\(.+\\)\\.\\(.+\\)$")
1005 (setq mode (match-string 1))
1006 (setq uid (match-string 2))
1007 (setq gid (match-string 3))
1008 (when (string-match "^d" mode) (setq link t)))
1009 ;; S<size>
1010 ((looking-at "^S\\([0-9]+\\)$")
1011 (setq size (string-to-number (match-string 1))))
1012 ;; D<year> <month> <day> <hour> <minute> <second>[.1234]
1013 ((looking-at
1014 "^D\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\([0-9]+\\)\\s-\\(\\S-+\\)$")
1015 (setq mtime
1016 (encode-time
1017 (string-to-number (match-string 6))
1018 (string-to-number (match-string 5))
1019 (string-to-number (match-string 4))
1020 (string-to-number (match-string 3))
1021 (string-to-number (match-string 2))
1022 (string-to-number (match-string 1)))))
1023 ;; d<3-letters month name> <day> <year or HH:MM>
1024 ((looking-at "^d") nil)
1025 ;; E<major-of-device>,<minor>
1026 ((looking-at "^E") nil)
1027 ;; :<filename>
1028 ((looking-at "^:\\(.+\\)$")
1029 (setq localname (match-string 1)))
1030 ;; L<filename symlink points to>
1031 ((looking-at "^L\\(.+\\)$")
1032 (setq link (match-string 1)))
1033 ;; M<mimetype>
1034 ((looking-at "^M\\(.+\\)$") nil)
1035 ;; last line
1036 ((looking-at "^$")
1037 (return)))
1038 ;; delete line
1039 (forward-line)
1040 (delete-region (point-min) (point))))
1041
1042 ;; delete trailing empty line
1043 (forward-line)
1044 (delete-region (point-min) (point))
1045
1046 ;; Return entry in file-attributes format
1047 (list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil)))
1048
1049(defun tramp-fish-retrieve-data (vec)
1050 "Reads remote data for FISH protocol.
1051The data are left in the connection buffer of VEC for further processing.
1052Returns the size of the data."
1053 (block nil
1054 (with-current-buffer (tramp-get-buffer vec)
1055 ;; The retrieved data might be in binary format, without
1056 ;; trailing newline. Therefore, the OK prompt might not start
1057 ;; at the beginning of a line.
1058 (let ((tramp-fish-ok-prompt-regexp "### 200\n")
1059 size)
1060
1061 ;; Send command
1062 (tramp-fish-send-command
1063 vec (format "#RETR %s" (tramp-file-name-localname vec)))
1064
1065 ;; Read filesize
1066 (goto-char (point-min))
1067 (condition-case nil
1068 (unless (integerp (setq size (read (current-buffer)))) (error))
1069 (error (return nil)))
1070 (forward-line)
1071 (delete-region (point-min) (point))
1072
1073 ;; Read return code
1074 (goto-char (point-min))
1075 (condition-case nil
1076 (unless (looking-at tramp-fish-continue-prompt-regexp) (error))
1077 (error (return nil)))
1078 (forward-line)
1079 (delete-region (point-min) (point))
1080
1081 ;; The received data might contain the OK prompt already, so
1082 ;; there might be outstanding data.
1083 (while (/= (+ size (length tramp-fish-ok-prompt-regexp))
1084 (- (point-max) (point-min)))
1085 (tramp-wait-for-regexp
1086 (tramp-get-connection-process vec) nil
1087 (concat tramp-fish-ok-prompt-regexp "$")))
1088
1089 ;; Read return code
1090 (goto-char (+ (point-min) size))
1091 (condition-case nil
1092 (unless (looking-at tramp-fish-ok-prompt-regexp) (error))
1093 (error (return nil)))
1094 (delete-region (+ (point-min) size) (point-max))
1095 size))))
1096
1097
1098;; Connection functions
1099
1100(defun tramp-fish-maybe-open-connection (vec)
1101 "Maybe open a connection VEC.
1102Does not do anything if a connection is already open, but re-opens the
1103connection if a previous connection has died for some reason."
1104 (let ((process-connection-type tramp-process-connection-type)
1105 (p (get-buffer-process (tramp-get-buffer vec))))
1106
1107 ;; New connection must be opened.
1108 (unless (and p (processp p) (memq (process-status p) '(run open)))
1109
1110 ;; Set variables for computing the prompt for reading password.
1111 (setq tramp-current-method (tramp-file-name-method vec)
1112 tramp-current-user (tramp-file-name-user vec)
1113 tramp-current-host (tramp-file-name-host vec))
1114
1115 ;; Start new process.
1116 (when (and p (processp p))
1117 (delete-process p))
1118 (setenv "TERM" tramp-terminal-type)
1119 (setenv "PS1" "$ ")
1120 (tramp-message
1121 vec 3 "Opening connection for %s@%s using %s..."
1122 tramp-current-user tramp-current-host tramp-current-method)
1123
1124 (let* ((process-connection-type tramp-process-connection-type)
1125 (inhibit-eol-conversion nil)
1126 (coding-system-for-read 'binary)
1127 (coding-system-for-write 'binary)
1128 ;; This must be done in order to avoid our file name handler.
1129 (p (let ((default-directory (tramp-temporary-file-directory)))
1130 (start-process
1131 (or (tramp-get-connection-property vec "process-name" nil)
1132 (tramp-buffer-name vec))
1133 (tramp-get-connection-buffer vec)
1134 "ssh" "-l"
1135 (tramp-file-name-user vec)
1136 (tramp-file-name-host vec)))))
1137 (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " "))
1138
1139 ;; Check whether process is alive.
1140 (set-process-sentinel p 'tramp-flush-connection-property)
1141 (tramp-set-process-query-on-exit-flag p nil)
1142
1143 (tramp-process-actions p vec tramp-actions-before-shell 60)
1144 (tramp-fish-send-command vec tramp-fish-start-fish-server-command)
1145 (tramp-message
1146 vec 3
1147 "Found remote shell prompt on `%s'" (tramp-file-name-host vec))))))
1148
1149(defun tramp-fish-send-command (vec command)
1150 "Send the COMMAND to connection VEC."
1151 (tramp-fish-maybe-open-connection vec)
1152 (tramp-message vec 6 "%s" command)
1153 (tramp-send-string vec command)
1154 (tramp-wait-for-regexp
1155 (tramp-get-connection-process vec) nil
1156 (concat tramp-fish-ok-prompt-regexp "\\|" tramp-fish-error-prompt-regexp)))
1157
1158(defun tramp-fish-send-command-and-check (vec command)
1159 "Send the COMMAND to connection VEC.
1160Returns nil if there has been an error message."
1161
1162 ;; Send command.
1163 (tramp-fish-send-command vec command)
1164
1165 ;; Read return code.
1166 (with-current-buffer (tramp-get-buffer vec)
1167 (goto-char (point-min))
1168 (looking-at tramp-fish-ok-prompt-regexp)))
1169
1170(provide 'tramp-fish)
1171;
1172;;;; TODO:
1173;
1174;; * Evaluate the MIME information with #LIST or #STAT.
1175;
1176
1177;; arch-tag: a66df7df-5f29-42a7-a921-643ceb29db49
1178;;;; tramp-fish.el ends here
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index d33873d1689..fcdab250ac8 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -10,8 +10,8 @@
10 10
11;; GNU Emacs is free software; you can redistribute it and/or modify 11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by 12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option) 13;; the Free Software Foundation; either version 3 of the License, or
14;; any later version. 14;; (at your option) any later version.
15 15
16;; GNU Emacs is distributed in the hope that it will be useful, 16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +19,8 @@
19;; GNU General Public License for more details. 19;; GNU General Public License for more details.
20 20
21;; You should have received a copy of the GNU General Public License 21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; along with GNU Emacs; see the file COPYING. If not, see
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; <http://www.gnu.org/licenses/>.
24;; Boston, MA 02110-1301, USA.
25 24
26;;; Commentary: 25;;; Commentary:
27 26
@@ -110,10 +109,13 @@ present for backward compatibility."
110 (list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) 109 (list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
111 110
112;; Add completion function for FTP method. 111;; Add completion function for FTP method.
113(unless (memq system-type '(windows-nt)) 112(tramp-set-completion-function
114 (tramp-set-completion-function 113 tramp-ftp-method
115 tramp-ftp-method 114 '((tramp-parse-netrc "~/.netrc")))
116 '((tramp-parse-netrc "~/.netrc")))) 115
116;; If there is URL syntax, `substitute-in-file-name' needs special
117;; handling.
118(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name)
117 119
118(defun tramp-ftp-file-name-handler (operation &rest args) 120(defun tramp-ftp-file-name-handler (operation &rest args)
119 "Invoke the Ange-FTP handler for OPERATION. 121 "Invoke the Ange-FTP handler for OPERATION.
@@ -152,13 +154,7 @@ pass to the OPERATION."
152(defun tramp-ftp-file-name-p (filename) 154(defun tramp-ftp-file-name-p (filename)
153 "Check if it's a filename that should be forwarded to Ange-FTP." 155 "Check if it's a filename that should be forwarded to Ange-FTP."
154 (let ((v (tramp-dissect-file-name filename))) 156 (let ((v (tramp-dissect-file-name filename)))
155 (string= 157 (string= (tramp-file-name-method v) tramp-ftp-method)))
156 (tramp-find-method
157 (tramp-file-name-multi-method v)
158 (tramp-file-name-method v)
159 (tramp-file-name-user v)
160 (tramp-file-name-host v))
161 tramp-ftp-method)))
162 158
163(add-to-list 'tramp-foreign-file-name-handler-alist 159(add-to-list 'tramp-foreign-file-name-handler-alist
164 (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) 160 (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
@@ -172,8 +168,6 @@ pass to the OPERATION."
172;; pretended in `tramp-file-name-handler' otherwise. 168;; pretended in `tramp-file-name-handler' otherwise.
173;; Furthermore, there are no backup files on FTP hosts. 169;; Furthermore, there are no backup files on FTP hosts.
174;; Worth further investigations. 170;; Worth further investigations.
175;; * Map /multi:ssh:out@gate:ftp:kai@real.host:/path/to.file
176;; on Ange-FTP gateways.
177 171
178;;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff 172;;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff
179;;; tramp-ftp.el ends here 173;;; tramp-ftp.el ends here
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
new file mode 100644
index 00000000000..78f8040a909
--- /dev/null
+++ b/lisp/net/tramp-gw.el
@@ -0,0 +1,324 @@
1;;; -*- coding: iso-8859-1; -*-
2;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways
3
4;; Copyright (C) 2007 Free Software Foundation, Inc.
5
6;; Author: Michael Albinus <michael.albinus@gmx.de>
7;; Keywords: comm, processes
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, see
23;; <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Access functions for HTTP tunnels and SOCKS gateways from Tramp.
28;; SOCKS functionality is implemented by socks.el from the w3 package.
29;; HTTP tunnels are partly implemented in socks.el and url-http.el;
30;; both implementations are not complete. Therefore, it is
31;; implemented in this package.
32
33;;; Code:
34
35(require 'tramp)
36
37;; Pacify byte-compiler
38(eval-when-compile
39 (require 'cl)
40 (require 'custom))
41
42;; Autoload the socks library. It is used only when we access a SOCKS server.
43(autoload 'socks-open-network-stream "socks")
44(defvar socks-username (user-login-name))
45(defvar socks-server (list "Default server" "socks" 1080 5))
46
47;; Avoid byte-compiler warnings if the byte-compiler supports this.
48;; Currently, XEmacs supports this.
49(eval-when-compile
50 (when (featurep 'xemacs)
51 (byte-compiler-options (warnings (- unused-vars)))))
52
53;; Define HTTP tunnel method ...
54(defvar tramp-gw-tunnel-method "tunnel"
55 "*Method to connect HTTP gateways.")
56
57;; ... and port.
58(defvar tramp-gw-default-tunnel-port 8080
59 "*Default port for HTTP gateways.")
60
61;; Define SOCKS method ...
62(defvar tramp-gw-socks-method "socks"
63 "*Method to connect SOCKS servers.")
64
65;; ... and port.
66(defvar tramp-gw-default-socks-port 1080
67 "*Default port for SOCKS servers.")
68
69;; Add a default for `tramp-default-user-alist'. Default is the local user.
70(add-to-list 'tramp-default-user-alist
71 `(,tramp-gw-tunnel-method nil ,(user-login-name)))
72(add-to-list 'tramp-default-user-alist
73 `(,tramp-gw-socks-method nil ,(user-login-name)))
74
75;; Internal file name functions and variables.
76
77(defvar tramp-gw-vector nil
78 "Keeps the remote host identification. Needed for Tramp messages.")
79
80(defvar tramp-gw-gw-vector nil
81 "Current gateway identification vector.")
82
83(defvar tramp-gw-gw-proc nil
84 "Current gateway process.")
85
86;; This variable keeps the listening process, in order to reuse it for
87;; new processes.
88(defvar tramp-gw-aux-proc nil
89 "Process listening on local port, as mediation between SSH and the gateway.")
90
91(defun tramp-gw-gw-proc-sentinel (proc event)
92 "Delete auxiliary process when we are deleted."
93 (unless (memq (process-status proc) '(run open))
94 (tramp-message
95 tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc)
96 (let* (tramp-verbose
97 (p (tramp-get-connection-property proc "process" nil)))
98 (when (processp p) (delete-process p)))))
99
100(defun tramp-gw-aux-proc-sentinel (proc event)
101 "Activate the different filters for involved gateway and auxiliary processes."
102 (when (memq (process-status proc) '(run open))
103 ;; A new process has been spawned from `tramp-gw-aux-proc'.
104 (tramp-message
105 tramp-gw-vector 4
106 "Opening auxiliary process `%s', speaking with process `%s'"
107 proc tramp-gw-gw-proc)
108 (tramp-set-process-query-on-exit-flag proc nil)
109 ;; We don't want debug messages, because the corresponding debug
110 ;; buffer might be undecided.
111 (let (tramp-verbose)
112 (tramp-set-connection-property tramp-gw-gw-proc "process" proc)
113 (tramp-set-connection-property proc "process" tramp-gw-gw-proc))
114 ;; Set the process-filter functions for both processes.
115 (set-process-filter proc 'tramp-gw-process-filter)
116 (set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter)
117 ;; There might be already some output from the gateway process.
118 (with-current-buffer (process-buffer tramp-gw-gw-proc)
119 (unless (= (point-min) (point-max))
120 (let ((s (buffer-string)))
121 (delete-region (point) (point-max))
122 (tramp-gw-process-filter tramp-gw-gw-proc s))))))
123
124(defun tramp-gw-process-filter (proc string)
125 (let (tramp-verbose)
126 (process-send-string
127 (tramp-get-connection-property proc "process" nil) string)))
128
129(defun tramp-gw-open-connection (vec gw-vec target-vec)
130 "Open a remote connection to VEC (see `tramp-file-name' structure).
131Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
132gateway method. TARGET-VEC identifies where to connect to via
133the gateway, it can be different from VEC when there are more
134hops to be applied.
135
136It returns a string like \"localhost#port\", which must be used
137instead of the host name declared in TARGET-VEC."
138
139 ;; Remember vectors for property retrieval.
140 (setq tramp-gw-vector vec
141 tramp-gw-gw-vector gw-vec)
142
143 ;; Start listening auxiliary process.
144 (unless (and (processp tramp-gw-aux-proc)
145 (memq (process-status tramp-gw-aux-proc) '(listen)))
146 (let ((aux-vec
147 (vector "aux" (tramp-file-name-user gw-vec)
148 (tramp-file-name-host gw-vec) nil)))
149 (setq tramp-gw-aux-proc
150 (make-network-process
151 :name (tramp-buffer-name aux-vec) :buffer nil :host 'local
152 :server t :noquery t :service t :coding 'binary))
153 (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel)
154 (tramp-set-process-query-on-exit-flag tramp-gw-aux-proc nil)
155 (tramp-message
156 vec 4 "Opening auxiliary process `%s', listening on port %d"
157 tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service))))
158
159 (let* ((gw-method
160 (intern
161 (tramp-find-method
162 (tramp-file-name-method gw-vec)
163 (tramp-file-name-user gw-vec)
164 (tramp-file-name-host gw-vec))))
165 (socks-username
166 (tramp-find-user
167 (tramp-file-name-method gw-vec)
168 (tramp-file-name-user gw-vec)
169 (tramp-file-name-host gw-vec)))
170 ;; Declare the SOCKS server to be used.
171 (socks-server
172 (list "Tramp tempory socks server list"
173 ;; Host name.
174 (tramp-file-name-real-host gw-vec)
175 ;; Port number.
176 (or (tramp-file-name-port gw-vec)
177 (case gw-method
178 (tunnel tramp-gw-default-tunnel-port)
179 (socks tramp-gw-default-socks-port)))
180 ;; Type. We support only http and socks5, NO socks4.
181 ;; 'http could be used when HTTP tunnel works in socks.el.
182 5))
183 ;; The function to be called.
184 (socks-function
185 (case gw-method
186 (tunnel 'tramp-gw-open-network-stream)
187 (socks 'socks-open-network-stream)))
188 socks-noproxy)
189
190 ;; Open SOCKS process.
191 (setq tramp-gw-gw-proc
192 (funcall
193 socks-function
194 (tramp-buffer-name gw-vec)
195 (tramp-get-buffer gw-vec)
196 (tramp-file-name-real-host target-vec)
197 (tramp-file-name-port target-vec)))
198 (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel)
199 (tramp-set-process-query-on-exit-flag tramp-gw-gw-proc nil)
200 (tramp-message
201 vec 4 "Opened %s process `%s'"
202 (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS"))
203 tramp-gw-gw-proc)
204
205 ;; Return the new host for gateway access.
206 (format "localhost#%d" (process-contact tramp-gw-aux-proc :service))))
207
208(defun tramp-gw-open-network-stream (name buffer host service)
209 "Open stream to proxy server HOST:SERVICE.
210Resulting process has name NAME and buffer BUFFER. If
211authentication is requested from proxy server, provide it."
212 (let ((command (format (concat
213 "CONNECT %s:%d HTTP/1.1\r\n"
214 "Host: %s:%d\r\n"
215 "Connection: keep-alive\r\n"
216 "User-Agent: Tramp/%s\r\n")
217 host service host service tramp-version))
218 (authentication "")
219 (first t)
220 found proc)
221
222 (while (not found)
223 ;; Clean up.
224 (when (processp proc) (delete-process proc))
225 (with-current-buffer buffer (erase-buffer))
226 ;; Open network stream.
227 (setq proc (open-network-stream
228 name buffer (nth 1 socks-server) (nth 2 socks-server)))
229 (set-process-coding-system proc 'binary 'binary)
230 (tramp-set-process-query-on-exit-flag proc nil)
231 ;; Send CONNECT command.
232 (process-send-string proc (format "%s%s\r\n" command authentication))
233 (tramp-message
234 tramp-gw-vector 6 "\n%s"
235 (format
236 "%s%s\r\n" command
237 (replace-regexp-in-string ;; no password in trace!
238 "Basic [^\r\n]+" "Basic xxxxx" authentication t)))
239 (with-current-buffer buffer
240 ;; Trap errors to be traced in the right trace buffer. Often,
241 ;; proxies have a timeout of 60". We wait 65" in order to
242 ;; receive an answer this case.
243 (condition-case nil
244 (let (tramp-verbose)
245 (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))
246 (error nil))
247 ;; Check return code.
248 (goto-char (point-min))
249 (narrow-to-region
250 (point-min)
251 (or (search-forward-regexp "\r?\n\r?\n" nil t) (point-max)))
252 (tramp-message tramp-gw-vector 6 "\n%s" (buffer-string))
253 (goto-char (point-min))
254 (search-forward-regexp "^HTTP/[1-9]\\.[0-9]" nil t)
255 (case (condition-case nil (read (current-buffer)) (error))
256 ;; Connected.
257 (200 (setq found t))
258 ;; We need basic authentication.
259 (401 (setq authentication (tramp-gw-basic-authentication nil first)))
260 ;; Target host not found.
261 (404 (tramp-error-with-buffer
262 (current-buffer) tramp-gw-vector 'file-error
263 "Host %s not found." host))
264 ;; We need basic proxy authentication.
265 (407 (setq authentication (tramp-gw-basic-authentication t first)))
266 ;; Connection failed.
267 (503 (tramp-error-with-buffer
268 (current-buffer) tramp-gw-vector 'file-error
269 "Connection to %s:%d failed." host service))
270 ;; That doesn't work at all.
271 (t (tramp-error-with-buffer
272 (current-buffer) tramp-gw-vector 'file-error
273 "Access to HTTP server %s:%d failed."
274 (nth 1 socks-server) (nth 2 socks-server))))
275 ;; Remove HTTP headers.
276 (delete-region (point-min) (point-max))
277 (widen)
278 (setq first nil)))
279 ;; Return the process.
280 proc))
281
282(defun tramp-gw-basic-authentication (proxy pw-cache)
283 "Return authentication header for CONNECT, based on server request.
284PROXY is an indication whether we need a Proxy-Authorization header
285or an Authorization header. If PW-CACHE is non-nil, check for
286password in password cache. This is done for the first try only."
287
288 ;; `tramp-current-*' must be set for `tramp-read-passwd' and
289 ;; `tramp-clear-passwd'.
290 (let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector))
291 (tramp-current-user (tramp-file-name-user tramp-gw-gw-vector))
292 (tramp-current-host (tramp-file-name-host tramp-gw-gw-vector)))
293 (unless pw-cache (tramp-clear-passwd))
294 ;; We are already in the right buffer.
295 (tramp-message
296 tramp-gw-vector 5 "%s required"
297 (if proxy "Proxy authentication" "Authentication"))
298 ;; Search for request header. We accept only basic authentication.
299 (goto-char (point-min))
300 (search-forward-regexp
301 "^\\(Proxy\\|WWW\\)-Authenticate:\\s-*Basic\\s-+realm=")
302 ;; Return authentication string.
303 (format
304 "%s: Basic %s\r\n"
305 (if proxy "Proxy-Authorization" "Authorization")
306 (base64-encode-string
307 (format
308 "%s:%s"
309 socks-username
310 (tramp-read-passwd
311 proc
312 (format
313 "Password for %s@[%s]: " socks-username (read (current-buffer)))))))))
314
315
316(provide 'tramp-gw)
317
318;;; TODO:
319
320;; * Provide descriptive Commentary.
321;; * Enable it for several gateway processes in parallel.
322
323;; arch-tag: 277e3a81-fdee-40cf-9e6b-59626292a5e0
324;;; tramp-gw.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 7382bdef63b..981073f7126 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,6 +1,7 @@
1;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- 1;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
2 2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
4;; 2007 Free Software Foundation, Inc.
4 5
5;; Author: Michael Albinus <michael.albinus@gmx.de> 6;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes 7;; Keywords: comm, processes
@@ -9,8 +10,8 @@
9 10
10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by 12;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option) 13;; the Free Software Foundation; either version 3 of the License, or
13;; any later version. 14;; (at your option) any later version.
14 15
15;; GNU Emacs is distributed in the hope that it will be useful, 16;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +19,8 @@
18;; GNU General Public License for more details. 19;; GNU General Public License for more details.
19 20
20;; You should have received a copy of the GNU General Public License 21;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; along with GNU Emacs; see the file COPYING. If not, see
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; <http://www.gnu.org/licenses/>.
23;; Boston, MA 02110-1301, USA.
24 24
25;;; Commentary: 25;;; Commentary:
26 26
@@ -29,6 +29,7 @@
29;;; Code: 29;;; Code:
30 30
31(require 'tramp) 31(require 'tramp)
32(require 'tramp-cache)
32 33
33;; Pacify byte-compiler 34;; Pacify byte-compiler
34(eval-when-compile (require 'custom)) 35(eval-when-compile (require 'custom))
@@ -36,10 +37,8 @@
36;; Avoid byte-compiler warnings if the byte-compiler supports this. 37;; Avoid byte-compiler warnings if the byte-compiler supports this.
37;; Currently, XEmacs supports this. 38;; Currently, XEmacs supports this.
38(eval-when-compile 39(eval-when-compile
39 (when (fboundp 'byte-compiler-options) 40 (when (featurep 'xemacs)
40 (let (unused-vars) ; Pacify Emacs byte-compiler 41 (byte-compiler-options (warnings (- unused-vars)))))
41 (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
42 (byte-compiler-options (warnings (- unused-vars))))))
43 42
44;; Define SMB method ... 43;; Define SMB method ...
45(defcustom tramp-smb-method "smb" 44(defcustom tramp-smb-method "smb"
@@ -53,7 +52,12 @@
53;; Add a default for `tramp-default-method-alist'. Rule: If there is 52;; Add a default for `tramp-default-method-alist'. Rule: If there is
54;; a domain in USER, it must be the SMB method. 53;; a domain in USER, it must be the SMB method.
55(add-to-list 'tramp-default-method-alist 54(add-to-list 'tramp-default-method-alist
56 (list "" "%" tramp-smb-method)) 55 `(nil "%" ,tramp-smb-method))
56
57;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
58;; the anonymous user is chosen.
59(add-to-list 'tramp-default-user-alist
60 `(,tramp-smb-method nil ""))
57 61
58;; Add completion function for SMB method. 62;; Add completion function for SMB method.
59(tramp-set-completion-function 63(tramp-set-completion-function
@@ -69,11 +73,13 @@
69 "Regexp used as prompt in smbclient.") 73 "Regexp used as prompt in smbclient.")
70 74
71(defconst tramp-smb-errors 75(defconst tramp-smb-errors
76 ;; `regexp-opt' not possible because of first string.
72 (mapconcat 77 (mapconcat
73 'identity 78 'identity
74 '(; Connection error 79 '(;; Connection error / timeout
75 "Connection to \\S-+ failed" 80 "Connection to \\S-+ failed"
76 ; Samba 81 "Read from server failed, maybe it closed the connection"
82 ;; Samba
77 "ERRDOS" 83 "ERRDOS"
78 "ERRSRV" 84 "ERRSRV"
79 "ERRbadfile" 85 "ERRbadfile"
@@ -82,34 +88,48 @@
82 "ERRnoaccess" 88 "ERRnoaccess"
83 "ERRnomem" 89 "ERRnomem"
84 "ERRnosuchshare" 90 "ERRnosuchshare"
85 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) 91 ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
92 ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003)
86 "NT_STATUS_ACCESS_DENIED" 93 "NT_STATUS_ACCESS_DENIED"
87 "NT_STATUS_ACCOUNT_LOCKED_OUT" 94 "NT_STATUS_ACCOUNT_LOCKED_OUT"
88 "NT_STATUS_BAD_NETWORK_NAME" 95 "NT_STATUS_BAD_NETWORK_NAME"
89 "NT_STATUS_CANNOT_DELETE" 96 "NT_STATUS_CANNOT_DELETE"
97 "NT_STATUS_DIRECTORY_NOT_EMPTY"
98 "NT_STATUS_DUPLICATE_NAME"
99 "NT_STATUS_FILE_IS_A_DIRECTORY"
90 "NT_STATUS_LOGON_FAILURE" 100 "NT_STATUS_LOGON_FAILURE"
91 "NT_STATUS_NETWORK_ACCESS_DENIED" 101 "NT_STATUS_NETWORK_ACCESS_DENIED"
92 "NT_STATUS_NO_SUCH_FILE" 102 "NT_STATUS_NO_SUCH_FILE"
103 "NT_STATUS_OBJECT_NAME_COLLISION"
93 "NT_STATUS_OBJECT_NAME_INVALID" 104 "NT_STATUS_OBJECT_NAME_INVALID"
94 "NT_STATUS_OBJECT_NAME_NOT_FOUND" 105 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
95 "NT_STATUS_SHARING_VIOLATION" 106 "NT_STATUS_SHARING_VIOLATION"
107 "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
96 "NT_STATUS_WRONG_PASSWORD") 108 "NT_STATUS_WRONG_PASSWORD")
97 "\\|") 109 "\\|")
98 "Regexp for possible error strings of SMB servers. 110 "Regexp for possible error strings of SMB servers.
99Used instead of analyzing error codes of commands.") 111Used instead of analyzing error codes of commands.")
100 112
101(defvar tramp-smb-share nil 113(defconst tramp-smb-actions-with-share
102 "Holds the share name for the current buffer. 114 '((tramp-smb-prompt tramp-action-succeed)
103This variable is local to each buffer.") 115 (tramp-password-prompt-regexp tramp-action-password)
104(make-variable-buffer-local 'tramp-smb-share) 116 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
117 (tramp-smb-errors tramp-action-permission-denied)
118 (tramp-process-alive-regexp tramp-action-process-alive))
119 "List of pattern/action pairs.
120This list is used for login to SMB servers.
121
122See `tramp-actions-before-shell' for more info.")
105 123
106(defvar tramp-smb-share-cache nil 124(defconst tramp-smb-actions-without-share
107 "Caches the share names accessible to host related to the current buffer. 125 '((tramp-password-prompt-regexp tramp-action-password)
108This variable is local to each buffer.") 126 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
109(make-variable-buffer-local 'tramp-smb-share-cache) 127 (tramp-smb-errors tramp-action-permission-denied)
128 (tramp-process-alive-regexp tramp-action-out-of-band))
129 "List of pattern/action pairs.
130This list is used for login to SMB servers.
110 131
111(defvar tramp-smb-inodes nil 132See `tramp-actions-before-shell' for more info.")
112 "Keeps virtual inodes numbers for SMB files.")
113 133
114;; New handlers should be added here. 134;; New handlers should be added here.
115(defconst tramp-smb-file-name-handler-alist 135(defconst tramp-smb-file-name-handler-alist
@@ -124,8 +144,8 @@ This variable is local to each buffer.")
124 (directory-file-name . tramp-handle-directory-file-name) 144 (directory-file-name . tramp-handle-directory-file-name)
125 (directory-files . tramp-smb-handle-directory-files) 145 (directory-files . tramp-smb-handle-directory-files)
126 (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes) 146 (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes)
127 (dired-call-process . tramp-smb-not-handled) 147 (dired-call-process . ignore)
128 (dired-compress-file . tramp-smb-not-handled) 148 (dired-compress-file . ignore)
129 ;; `dired-uncache' performed by default handler 149 ;; `dired-uncache' performed by default handler
130 ;; `expand-file-name' not necessary because we cannot expand "~/" 150 ;; `expand-file-name' not necessary because we cannot expand "~/"
131 (file-accessible-directory-p . tramp-smb-handle-file-directory-p) 151 (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
@@ -143,10 +163,10 @@ This variable is local to each buffer.")
143 (file-name-nondirectory . tramp-handle-file-name-nondirectory) 163 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
144 ;; `file-name-sans-versions' performed by default handler 164 ;; `file-name-sans-versions' performed by default handler
145 (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) 165 (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p)
146 (file-ownership-preserved-p . tramp-smb-not-handled) 166 (file-ownership-preserved-p . ignore)
147 (file-readable-p . tramp-smb-handle-file-exists-p) 167 (file-readable-p . tramp-smb-handle-file-exists-p)
148 (file-regular-p . tramp-handle-file-regular-p) 168 (file-regular-p . tramp-handle-file-regular-p)
149 (file-symlink-p . tramp-smb-not-handled) 169 (file-symlink-p . tramp-handle-file-symlink-p)
150 ;; `file-truename' performed by default handler 170 ;; `file-truename' performed by default handler
151 (file-writable-p . tramp-smb-handle-file-writable-p) 171 (file-writable-p . tramp-smb-handle-file-writable-p)
152 (find-backup-file-name . tramp-handle-find-backup-file-name) 172 (find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -157,15 +177,15 @@ This variable is local to each buffer.")
157 (load . tramp-handle-load) 177 (load . tramp-handle-load)
158 (make-directory . tramp-smb-handle-make-directory) 178 (make-directory . tramp-smb-handle-make-directory)
159 (make-directory-internal . tramp-smb-handle-make-directory-internal) 179 (make-directory-internal . tramp-smb-handle-make-directory-internal)
160 (make-symbolic-link . tramp-smb-not-handled) 180 (make-symbolic-link . ignore)
161 (rename-file . tramp-smb-handle-rename-file) 181 (rename-file . tramp-smb-handle-rename-file)
162 (set-file-modes . tramp-smb-not-handled) 182 (set-file-modes . ignore)
163 (set-visited-file-modtime . tramp-smb-not-handled) 183 (set-visited-file-modtime . ignore)
164 (shell-command . tramp-smb-not-handled) 184 (shell-command . ignore)
165 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) 185 (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
166 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) 186 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
167 (vc-registered . tramp-smb-not-handled) 187 (vc-registered . ignore)
168 (verify-visited-file-modtime . tramp-smb-not-handled) 188 (verify-visited-file-modtime . ignore)
169 (write-region . tramp-smb-handle-write-region) 189 (write-region . tramp-smb-handle-write-region)
170) 190)
171 "Alist of handler functions for Tramp SMB method. 191 "Alist of handler functions for Tramp SMB method.
@@ -174,13 +194,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
174(defun tramp-smb-file-name-p (filename) 194(defun tramp-smb-file-name-p (filename)
175 "Check if it's a filename for SMB servers." 195 "Check if it's a filename for SMB servers."
176 (let ((v (tramp-dissect-file-name filename))) 196 (let ((v (tramp-dissect-file-name filename)))
177 (string= 197 (string= (tramp-file-name-method v) tramp-smb-method)))
178 (tramp-find-method
179 (tramp-file-name-multi-method v)
180 (tramp-file-name-method v)
181 (tramp-file-name-user v)
182 (tramp-file-name-host v))
183 tramp-smb-method)))
184 198
185(defun tramp-smb-file-name-handler (operation &rest args) 199(defun tramp-smb-file-name-handler (operation &rest args)
186 "Invoke the SMB related OPERATION. 200 "Invoke the SMB related OPERATION.
@@ -188,9 +202,7 @@ First arg specifies the OPERATION, second arg is a list of arguments to
188pass to the OPERATION." 202pass to the OPERATION."
189 (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) 203 (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
190 (if fn 204 (if fn
191 (if (eq (cdr fn) 'tramp-smb-not-handled) 205 (save-match-data (apply (cdr fn) args))
192 (apply (cdr fn) operation args)
193 (save-match-data (apply (cdr fn) args)))
194 (tramp-run-real-handler operation args)))) 206 (tramp-run-real-handler operation args))))
195 207
196(add-to-list 'tramp-foreign-file-name-handler-alist 208(add-to-list 'tramp-foreign-file-name-handler-alist
@@ -199,14 +211,9 @@ pass to the OPERATION."
199 211
200;; File name primitives 212;; File name primitives
201 213
202(defun tramp-smb-not-handled (operation &rest args)
203 "Default handler for all functions which are disrecarded."
204 (tramp-message 10 "Won't be handled: %s %s" operation args)
205 nil)
206
207(defun tramp-smb-handle-copy-file 214(defun tramp-smb-handle-copy-file
208 (filename newname &optional ok-if-already-exists keep-date) 215 (filename newname &optional ok-if-already-exists keep-date)
209 "Like `copy-file' for tramp files. 216 "Like `copy-file' for Tramp files.
210KEEP-DATE is not handled in case NEWNAME resides on an SMB server." 217KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
211 (setq filename (expand-file-name filename) 218 (setq filename (expand-file-name filename)
212 newname (expand-file-name newname)) 219 newname (expand-file-name newname))
@@ -214,199 +221,187 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
214 (let ((tmpfile (file-local-copy filename))) 221 (let ((tmpfile (file-local-copy filename)))
215 222
216 (if tmpfile 223 (if tmpfile
217 ;; remote filename 224 ;; Remote filename.
218 (rename-file tmpfile newname ok-if-already-exists) 225 (rename-file tmpfile newname ok-if-already-exists)
219 226
220 ;; remote newname 227 ;; Remote newname.
221 (when (file-directory-p newname) 228 (when (file-directory-p newname)
222 (setq newname (expand-file-name 229 (setq newname (expand-file-name
223 (file-name-nondirectory filename) newname))) 230 (file-name-nondirectory filename) newname)))
224 (when (and (not ok-if-already-exists)
225 (file-exists-p newname))
226 (error "copy-file: file %s already exists" newname))
227 231
228 (with-parsed-tramp-file-name newname nil 232 (with-parsed-tramp-file-name newname nil
229 (save-excursion 233 (when (and (not ok-if-already-exists)
230 (let ((share (tramp-smb-get-share localname)) 234 (file-exists-p newname))
231 (file (tramp-smb-get-localname localname t))) 235 (tramp-error v 'file-already-exists newname))
232 (unless share 236
233 (error "Target `%s' must contain a share name" filename)) 237 ;; We must also flush the cache of the directory, because
234 (tramp-smb-maybe-open-connection user host share) 238 ;; file-attributes reads the values from there.
235 (tramp-message-for-buffer 239 (tramp-flush-file-property v (file-name-directory localname))
236 nil tramp-smb-method user host 240 (tramp-flush-file-property v localname)
237 5 "Copying file %s to file %s..." filename newname) 241 (let ((share (tramp-smb-get-share localname))
238 (if (tramp-smb-send-command 242 (file (tramp-smb-get-localname localname t)))
239 user host (format "put %s \"%s\"" filename file)) 243 (unless share
240 (tramp-message-for-buffer 244 (tramp-error
241 nil tramp-smb-method user host 245 v 'file-error "Target `%s' must contain a share name" newname))
242 5 "Copying file %s to file %s...done" filename newname) 246 (tramp-message v 0 "Copying file %s to file %s..." filename newname)
243 (error "Cannot copy `%s'" filename)))))))) 247 (if (tramp-smb-send-command
248 v (format "put %s \"%s\"" filename file))
249 (tramp-message
250 v 0 "Copying file %s to file %s...done" filename newname)
251 (tramp-error v 'file-error "Cannot copy `%s'" filename)))))))
244 252
245(defun tramp-smb-handle-delete-directory (directory) 253(defun tramp-smb-handle-delete-directory (directory)
246 "Like `delete-directory' for tramp files." 254 "Like `delete-directory' for Tramp files."
247 (setq directory (directory-file-name (expand-file-name directory))) 255 (setq directory (directory-file-name (expand-file-name directory)))
248 (when (file-exists-p directory) 256 (when (file-exists-p directory)
249 (with-parsed-tramp-file-name directory nil 257 (with-parsed-tramp-file-name directory nil
250 (save-excursion 258 ;; We must also flush the cache of the directory, because
251 (let ((share (tramp-smb-get-share localname)) 259 ;; file-attributes reads the values from there.
252 (dir (tramp-smb-get-localname (file-name-directory localname) t)) 260 (tramp-flush-file-property v (file-name-directory localname))
253 (file (file-name-nondirectory localname))) 261 (tramp-flush-directory-property v localname)
254 (tramp-smb-maybe-open-connection user host share) 262 (let ((dir (tramp-smb-get-localname (file-name-directory localname) t))
255 (if (and 263 (file (file-name-nondirectory localname)))
256 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) 264 (unwind-protect
257 (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) 265 (unless (and
258 ;; Go Home 266 (tramp-smb-send-command v (format "cd \"%s\"" dir))
259 (tramp-smb-send-command user host (format "cd \\")) 267 (tramp-smb-send-command v (format "rmdir \"%s\"" file)))
260 ;; Error 268 ;; Error
261 (tramp-smb-send-command user host (format "cd \\")) 269 (with-current-buffer (tramp-get-connection-buffer v)
262 (error "Cannot delete directory `%s'" directory))))))) 270 (goto-char (point-min))
271 (search-forward-regexp tramp-smb-errors nil t)
272 (tramp-error
273 v 'file-error "%s `%s'" (match-string 0) directory)))
274 ;; Always go home
275 (tramp-smb-send-command v (format "cd \\")))))))
263 276
264(defun tramp-smb-handle-delete-file (filename) 277(defun tramp-smb-handle-delete-file (filename)
265 "Like `delete-file' for tramp files." 278 "Like `delete-file' for Tramp files."
266 (setq filename (expand-file-name filename)) 279 (setq filename (expand-file-name filename))
267 (when (file-exists-p filename) 280 (when (file-exists-p filename)
268 (with-parsed-tramp-file-name filename nil 281 (with-parsed-tramp-file-name filename nil
269 (save-excursion 282 ;; We must also flush the cache of the directory, because
270 (let ((share (tramp-smb-get-share localname)) 283 ;; file-attributes reads the values from there.
271 (dir (tramp-smb-get-localname (file-name-directory localname) t)) 284 (tramp-flush-file-property v (file-name-directory localname))
272 (file (file-name-nondirectory localname))) 285 (tramp-flush-file-property v localname)
273 (tramp-smb-maybe-open-connection user host share) 286 (let ((dir (tramp-smb-get-localname (file-name-directory localname) t))
274 (if (and 287 (file (file-name-nondirectory localname)))
275 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) 288 (unwind-protect
276 (tramp-smb-send-command user host (format "rm \"%s\"" file))) 289 (unless (and
277 ;; Go Home 290 (tramp-smb-send-command v (format "cd \"%s\"" dir))
278 (tramp-smb-send-command user host (format "cd \\")) 291 (tramp-smb-send-command v (format "rm \"%s\"" file)))
279 ;; Error 292 ;; Error
280 (tramp-smb-send-command user host (format "cd \\")) 293 (with-current-buffer (tramp-get-connection-buffer v)
281 (error "Cannot delete file `%s'" filename))))))) 294 (goto-char (point-min))
295 (search-forward-regexp tramp-smb-errors nil t)
296 (tramp-error
297 v 'file-error "%s `%s'" (match-string 0) filename)))
298 ;; Always go home
299 (tramp-smb-send-command v (format "cd \\")))))))
282 300
283(defun tramp-smb-handle-directory-files 301(defun tramp-smb-handle-directory-files
284 (directory &optional full match nosort) 302 (directory &optional full match nosort)
285 "Like `directory-files' for tramp files." 303 "Like `directory-files' for Tramp files."
286 (setq directory (directory-file-name (expand-file-name directory))) 304 (let ((result (mapcar 'directory-file-name
287 (with-parsed-tramp-file-name directory nil 305 (file-name-all-completions "" directory))))
288 (save-excursion 306 ;; Discriminate with regexp
289 (let* ((share (tramp-smb-get-share localname)) 307 (when match
290 (file (tramp-smb-get-localname localname nil)) 308 (setq result
291 (entries (tramp-smb-get-file-entries user host share file))) 309 (delete nil
292 ;; Just the file names are needed 310 (mapcar (lambda (x) (when (string-match match x) x))
293 (setq entries (mapcar 'car entries)) 311 result))))
294 ;; Discriminate with regexp 312 ;; Append directory
295 (when match 313 (when full
296 (setq entries 314 (setq result
297 (delete nil 315 (mapcar
298 (mapcar (lambda (x) (when (string-match match x) x)) 316 (lambda (x) (expand-file-name x directory))
299 entries)))) 317 result)))
300 ;; Make absolute localnames if necessary 318 ;; Sort them if necessary
301 (when full 319 (unless nosort (setq result (sort result 'string-lessp)))
302 (setq entries 320 ;; That's it
303 (mapcar (lambda (x) 321 result))
304 (concat (file-name-as-directory directory) x))
305 entries)))
306 ;; Sort them if necessary
307 (unless nosort (setq entries (sort entries 'string-lessp)))
308 ;; That's it
309 entries))))
310 322
311(defun tramp-smb-handle-directory-files-and-attributes 323(defun tramp-smb-handle-directory-files-and-attributes
312 (directory &optional full match nosort id-format) 324 (directory &optional full match nosort id-format)
313 "Like `directory-files-and-attributes' for tramp files." 325 "Like `directory-files-and-attributes' for Tramp files."
314 (mapcar 326 (mapcar
315 (lambda (x) 327 (lambda (x)
316 ;; We cannot call `file-attributes' for backward compatibility reasons. 328 ;; We cannot call `file-attributes' for backward compatibility reasons.
317 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. 329 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
318 (cons x (tramp-smb-handle-file-attributes 330 (cons x (tramp-smb-handle-file-attributes
319 (if full x (concat (file-name-as-directory directory) x)) id-format))) 331 (if full x (expand-file-name x directory)) id-format)))
320 (directory-files directory full match nosort))) 332 (directory-files directory full match nosort)))
321 333
322(defun tramp-smb-handle-file-attributes (filename &optional id-format) 334(defun tramp-smb-handle-file-attributes (filename &optional id-format)
323 "Like `file-attributes' for tramp files." 335 "Like `file-attributes' for Tramp files."
336 ;; Reading just the filename entry via "dir localname" is not
337 ;; possible, because when filename is a directory, some smbclient
338 ;; versions return the content of the directory, and other versions
339 ;; don't. Therefore, the whole content of the upper directory is
340 ;; retrieved, and the entry of the filename is extracted from.
324 (with-parsed-tramp-file-name filename nil 341 (with-parsed-tramp-file-name filename nil
325 (save-excursion 342 (with-file-property v localname (format "file-attributes-%s" id-format)
326 (let* ((share (tramp-smb-get-share localname)) 343 (let* ((entries (tramp-smb-get-file-entries
327 (file (tramp-smb-get-localname localname nil)) 344 (file-name-directory filename)))
328 (entries (tramp-smb-get-file-entries user host share file))
329 (entry (and entries 345 (entry (and entries
330 (assoc (file-name-nondirectory file) entries))) 346 (assoc (file-name-nondirectory filename) entries)))
331 (uid (if (and id-format (equal id-format 'string)) "nobody" -1)) 347 (uid (if (and id-format (equal id-format 'string)) "nobody" -1))
332 (gid (if (and id-format (equal id-format 'string)) "nogroup" -1)) 348 (gid (if (and id-format (equal id-format 'string)) "nogroup" -1))
333 (inode (tramp-smb-get-inode share file)) 349 (inode (tramp-get-inode filename))
334 (device (tramp-get-device nil tramp-smb-method user host))) 350 (device (tramp-get-device v)))
335 351
336 ; check result 352 ;; Check result.
337 (when entry 353 (when entry
338 (list (and (string-match "d" (nth 1 entry)) 354 (list (and (string-match "d" (nth 1 entry))
339 t) ;0 file type 355 t) ;0 file type
340 -1 ;1 link count 356 -1 ;1 link count
341 uid ;2 uid 357 uid ;2 uid
342 gid ;3 gid 358 gid ;3 gid
343 '(0 0) ;4 atime 359 '(0 0) ;4 atime
344 (nth 3 entry) ;5 mtime 360 (nth 3 entry) ;5 mtime
345 '(0 0) ;6 ctime 361 '(0 0) ;6 ctime
346 (nth 2 entry) ;7 size 362 (nth 2 entry) ;7 size
347 (nth 1 entry) ;8 mode 363 (nth 1 entry) ;8 mode
348 nil ;9 gid weird 364 nil ;9 gid weird
349 inode ;10 inode number 365 inode ;10 inode number
350 device)))))) ;11 file system number 366 device)))))) ;11 file system number
351 367
352(defun tramp-smb-handle-file-directory-p (filename) 368(defun tramp-smb-handle-file-directory-p (filename)
353 "Like `file-directory-p' for tramp files." 369 "Like `file-directory-p' for Tramp files."
354 (with-parsed-tramp-file-name filename nil 370 (and (file-exists-p filename)
355 (save-excursion 371 (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
356 (let* ((share (tramp-smb-get-share localname))
357 (file (tramp-smb-get-localname localname nil))
358 (entries (tramp-smb-get-file-entries user host share file))
359 (entry (and entries
360 (assoc (file-name-nondirectory file) entries))))
361 (and entry
362 (string-match "d" (nth 1 entry))
363 t)))))
364 372
365(defun tramp-smb-handle-file-exists-p (filename) 373(defun tramp-smb-handle-file-exists-p (filename)
366 "Like `file-exists-p' for tramp files." 374 "Like `file-exists-p' for Tramp files."
367 (with-parsed-tramp-file-name filename nil 375 (not (null (file-attributes filename))))
368 (save-excursion
369 (let* ((share (tramp-smb-get-share localname))
370 (file (tramp-smb-get-localname localname nil))
371 (entries (tramp-smb-get-file-entries user host share file)))
372 (and entries
373 (member (file-name-nondirectory file) (mapcar 'car entries))
374 t)))))
375 376
376(defun tramp-smb-handle-file-local-copy (filename) 377(defun tramp-smb-handle-file-local-copy (filename)
377 "Like `file-local-copy' for tramp files." 378 "Like `file-local-copy' for Tramp files."
378 (with-parsed-tramp-file-name filename nil 379 (with-parsed-tramp-file-name filename nil
379 (save-excursion 380 (let ((file (tramp-smb-get-localname localname t))
380 (let ((share (tramp-smb-get-share localname)) 381 (tmpfil (tramp-make-temp-file filename)))
381 (file (tramp-smb-get-localname localname t)) 382 (unless (file-exists-p filename)
382 (tmpfil (tramp-make-temp-file filename))) 383 (tramp-error
383 (unless (file-exists-p filename) 384 v 'file-error
384 (error "Cannot make local copy of non-existing file `%s'" filename)) 385 "Cannot make local copy of non-existing file `%s'" filename))
385 (tramp-message-for-buffer 386 (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfil)
386 nil tramp-smb-method user host 387 (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfil))
387 5 "Fetching %s to tmp file %s..." filename tmpfil) 388 (tramp-message
388 (tramp-smb-maybe-open-connection user host share) 389 v 4 "Fetching %s to tmp file %s...done" filename tmpfil)
389 (if (tramp-smb-send-command 390 (tramp-error
390 user host (format "get \"%s\" %s" file tmpfil)) 391 v 'file-error
391 (tramp-message-for-buffer 392 "Cannot make local copy of file `%s'" filename))
392 nil tramp-smb-method user host 393 tmpfil)))
393 5 "Fetching %s to tmp file %s...done" filename tmpfil)
394 (error "Cannot make local copy of file `%s'" filename))
395 tmpfil))))
396 394
397;; This function should return "foo/" for directories and "bar" for 395;; This function should return "foo/" for directories and "bar" for
398;; files. 396;; files.
399(defun tramp-smb-handle-file-name-all-completions (filename directory) 397(defun tramp-smb-handle-file-name-all-completions (filename directory)
400 "Like `file-name-all-completions' for tramp files." 398 "Like `file-name-all-completions' for Tramp files."
401 (with-parsed-tramp-file-name directory nil 399 (all-completions
402 (save-match-data 400 filename
403 (save-excursion 401 (with-parsed-tramp-file-name directory nil
404 (let* ((share (tramp-smb-get-share localname)) 402 (with-file-property v localname "file-name-all-completions"
405 (file (tramp-smb-get-localname localname nil)) 403 (save-match-data
406 (entries (tramp-smb-get-file-entries user host share file))) 404 (let ((entries (tramp-smb-get-file-entries directory)))
407
408 (all-completions
409 filename
410 (mapcar 405 (mapcar
411 (lambda (x) 406 (lambda (x)
412 (list 407 (list
@@ -416,51 +411,59 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
416 entries))))))) 411 entries)))))))
417 412
418(defun tramp-smb-handle-file-newer-than-file-p (file1 file2) 413(defun tramp-smb-handle-file-newer-than-file-p (file1 file2)
419 "Like `file-newer-than-file-p' for tramp files." 414 "Like `file-newer-than-file-p' for Tramp files."
420 (cond 415 (cond
421 ((not (file-exists-p file1)) nil) 416 ((not (file-exists-p file1)) nil)
422 ((not (file-exists-p file2)) t) 417 ((not (file-exists-p file2)) t)
423 (t (tramp-smb-time-less-p (file-attributes file2) 418 (t (tramp-time-less-p (nth 5 (file-attributes file2))
424 (file-attributes file1))))) 419 (nth 5 (file-attributes file1))))))
425 420
426(defun tramp-smb-handle-file-writable-p (filename) 421(defun tramp-smb-handle-file-writable-p (filename)
427 "Like `file-writable-p' for tramp files." 422 "Like `file-writable-p' for Tramp files."
428 (if (not (file-exists-p filename)) 423 (if (file-exists-p filename)
429 (let ((dir (file-name-directory filename))) 424 (string-match "w" (or (nth 8 (file-attributes filename)) ""))
430 (and (file-exists-p dir) 425 (let ((dir (file-name-directory filename)))
431 (file-writable-p dir))) 426 (and (file-exists-p dir)
432 (with-parsed-tramp-file-name filename nil 427 (file-writable-p dir)))))
433 (save-excursion
434 (let* ((share (tramp-smb-get-share localname))
435 (file (tramp-smb-get-localname localname nil))
436 (entries (tramp-smb-get-file-entries user host share file))
437 (entry (and entries
438 (assoc (file-name-nondirectory file) entries))))
439 (and share entry
440 (string-match "w" (nth 1 entry))
441 t))))))
442 428
443(defun tramp-smb-handle-insert-directory 429(defun tramp-smb-handle-insert-directory
444 (filename switches &optional wildcard full-directory-p) 430 (filename switches &optional wildcard full-directory-p)
445 "Like `insert-directory' for tramp files. 431 "Like `insert-directory' for Tramp files."
446WILDCARD and FULL-DIRECTORY-P are not handled."
447 (setq filename (expand-file-name filename)) 432 (setq filename (expand-file-name filename))
448 (when (file-directory-p filename) 433 (when full-directory-p
449 ;; This check is a little bit strange, but in `dired-add-entry' 434 ;; Called from `dired-add-entry'.
450 ;; this function is called with a non-directory ...
451 (setq filename (file-name-as-directory filename))) 435 (setq filename (file-name-as-directory filename)))
452 (with-parsed-tramp-file-name filename nil 436 (with-parsed-tramp-file-name filename nil
437 (tramp-flush-file-property v (file-name-directory localname))
453 (save-match-data 438 (save-match-data
454 (let* ((share (tramp-smb-get-share localname)) 439 (let ((base (file-name-nondirectory filename))
455 (file (tramp-smb-get-localname localname nil)) 440 ;; We should not destroy the cache entry.
456 (entries (tramp-smb-get-file-entries user host share file))) 441 (entries (copy-sequence
457 442 (tramp-smb-get-file-entries
458 ;; Delete dummy "" entry, useless entries 443 (file-name-directory filename)))))
444
445 (when wildcard
446 (string-match "\\." base)
447 (setq base (replace-match "\\\\." nil nil base))
448 (string-match "\\*" base)
449 (setq base (replace-match ".*" nil nil base))
450 (string-match "\\?" base)
451 (setq base (replace-match ".?" nil nil base)))
452
453 ;; Filter entries.
459 (setq entries 454 (setq entries
460 (if (file-directory-p filename) 455 (delq
461 (delq (assoc "" entries) entries) 456 nil
462 ;; We just need the only and only entry FILENAME. 457 (if (or wildcard (zerop (length base)))
463 (list (assoc (file-name-nondirectory filename) entries)))) 458 ;; Check for matching entries.
459 (mapcar
460 (lambda (x)
461 (when (string-match
462 (format "^%s" base) (nth 0 x))
463 x))
464 entries)
465 ;; We just need the only and only entry FILENAME.
466 (list (assoc base entries)))))
464 467
465 ;; Sort entries 468 ;; Sort entries
466 (setq entries 469 (setq entries
@@ -468,37 +471,38 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
468 entries 471 entries
469 (lambda (x y) 472 (lambda (x y)
470 (if (string-match "t" switches) 473 (if (string-match "t" switches)
471 ; sort by date 474 ;; Sort by date.
472 (tramp-smb-time-less-p (nth 3 y) (nth 3 x)) 475 (tramp-time-less-p (nth 3 y) (nth 3 x))
473 ; sort by name 476 ;; Sort by name.
474 (string-lessp (nth 0 x) (nth 0 y)))))) 477 (string-lessp (nth 0 x) (nth 0 y))))))
475 478
476 ;; Print entries 479 ;; Print entries.
477 (mapcar 480 (mapcar
478 (lambda (x) 481 (lambda (x)
479 (insert 482 (when (not (zerop (length (nth 0 x))))
480 (format 483 (insert
481 "%10s %3d %-8s %-8s %8s %s %s\n" 484 (format
482 (nth 1 x) ; mode 485 "%10s %3d %-8s %-8s %8s %s %s\n"
483 1 "nobody" "nogroup" 486 (nth 1 x) ; mode
484 (nth 2 x) ; size 487 1 "nobody" "nogroup"
485 (format-time-string 488 (nth 2 x) ; size
486 (if (tramp-smb-time-less-p 489 (format-time-string
487 (tramp-smb-time-subtract (current-time) (nth 3 x)) 490 (if (tramp-time-less-p
488 tramp-smb-half-a-year) 491 (tramp-time-subtract (current-time) (nth 3 x))
489 "%b %e %R" 492 tramp-half-a-year)
490 "%b %e %Y") 493 "%b %e %R"
491 (nth 3 x)) ; date 494 "%b %e %Y")
492 (nth 0 x))) ; file name 495 (nth 3 x)) ; date
493 (forward-line) 496 (nth 0 x))) ; file name
494 (beginning-of-line)) 497 (forward-line)
495 entries))))) 498 (beginning-of-line)))
499 entries)))))
496 500
497(defun tramp-smb-handle-make-directory (dir &optional parents) 501(defun tramp-smb-handle-make-directory (dir &optional parents)
498 "Like `make-directory' for tramp files." 502 "Like `make-directory' for Tramp files."
499 (setq dir (directory-file-name (expand-file-name dir))) 503 (setq dir (directory-file-name (expand-file-name dir)))
500 (unless (file-name-absolute-p dir) 504 (unless (file-name-absolute-p dir)
501 (setq dir (concat default-directory dir))) 505 (setq dir (expand-file-name dir default-directory)))
502 (with-parsed-tramp-file-name dir nil 506 (with-parsed-tramp-file-name dir nil
503 (save-match-data 507 (save-match-data
504 (let* ((share (tramp-smb-get-share localname)) 508 (let* ((share (tramp-smb-get-share localname))
@@ -510,26 +514,28 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
510 (when (file-directory-p ldir) 514 (when (file-directory-p ldir)
511 (make-directory-internal dir)) 515 (make-directory-internal dir))
512 (unless (file-directory-p dir) 516 (unless (file-directory-p dir)
513 (error "Couldn't make directory %s" dir)))))) 517 (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
514 518
515(defun tramp-smb-handle-make-directory-internal (directory) 519(defun tramp-smb-handle-make-directory-internal (directory)
516 "Like `make-directory-internal' for tramp files." 520 "Like `make-directory-internal' for Tramp files."
517 (setq directory (directory-file-name (expand-file-name directory))) 521 (setq directory (directory-file-name (expand-file-name directory)))
518 (unless (file-name-absolute-p directory) 522 (unless (file-name-absolute-p directory)
519 (setq directory (concat default-directory directory))) 523 (setq directory (expand-file-name directory default-directory)))
520 (with-parsed-tramp-file-name directory nil 524 (with-parsed-tramp-file-name directory nil
521 (save-match-data 525 (save-match-data
522 (let* ((share (tramp-smb-get-share localname)) 526 (let* ((file (tramp-smb-get-localname localname t)))
523 (file (tramp-smb-get-localname localname nil)))
524 (when (file-directory-p (file-name-directory directory)) 527 (when (file-directory-p (file-name-directory directory))
525 (tramp-smb-maybe-open-connection user host share) 528 (tramp-smb-send-command v (format "mkdir \"%s\"" file))
526 (tramp-smb-send-command user host (format "mkdir \"%s\"" file))) 529 ;; We must also flush the cache of the directory, because
530 ;; file-attributes reads the values from there.
531 (tramp-flush-file-property v (file-name-directory localname)))
527 (unless (file-directory-p directory) 532 (unless (file-directory-p directory)
528 (error "Couldn't make directory %s" directory)))))) 533 (tramp-error
534 v 'file-error "Couldn't make directory %s" directory))))))
529 535
530(defun tramp-smb-handle-rename-file 536(defun tramp-smb-handle-rename-file
531 (filename newname &optional ok-if-already-exists) 537 (filename newname &optional ok-if-already-exists)
532 "Like `rename-file' for tramp files." 538 "Like `rename-file' for Tramp files."
533 (setq filename (expand-file-name filename) 539 (setq filename (expand-file-name filename)
534 newname (expand-file-name newname)) 540 newname (expand-file-name newname))
535 541
@@ -543,29 +549,26 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
543 (when (file-directory-p newname) 549 (when (file-directory-p newname)
544 (setq newname (expand-file-name 550 (setq newname (expand-file-name
545 (file-name-nondirectory filename) newname))) 551 (file-name-nondirectory filename) newname)))
546 (when (and (not ok-if-already-exists)
547 (file-exists-p newname))
548 (error "rename-file: file %s already exists" newname))
549 552
550 (with-parsed-tramp-file-name newname nil 553 (with-parsed-tramp-file-name newname nil
551 (save-excursion 554 (when (and (not ok-if-already-exists)
552 (let ((share (tramp-smb-get-share localname)) 555 (file-exists-p newname))
553 (file (tramp-smb-get-localname localname t))) 556 (tramp-error v 'file-already-exists newname))
554 (tramp-smb-maybe-open-connection user host share) 557 ;; We must also flush the cache of the directory, because
555 (tramp-message-for-buffer 558 ;; file-attributes reads the values from there.
556 nil tramp-smb-method user host 559 (tramp-flush-file-property v (file-name-directory localname))
557 5 "Copying file %s to file %s..." filename newname) 560 (tramp-flush-file-property v localname)
558 (if (tramp-smb-send-command 561 (let ((file (tramp-smb-get-localname localname t)))
559 user host (format "put %s \"%s\"" filename file)) 562 (tramp-message v 0 "Copying file %s to file %s..." filename newname)
560 (tramp-message-for-buffer 563 (if (tramp-smb-send-command v (format "put %s \"%s\"" filename file))
561 nil tramp-smb-method user host 564 (tramp-message
562 5 "Copying file %s to file %s...done" filename newname) 565 v 0 "Copying file %s to file %s...done" filename newname)
563 (error "Cannot rename `%s'" filename))))))) 566 (tramp-error v 'file-error "Cannot rename `%s'" filename))))))
564 567
565 (delete-file filename)) 568 (delete-file filename))
566 569
567(defun tramp-smb-handle-substitute-in-file-name (filename) 570(defun tramp-smb-handle-substitute-in-file-name (filename)
568 "Like `handle-substitute-in-file-name' for tramp files. 571 "Like `handle-substitute-in-file-name' for Tramp files.
569Catches errors for shares like \"C$/\", which are common in Microsoft Windows." 572Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
570 (condition-case nil 573 (condition-case nil
571 (tramp-run-real-handler 'substitute-in-file-name (list filename)) 574 (tramp-run-real-handler 'substitute-in-file-name (list filename))
@@ -573,50 +576,49 @@ Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
573 576
574(defun tramp-smb-handle-write-region 577(defun tramp-smb-handle-write-region
575 (start end filename &optional append visit lockname confirm) 578 (start end filename &optional append visit lockname confirm)
576 "Like `write-region' for tramp files." 579 "Like `write-region' for Tramp files."
577 (unless (eq append nil)
578 (error "Cannot append to file using tramp (`%s')" filename))
579 (setq filename (expand-file-name filename)) 580 (setq filename (expand-file-name filename))
580 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
581 (when (and (not (featurep 'xemacs))
582 confirm (file-exists-p filename))
583 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
584 filename))
585 (error "File not overwritten")))
586 (with-parsed-tramp-file-name filename nil 581 (with-parsed-tramp-file-name filename nil
587 (save-excursion 582 (unless (eq append nil)
588 (let ((share (tramp-smb-get-share localname)) 583 (tramp-error
589 (file (tramp-smb-get-localname localname t)) 584 v 'file-error "Cannot append to file using tramp (`%s')" filename))
590 (curbuf (current-buffer)) 585 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
591 tmpfil) 586 (when (and (not (featurep 'xemacs))
592 ;; Write region into a tmp file. 587 confirm (file-exists-p filename))
593 (setq tmpfil (tramp-make-temp-file filename)) 588 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
594 ;; We say `no-message' here because we don't want the visited file 589 filename))
595 ;; modtime data to be clobbered from the temp file. We call 590 (tramp-error v 'file-error "File not overwritten")))
596 ;; `set-visited-file-modtime' ourselves later on. 591 ;; We must also flush the cache of the directory, because
597 (tramp-run-real-handler 592 ;; file-attributes reads the values from there.
598 'write-region 593 (tramp-flush-file-property v (file-name-directory localname))
599 (if confirm ; don't pass this arg unless defined for backward compat. 594 (tramp-flush-file-property v localname)
600 (list start end tmpfil append 'no-message lockname confirm) 595 (let ((file (tramp-smb-get-localname localname t))
601 (list start end tmpfil append 'no-message lockname))) 596 (curbuf (current-buffer))
602 597 tmpfil)
603 (tramp-smb-maybe-open-connection user host share) 598 ;; Write region into a tmp file.
604 (tramp-message-for-buffer 599 (setq tmpfil (tramp-make-temp-file filename))
605 nil tramp-smb-method user host 600 ;; We say `no-message' here because we don't want the visited file
606 5 "Writing tmp file %s to file %s..." tmpfil filename) 601 ;; modtime data to be clobbered from the temp file. We call
607 (if (tramp-smb-send-command 602 ;; `set-visited-file-modtime' ourselves later on.
608 user host (format "put %s \"%s\"" tmpfil file)) 603 (tramp-run-real-handler
609 (tramp-message-for-buffer 604 'write-region
610 nil tramp-smb-method user host 605 (if confirm ; don't pass this arg unless defined for backward compat.
611 5 "Writing tmp file %s to file %s...done" tmpfil filename) 606 (list start end tmpfil append 'no-message lockname confirm)
612 (error "Cannot write `%s'" filename)) 607 (list start end tmpfil append 'no-message lockname)))
613 608
614 (delete-file tmpfil) 609 (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfil filename)
615 (unless (equal curbuf (current-buffer)) 610 (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfil file))
616 (error "Buffer has changed from `%s' to `%s'" 611 (tramp-message
617 curbuf (current-buffer))) 612 v 5 "Writing tmp file %s to file %s...done" tmpfil filename)
618 (when (eq visit t) 613 (tramp-error v 'file-error "Cannot write `%s'" filename))
619 (set-visited-file-modtime)))))) 614
615 (delete-file tmpfil)
616 (unless (equal curbuf (current-buffer))
617 (tramp-error
618 v 'file-error
619 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
620 (when (eq visit t)
621 (set-visited-file-modtime)))))
620 622
621 623
622;; Internal file name functions 624;; Internal file name functions
@@ -652,51 +654,53 @@ If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
652 654
653;; Share names of a host are cached. It is very unlikely that the 655;; Share names of a host are cached. It is very unlikely that the
654;; shares do change during connection. 656;; shares do change during connection.
655(defun tramp-smb-get-file-entries (user host share localname) 657(defun tramp-smb-get-file-entries (directory)
656 "Read entries which match LOCALNAME. 658 "Read entries which match DIRECTORY.
657Either the shares are listed, or the `dir' command is executed. 659Either the shares are listed, or the `dir' command is executed.
658Only entries matching the localname are returned.
659Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." 660Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
660 (save-excursion 661 (with-parsed-tramp-file-name directory nil
661 (save-match-data 662 (setq localname (or localname "/"))
662 (let ((base (or (and (> (length localname) 0) 663 (with-file-property v localname "file-entries"
663 (string-match "\\([^/]+\\)$" localname) 664 (with-current-buffer (tramp-get-buffer v)
664 (regexp-quote (match-string 1 localname))) 665 (let* ((share (tramp-smb-get-share localname))
665 "")) 666 (file (tramp-smb-get-localname localname nil))
666 res entry) 667 (cache (tramp-get-connection-property v "share-cache" nil))
667 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 668 res entry)
668 (if (and (not share) tramp-smb-share-cache) 669
669 ;; Return cached shares 670 (if (and (not share) cache)
670 (setq res tramp-smb-share-cache) 671 ;; Return cached shares
671 ;; Read entries 672 (setq res cache)
672 (tramp-smb-maybe-open-connection user host share) 673
673 (when share 674 ;; Read entries
674 (tramp-smb-send-command 675 (setq file (file-name-as-directory file))
675 user host 676 (when (string-match "^\\./" file)
676 (format "dir %s" 677 (setq file (substring file 1)))
677 (if (zerop (length localname)) "" (concat "\"" localname "*\""))))) 678 (if share
678 (goto-char (point-min)) 679 (tramp-smb-send-command v (format "dir \"%s*\"" file))
679 ;; Loop the listing 680 ;; `tramp-smb-maybe-open-connection' lists also the share names
680 (unless (re-search-forward tramp-smb-errors nil t) 681 (tramp-smb-maybe-open-connection v))
681 (while (not (eobp)) 682
682 (setq entry (tramp-smb-read-file-entry share)) 683 ;; Loop the listing
683 (forward-line) 684 (goto-char (point-min))
684 (when entry (add-to-list 'res entry)))) 685 (unless (re-search-forward tramp-smb-errors nil t)
685 (unless share 686 (while (not (eobp))
687 (setq entry (tramp-smb-read-file-entry share))
688 (forward-line)
689 (when entry (add-to-list 'res entry))))
690
686 ;; Cache share entries 691 ;; Cache share entries
687 (setq tramp-smb-share-cache res))) 692 (unless share
693 (tramp-set-connection-property v "share-cache" res)))
688 694
689 ;; Add directory itself 695 ;; Add directory itself
690 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0))) 696 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
691 697
692 ;; There's a very strange error (debugged with XEmacs 21.4.14) 698 ;; There's a very strange error (debugged with XEmacs 21.4.14)
693 ;; If there's no short delay, it returns nil. No idea about 699 ;; If there's no short delay, it returns nil. No idea about.
694 (when (featurep 'xemacs) (sleep-for 0.01)) 700 (when (featurep 'xemacs) (sleep-for 0.01))
695 701
696 ;; Check for matching entries 702 ;; Return entries
697 (delq nil (mapcar 703 (delq nil res))))))
698 (lambda (x) (and (string-match base (nth 0 x)) x))
699 res))))))
700 704
701;; Return either a share name (if SHARE is nil), or a file name 705;; Return either a share name (if SHARE is nil), or a file name
702;; 706;;
@@ -721,7 +725,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
721;; \s- - space delimeter 725;; \s- - space delimeter
722;; \w\{3,3\} - month 726;; \w\{3,3\} - month
723;; \s- - space delimeter 727;; \s- - space delimeter
724;; [ 19][0-9] - day 728;; [ 12][0-9] - day
725;; \s- - space delimeter 729;; \s- - space delimeter
726;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time 730;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
727;; \s- - space delimeter 731;; \s- - space delimeter
@@ -756,18 +760,20 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
756 "Parse entry in SMB output buffer. 760 "Parse entry in SMB output buffer.
757If SHARE is result, entries are of type dir. Otherwise, shares are listed. 761If SHARE is result, entries are of type dir. Otherwise, shares are listed.
758Result is the list (LOCALNAME MODE SIZE MTIME)." 762Result is the list (LOCALNAME MODE SIZE MTIME)."
759 (let ((line (buffer-substring (point) (tramp-point-at-eol))) 763;; We are called from `tramp-smb-get-file-entries', which sets the
764;; current buffer.
765 (let ((line (buffer-substring (point) (tramp-line-end-position)))
760 localname mode size month day hour min sec year mtime) 766 localname mode size month day hour min sec year mtime)
761 767
762 (if (not share) 768 (if (not share)
763 769
764 ; Read share entries 770 ;; Read share entries.
765 (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line) 771 (when (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+Disk" line)
766 (setq localname (match-string 1 line) 772 (setq localname (match-string 1 line)
767 mode "dr-xr-xr-x" 773 mode "dr-xr-xr-x"
768 size 0)) 774 size 0))
769 775
770 ; Real listing 776 ;; Real listing.
771 (block nil 777 (block nil
772 778
773 ;; year 779 ;; year
@@ -833,219 +839,186 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
833 (if (and sec min hour day month year) 839 (if (and sec min hour day month year)
834 (encode-time 840 (encode-time
835 sec min hour day 841 sec min hour day
836 (cdr (assoc (downcase month) tramp-smb-parse-time-months)) 842 (cdr (assoc (downcase month) tramp-parse-time-months))
837 year) 843 year)
838 '(0 0))) 844 '(0 0)))
839 (list localname mode size mtime)))) 845 (list localname mode size mtime))))
840 846
841;; Inodes don't exist for SMB files. Therefore we must generate virtual ones.
842;; Used in `find-buffer-visiting'.
843;; The method applied might be not so efficient (Ange-FTP uses hashes). But
844;; performance isn't the major issue given that file transfer will take time.
845
846(defun tramp-smb-get-inode (share file)
847 "Returns the virtual inode number.
848If it doesn't exist, generate a new one."
849 (let ((string (concat share "/" (directory-file-name file))))
850 (unless (assoc string tramp-smb-inodes)
851 (add-to-list 'tramp-smb-inodes
852 (list string (length tramp-smb-inodes))))
853 (nth 1 (assoc string tramp-smb-inodes))))
854
855 847
856;; Connection functions 848;; Connection functions
857 849
858(defun tramp-smb-send-command (user host command) 850(defun tramp-smb-send-command (vec command)
859 "Send the COMMAND to USER at HOST (logged into an SMB session). 851 "Send the COMMAND to connection VEC.
860Erases temporary buffer before sending the command. Returns nil if 852Returns nil if there has been an error message from smbclient."
861there has been an error message from smbclient." 853 (tramp-smb-maybe-open-connection vec)
862 (save-excursion 854 (tramp-message vec 6 "%s" command)
863 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 855 (tramp-send-string vec command)
864 (erase-buffer) 856 (tramp-smb-wait-for-output vec))
865 (tramp-send-command nil tramp-smb-method user host command nil t) 857
866 (tramp-smb-wait-for-output user host))) 858(defun tramp-smb-maybe-open-connection (vec)
867 859 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
868(defun tramp-smb-maybe-open-connection (user host share)
869 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
870Does not do anything if a connection is already open, but re-opens the 860Does not do anything if a connection is already open, but re-opens the
871connection if a previous connection has died for some reason." 861connection if a previous connection has died for some reason."
872 (let ((process-connection-type tramp-process-connection-type) 862 (let* ((share (tramp-smb-get-share (tramp-file-name-localname vec)))
873 (p (get-buffer-process 863 (buf (tramp-get-buffer vec))
874 (tramp-get-buffer nil tramp-smb-method user host)))) 864 (p (get-buffer-process buf)))
875 (save-excursion
876 (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
877 ;; Check whether it is still the same share
878 (unless (and p (processp p) (string-equal tramp-smb-share share))
879 (when (and p (processp p))
880 (delete-process p)
881 (setq p nil)))
882 ;; If too much time has passed since last command was sent, look
883 ;; whether process is still alive. If it isn't, kill it.
884 (when (and tramp-last-cmd-time
885 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60)
886 p (processp p) (memq (process-status p) '(run open)))
887 (unless (and p (processp p) (memq (process-status p) '(run open)))
888 (delete-process p)
889 (setq p nil))))
890 (unless (and p (processp p) (memq (process-status p) '(run open)))
891 (when (and p (processp p))
892 (delete-process p))
893 (tramp-smb-open-connection user host share))))
894
895(defun tramp-smb-open-connection (user host share)
896 "Open a connection using `tramp-smb-program'.
897This starts the command `smbclient //HOST/SHARE -U USER', then waits
898for a remote password prompt. It queries the user for the password,
899then sends the password to the remote host.
900
901Domain names in USER and port numbers in HOST are acknowledged."
902
903 (when (and (fboundp 'executable-find)
904 (not (funcall 'executable-find tramp-smb-program)))
905 (error "Cannot find command %s in %s" tramp-smb-program exec-path))
906 865
907 (save-match-data 866 ;; If too much time has passed since last command was sent, look
908 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) 867 ;; whether has been an error message; maybe due to connection timeout.
909 (real-user user) 868 (with-current-buffer buf
910 (real-host host) 869 (goto-char (point-min))
911 domain port args) 870 (when (and (> (tramp-time-diff
912 871 (current-time)
913 ; Check for domain ("user%domain") and port ("host#port") 872 (tramp-get-connection-property
914 (when (and user (string-match "\\(.+\\)%\\(.+\\)" user)) 873 p "last-cmd-time" '(0 0 0)))
915 (setq real-user (or (match-string 1 user) user) 874 60)
916 domain (match-string 2 user))) 875 p (processp p) (memq (process-status p) '(run open))
917 876 (re-search-forward tramp-smb-errors nil t))
918 (when (and host (string-match "\\(.+\\)#\\(.+\\)" host)) 877 (delete-process p)
919 (setq real-host (or (match-string 1 host) host) 878 (setq p nil)))
920 port (match-string 2 host))) 879
921 880 ;; Check whether it is still the same share.
922 (if share 881 (unless
923 (setq args (list (concat "//" real-host "/" share))) 882 (and p (processp p) (memq (process-status p) '(run open))
924 (setq args (list "-L" real-host ))) 883 (string-equal
925 884 share
926 (if real-user 885 (tramp-get-connection-property p "smb-share" "")))
927 (setq args (append args (list "-U" real-user))) 886
928 (setq args (append args (list "-N")))) 887 (save-match-data
929 888 ;; There might be unread output from checking for share names.
930 (when domain (setq args (append args (list "-W" domain)))) 889 (when buf (with-current-buffer buf (erase-buffer)))
931 (when port (setq args (append args (list "-p" port)))) 890 (when (and p (processp p)) (delete-process p))
932 891
933 ; OK, let's go 892 (unless (let ((default-directory
934 (tramp-pre-connection nil tramp-smb-method user host tramp-chunksize) 893 (tramp-temporary-file-directory)))
935 (tramp-message 7 "Opening connection for //%s@%s/%s..." 894 (executable-find tramp-smb-program))
936 user host (or share "")) 895 (error "Cannot find command %s in %s" tramp-smb-program exec-path))
937 896
938 (let* ((default-directory (tramp-temporary-file-directory)) 897 (let* ((user (tramp-file-name-user vec))
939 ;; If we omit the conditional here, then we would use 898 (host (tramp-file-name-host vec))
940 ;; `undecided-dos' in some cases. With the conditional, 899 (real-user user)
941 ;; we use nil in these cases. Which one is right? 900 (real-host host)
942 (coding-system-for-read (unless (and (not (featurep 'xemacs)) 901 domain port args)
943 (> emacs-major-version 20)) 902
944 tramp-dos-coding-system)) 903 ;; Check for domain ("user%domain") and port ("host#port").
945 (p (apply #'start-process (buffer-name buffer) buffer 904 (when (and user (string-match "\\(.+\\)%\\(.+\\)" user))
946 tramp-smb-program args))) 905 (setq real-user (or (match-string 1 user) user)
947 906 domain (match-string 2 user)))
948 (tramp-message 9 "Started process %s" (process-command p)) 907
949 (tramp-set-process-query-on-exit-flag p nil) 908 (when (and host (string-match "\\(.+\\)#\\(.+\\)" host))
950 (set-buffer buffer) 909 (setq real-host (or (match-string 1 host) host)
951 (setq tramp-smb-share share) 910 port (match-string 2 host)))
952 911
953 ; send password 912 (if share
954 (when real-user 913 (setq args (list (concat "//" real-host "/" share)))
955 (let ((pw-prompt "Password:")) 914 (setq args (list "-L" real-host )))
956 (tramp-message 9 "Sending password") 915
957 (tramp-enter-password p pw-prompt user host))) 916 (if (not (zerop (length real-user)))
958 917 (setq args (append args (list "-U" real-user)))
959 (unless (tramp-smb-wait-for-output user host) 918 (setq args (append args (list "-N"))))
960 (tramp-clear-passwd user host) 919
961 (error "Cannot open connection //%s@%s/%s" 920 (when domain (setq args (append args (list "-W" domain))))
962 user host (or share ""))))))) 921 (when port (setq args (append args (list "-p" port))))
922 (setq args (append args (list "-s" "/dev/null")))
923
924 ;; OK, let's go.
925 (tramp-message
926 vec 3 "Opening connection for //%s%s/%s..."
927 (if (not (zerop (length user))) (concat user "@") "")
928 host (or share ""))
929
930 (let* ((coding-system-for-read nil)
931 (process-connection-type tramp-process-connection-type)
932 (p (let ((default-directory (tramp-temporary-file-directory)))
933 (apply #'start-process
934 (tramp-buffer-name vec) (tramp-get-buffer vec)
935 tramp-smb-program args))))
936
937 (tramp-message
938 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
939 (set-process-sentinel p 'tramp-flush-connection-property)
940 (tramp-set-process-query-on-exit-flag p nil)
941 (tramp-set-connection-property p "smb-share" share)
942
943 ;; Set variables for computing the prompt for reading password.
944 (setq tramp-current-method tramp-smb-method
945 tramp-current-user user
946 tramp-current-host host)
947
948 ;; Set chunksize. Otherwise, `tramp-send-string' might
949 ;; try it itself.
950 (tramp-set-connection-property p "chunksize" tramp-chunksize)
951
952 ;; Play login scenario.
953 (tramp-process-actions
954 p vec
955 (if share
956 tramp-smb-actions-with-share
957 tramp-smb-actions-without-share))
958
959 (tramp-message
960 vec 3 "Opening connection for //%s%s/%s...done"
961 (if (not (zerop (length user))) (concat user "@") "")
962 host (or share ""))))))))
963 963
964;; We don't use timeouts. If needed, the caller shall wrap around. 964;; We don't use timeouts. If needed, the caller shall wrap around.
965(defun tramp-smb-wait-for-output (user host) 965(defun tramp-smb-wait-for-output (vec)
966 "Wait for output from smbclient command. 966 "Wait for output from smbclient command.
967Returns nil if an error message has appeared." 967Returns nil if an error message has appeared."
968 (let ((proc (get-buffer-process (current-buffer))) 968 (with-current-buffer (tramp-get-buffer vec)
969 (found (progn (goto-char (point-min)) 969 (let ((p (get-buffer-process (current-buffer)))
970 (re-search-forward tramp-smb-prompt nil t))) 970 (found (progn (goto-char (point-min))
971 (err (progn (goto-char (point-min)) 971 (re-search-forward tramp-smb-prompt nil t)))
972 (re-search-forward tramp-smb-errors nil t)))) 972 (err (progn (goto-char (point-min))
973 973 (re-search-forward tramp-smb-errors nil t))))
974 ;; Algorithm: get waiting output. See if last line contains
975 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
976 ;; If not, wait a bit and again get waiting output.
977 (while (not found)
978
979 ;; Accept pending output.
980 (tramp-accept-process-output proc)
981
982 ;; Search for prompt.
983 (goto-char (point-min))
984 (setq found (re-search-forward tramp-smb-prompt nil t))
985
986 ;; Search for errors.
987 (goto-char (point-min))
988 (setq err (re-search-forward tramp-smb-errors nil t)))
989 974
990 ;; Add output to debug buffer if appropriate. 975 ;; Algorithm: get waiting output. See if last line contains
991 (when tramp-debug-buffer 976 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
992 (append-to-buffer 977 ;; If not, wait a bit and again get waiting output.
993 (tramp-get-debug-buffer nil tramp-smb-method user host) 978 (while (and (not found) (not err))
994 (point-min) (point-max)))
995 979
996 ;; Return value is whether no error message has appeared. 980 ;; Accept pending output.
997 (not err))) 981 (tramp-accept-process-output p)
998 982
983 ;; Search for prompt.
984 (goto-char (point-min))
985 (setq found (re-search-forward tramp-smb-prompt nil t))
999 986
1000;; Snarfed code from time-date.el and parse-time.el 987 ;; Search for errors.
988 (goto-char (point-min))
989 (setq err (re-search-forward tramp-smb-errors nil t)))
1001 990
1002(defconst tramp-smb-half-a-year '(241 17024) 991 ;; When the process is still alive, read pending output.
1003"Evaluated by \"(days-to-time 183)\".") 992 (while (and (not found) (memq (process-status p) '(run open)))
1004 993
1005(defconst tramp-smb-parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) 994 ;; Accept pending output.
1006 ("apr" . 4) ("may" . 5) ("jun" . 6) 995 (tramp-accept-process-output p)
1007 ("jul" . 7) ("aug" . 8) ("sep" . 9)
1008 ("oct" . 10) ("nov" . 11) ("dec" . 12))
1009"Alist mapping month names to integers.")
1010 996
1011(defun tramp-smb-time-less-p (t1 t2) 997 ;; Search for prompt.
1012 "Say whether time value T1 is less than time value T2." 998 (goto-char (point-min))
1013 (unless t1 (setq t1 '(0 0))) 999 (setq found (re-search-forward tramp-smb-prompt nil t)))
1014 (unless t2 (setq t2 '(0 0)))
1015 (or (< (car t1) (car t2))
1016 (and (= (car t1) (car t2))
1017 (< (nth 1 t1) (nth 1 t2)))))
1018 1000
1019(defun tramp-smb-time-subtract (t1 t2) 1001 ;; Return value is whether no error message has appeared.
1020 "Subtract two time values. 1002 (tramp-message vec 6 "\n%s" (buffer-string))
1021Return the difference in the format of a time value." 1003 (not err))))
1022 (unless t1 (setq t1 '(0 0)))
1023 (unless t2 (setq t2 '(0 0)))
1024 (let ((borrow (< (cadr t1) (cadr t2))))
1025 (list (- (car t1) (car t2) (if borrow 1 0))
1026 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
1027 1004
1028 1005
1029(provide 'tramp-smb) 1006(provide 'tramp-smb)
1030 1007
1031;;; TODO: 1008;;; TODO:
1032 1009
1033;; * Provide a local smb.conf. The default one might not be readable.
1034;; * Error handling in case password is wrong. 1010;; * Error handling in case password is wrong.
1035;; * Read password from "~/.netrc". 1011;; * Read password from "~/.netrc".
1036;; * Return more comprehensive file permission string. Think whether it is 1012;; * Return more comprehensive file permission string. Think whether it is
1037;; possible to implement `set-file-modes'. 1013;; possible to implement `set-file-modes'.
1038;; * Handle WILDCARD and FULL-DIRECTORY-P in
1039;; `tramp-smb-handle-insert-directory'.
1040;; * Handle links (FILENAME.LNK). 1014;; * Handle links (FILENAME.LNK).
1041;; * Maybe local tmp files should have the same extension like the original 1015;; * Maybe local tmp files should have the same extension like the original
1042;; files. Strange behaviour with jka-compr otherwise? 1016;; files. Strange behaviour with jka-compr otherwise?
1043;; * Copy files in dired from SMB to another method doesn't work.
1044;; * Try to remove the inclusion of dummy "" directory. Seems to be at 1017;; * Try to remove the inclusion of dummy "" directory. Seems to be at
1045;; several places, especially in `tramp-smb-handle-insert-directory'. 1018;; several places, especially in `tramp-smb-handle-insert-directory'.
1046;; * Provide variables for debug.
1047;; * (RMS) Use unwind-protect to clean up the state so as to make the state 1019;; * (RMS) Use unwind-protect to clean up the state so as to make the state
1048;; regular again. 1020;; regular again.
1021;; * Make it multi-hop capable.
1049 1022
1050;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 1023;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
1051;;; tramp-smb.el ends here 1024;;; tramp-smb.el ends here
diff --git a/lisp/net/tramp-util.el b/lisp/net/tramp-util.el
deleted file mode 100644
index 4895edf019b..00000000000
--- a/lisp/net/tramp-util.el
+++ /dev/null
@@ -1,138 +0,0 @@
1;;; -*- coding: iso-2022-7bit; -*-
2;;; tramp-util.el --- Misc utility functions to use with Tramp
3
4;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
5;; 2006, 2007 Free Software Foundation, Inc.
6
7;; Author: kai.grossjohann@gmx.net
8;; Keywords: comm, extensions, processes
9
10;; This file is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; This file is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; Some misc. utility functions that might go nicely with Tramp.
28;; Mostly, these are kluges awaiting real solutions later on.
29
30;;; Code:
31
32(require 'compile)
33(require 'tramp)
34(add-hook 'tramp-util-unload-hook
35 '(lambda ()
36 (when (featurep 'tramp)
37 (unload-feature 'tramp 'force))))
38
39;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
40;; specific functions, like compilation.
41;; The key remapping works since Emacs 22 only. Unknown for XEmacs.
42
43;; Pacify byte-compiler
44(eval-when-compile
45 (unless (fboundp 'define-minor-mode)
46 (defalias 'define-minor-mode 'identity)
47 (defvar tramp-minor-mode))
48 (unless (featurep 'xemacs)
49 (defalias 'add-menu-button 'ignore)))
50
51(defvar tramp-minor-mode-map (make-sparse-keymap)
52 "Keymap for Tramp minor mode.")
53
54(define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
55 :group 'tramp
56 :global nil
57 :init-value nil
58 :lighter " Tramp"
59 :keymap tramp-minor-mode-map
60 (setq tramp-minor-mode
61 (and tramp-minor-mode (tramp-tramp-file-p default-directory))))
62
63(add-hook 'find-file-hooks 'tramp-minor-mode t)
64(add-hook 'tramp-util-unload-hook
65 '(lambda ()
66 (remove-hook 'find-file-hooks 'tramp-minor-mode)))
67
68(add-hook 'dired-mode-hook 'tramp-minor-mode t)
69(add-hook 'tramp-util-unload-hook
70 '(lambda ()
71 (remove-hook 'dired-mode-hook 'tramp-minor-mode)))
72
73(defun tramp-remap-command (old-command new-command)
74 "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
75If remapping functionality for keymaps is defined, this happens for all
76bindings. Otherwise, only bindings active during invocation are taken
77into account. XEmacs menubar bindings are not changed by this."
78 (if (functionp 'command-remapping)
79 ;; Emacs 22
80 (eval
81 `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
82 ;; previous Emacs versions.
83 (mapcar
84 '(lambda (x)
85 (define-key tramp-minor-mode-map x new-command))
86 (where-is-internal old-command))))
87
88(tramp-remap-command 'compile 'tramp-compile)
89(tramp-remap-command 'recompile 'tramp-recompile)
90
91;; XEmacs has an own mimic for menu entries
92(when (fboundp 'add-menu-button)
93 (funcall 'add-menu-button
94 '("Tools" "Compile")
95 ["Compile..."
96 (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
97 :active (fboundp 'compile)])
98 (funcall 'add-menu-button
99 '("Tools" "Compile")
100 ["Repeat Compilation"
101 (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
102 :active (fboundp 'compile)]))
103
104;; Utility functions.
105
106(defun tramp-compile (command)
107 "Compile on remote host."
108 (interactive
109 (if (or compilation-read-command current-prefix-arg)
110 (list (read-from-minibuffer "Compile command: "
111 compile-command nil nil
112 '(compile-history . 1)))
113 (list compile-command)))
114 (setq compile-command command)
115 (save-some-buffers (not compilation-ask-about-save) nil)
116 (let ((d default-directory))
117 (save-excursion
118 (pop-to-buffer (get-buffer-create "*Compilation*") t)
119 (erase-buffer)
120 (setq default-directory d)))
121 (tramp-handle-shell-command command (get-buffer "*Compilation*"))
122 (pop-to-buffer (get-buffer "*Compilation*"))
123 (tramp-minor-mode 1)
124 (compilation-minor-mode 1))
125
126(defun tramp-recompile ()
127 "Re-compile on remote host."
128 (interactive)
129 (save-some-buffers (not compilation-ask-about-save) nil)
130 (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
131 (pop-to-buffer (get-buffer "*Compilation*"))
132 (tramp-minor-mode 1)
133 (compilation-minor-mode 1))
134
135(provide 'tramp-util)
136
137;;; arch-tag: 500f9992-a44e-46d0-83a7-980799251808
138;;; tramp-util.el ends here
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 32bb9857f7f..9973860efa0 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -9,8 +9,8 @@
9 9
10;; This file is free software; you can redistribute it and/or modify 10;; This file is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by 11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option) 12;; the Free Software Foundation; either version 3 of the License, or
13;; any later version. 13;; (at your option) any later version.
14 14
15;; This file is distributed in the hope that it will be useful, 15;; This file is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +18,8 @@
18;; GNU General Public License for more details. 18;; GNU General Public License for more details.
19 19
20;; You should have received a copy of the GNU General Public License 20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to 21;; along with GNU Emacs; see the file COPYING. If not, see
22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 22;; <http://www.gnu.org/licenses/>.
23;; Boston, MA 02110-1301, USA.
24 23
25;;; Commentary: 24;;; Commentary:
26 25
diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el
deleted file mode 100644
index cc5566d6354..00000000000
--- a/lisp/net/tramp-vc.el
+++ /dev/null
@@ -1,536 +0,0 @@
1;;; tramp-vc.el --- Version control integration for TRAMP.el
2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Daniel Pittman <daniel@danann.net>
7;; Keywords: comm, processes
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; See the main module, 'tramp.el' for discussion of the purpose of TRAMP.
29;; This module provides integration between remote files accessed by TRAMP and
30;; the Emacs version control system.
31
32;;; Code:
33
34(require 'vc)
35;; Old VC defines vc-rcs-release in vc.el, new VC requires extra module.
36(unless (boundp 'vc-rcs-release)
37 (require 'vc-rcs))
38(require 'tramp)
39
40;; Avoid byte-compiler warnings if the byte-compiler supports this.
41;; Currently, XEmacs supports this.
42(eval-when-compile
43 (when (fboundp 'byte-compiler-options)
44 (let (unused-vars) ; Pacify Emacs byte-compiler
45 (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
46 (byte-compiler-options (warnings (- unused-vars))))))
47
48;; -- vc --
49
50;; This used to blow away the file-name-handler-alist and reinstall
51;; TRAMP into it. This was intended to let VC work remotely. It didn't,
52;; at least not in my XEmacs 21.2 install.
53;;
54;; In any case, tramp-run-real-handler now deals correctly with disabling
55;; the things that should be, making this a no-op.
56;;
57;; I have removed it from the tramp-file-name-handler-alist because the
58;; shortened version does nothing. This is for reference only now.
59;;
60;; Daniel Pittman <daniel@danann.net>
61;;
62;; (defun tramp-handle-vc-registered (file)
63;; "Like `vc-registered' for tramp files."
64;; (tramp-run-real-handler 'vc-registered (list file)))
65
66;; `vc-do-command'
67;; This function does not deal well with remote files, so we define
68;; our own version and make a backup of the original function and
69;; call our version for tramp files and the original version for
70;; normal files.
71
72;; The following function is pretty much copied from vc.el, but
73;; the part that actually executes a command is changed.
74;; CCC: this probably works for Emacs 21, too.
75(defun tramp-vc-do-command (buffer okstatus command file last &rest flags)
76 "Like `vc-do-command' but invoked for tramp files.
77See `vc-do-command' for more information."
78 (save-match-data
79 (and file (setq file (expand-file-name file)))
80 (if (not buffer) (setq buffer "*vc*"))
81 (if vc-command-messages
82 (message "Running `%s' on `%s'..." command file))
83 (let ((obuf (current-buffer)) (camefrom (current-buffer))
84 (squeezed nil)
85 (olddir default-directory)
86 vc-file status)
87 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
88 (multi-method (tramp-file-name-multi-method v))
89 (method (tramp-file-name-method v))
90 (user (tramp-file-name-user v))
91 (host (tramp-file-name-host v))
92 (localname (tramp-file-name-localname v)))
93 (set-buffer (get-buffer-create buffer))
94 (set (make-local-variable 'vc-parent-buffer) camefrom)
95 (set (make-local-variable 'vc-parent-buffer-name)
96 (concat " from " (buffer-name camefrom)))
97 (setq default-directory olddir)
98
99 (erase-buffer)
100
101 (mapcar
102 (function
103 (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
104 flags)
105 (if (and (eq last 'MASTER) file
106 (setq vc-file (vc-name file)))
107 (setq squeezed
108 (append squeezed
109 (list (tramp-file-name-localname
110 (tramp-dissect-file-name vc-file))))))
111 (if (and file (eq last 'WORKFILE))
112 (progn
113 (let* ((pwd (expand-file-name default-directory))
114 (preflen (length pwd)))
115 (if (string= (substring file 0 preflen) pwd)
116 (setq file (substring file preflen))))
117 (setq squeezed (append squeezed (list file)))))
118 ;; Unless we (save-window-excursion) the layout of windows in
119 ;; the current frame changes. This is painful, at best.
120 ;;
121 ;; As a point of note, (save-excursion) is still here only because
122 ;; it preserves (point) in the current buffer. (save-window-excursion)
123 ;; does not, at least under XEmacs 21.2.
124 ;;
125 ;; I trust that the FSF support this as well. I can't find useful
126 ;; documentation to check :(
127 ;;
128 ;; Daniel Pittman <daniel@danann.net>
129 (save-excursion
130 (save-window-excursion
131 ;; Actually execute remote command
132 ;; `shell-command' cannot be used; it isn't magic in XEmacs.
133 (tramp-handle-shell-command
134 (mapconcat 'tramp-shell-quote-argument
135 (cons command squeezed) " ") t)
136 ;;(tramp-wait-for-output)
137 ;; Get status from command
138 (tramp-send-command multi-method method user host "echo $?")
139 (tramp-wait-for-output)
140 ;; Make sure to get status from last line of output.
141 (goto-char (point-max)) (forward-line -1)
142 (setq status (read (current-buffer)))
143 (message "Command %s returned status %d." command status)))
144 (goto-char (point-max))
145 (set-buffer-modified-p nil)
146 (forward-line -1)
147 (if (or (not (integerp status))
148 (and (integerp okstatus) (< okstatus status)))
149 (progn
150 (pop-to-buffer buffer)
151 (goto-char (point-min))
152 (shrink-window-if-larger-than-buffer)
153 (error "Running `%s'...FAILED (%s)" command
154 (if (integerp status)
155 (format "status %d" status)
156 status))
157 )
158 (if vc-command-messages
159 (message "Running %s...OK" command))
160 )
161 (set-buffer obuf)
162 status))
163 ))
164
165;; Following code snarfed from Emacs 21 vc.el and slightly tweaked.
166(defun tramp-vc-do-command-new (buffer okstatus command file &rest flags)
167 "Like `vc-do-command' but for TRAMP files.
168This function is for the new VC which comes with Emacs 21.
169Since TRAMP doesn't do async commands yet, this function doesn't, either."
170 (and file (setq file (expand-file-name file)))
171 (if vc-command-messages
172 (message "Running %s on %s..." command file))
173 (save-current-buffer
174 (unless (eq buffer t)
175 ; Pacify byte-compiler
176 (funcall (symbol-function 'vc-setup-buffer) buffer))
177 (let ((squeezed nil)
178 (inhibit-read-only t)
179 (status 0))
180 (let* ((v (when file (tramp-dissect-file-name file)))
181 (multi-method (when file (tramp-file-name-multi-method v)))
182 (method (when file (tramp-file-name-method v)))
183 (user (when file (tramp-file-name-user v)))
184 (host (when file (tramp-file-name-host v)))
185 (localname (when file (tramp-file-name-localname v))))
186 (setq squeezed (delq nil (copy-sequence flags)))
187 (when file
188 (setq squeezed (append squeezed (list (file-relative-name
189 file default-directory)))))
190 (let ((w32-quote-process-args t))
191 (when (eq okstatus 'async)
192 (message "Tramp doesn't do async commands, running synchronously."))
193 ;; `shell-command' cannot be used; it isn't magic in XEmacs.
194 (setq status (tramp-handle-shell-command
195 (mapconcat 'tramp-shell-quote-argument
196 (cons command squeezed) " ") t))
197 (when (or (not (integerp status))
198 (and (integerp okstatus) (< okstatus status)))
199 (pop-to-buffer (current-buffer))
200 (goto-char (point-min))
201 (shrink-window-if-larger-than-buffer)
202 (error "Running %s...FAILED (%s)" command
203 (if (integerp status) (format "status %d" status) status))))
204 (if vc-command-messages
205 (message "Running %s...OK" command))
206 ; Pacify byte-compiler
207 (funcall (symbol-function 'vc-exec-after)
208 `(run-hook-with-args
209 'vc-post-command-functions ',command ',localname ',flags))
210 status))))
211
212
213;; The context for a VC command is the current buffer.
214;; That makes a test on the buffers file more reliable than a test on the
215;; arguments.
216;; This is needed to handle remote VC correctly - else we test against the
217;; local VC system and get things wrong...
218;; Daniel Pittman <daniel@danann.net>
219;;-(if (fboundp 'vc-call-backend)
220;;- () ;; This is the new VC for which we don't have an appropriate advice yet
221;;-)
222(unless (fboundp 'process-file)
223 (if (fboundp 'vc-call-backend)
224 (defadvice vc-do-command
225 (around tramp-advice-vc-do-command
226 (buffer okstatus command file &rest flags)
227 activate)
228 "Invoke tramp-vc-do-command for tramp files."
229 (let ((file (symbol-value 'file))) ;pacify byte-compiler
230 (if (or (and (stringp file) (tramp-tramp-file-p file))
231 (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
232 (setq ad-return-value
233 (apply 'tramp-vc-do-command-new buffer okstatus command
234 file ;(or file (buffer-file-name))
235 flags))
236 ad-do-it)))
237 (defadvice vc-do-command
238 (around tramp-advice-vc-do-command
239 (buffer okstatus command file last &rest flags)
240 activate)
241 "Invoke tramp-vc-do-command for tramp files."
242 (let ((file (symbol-value 'file))) ;pacify byte-compiler
243 (if (or (and (stringp file) (tramp-tramp-file-p file))
244 (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
245 (setq ad-return-value
246 (apply 'tramp-vc-do-command buffer okstatus command
247 (or file (buffer-file-name)) last flags))
248 ad-do-it))))
249
250 (add-hook 'tramp-unload-hook
251 '(lambda () (ad-unadvise 'vc-do-command))))
252
253
254;; XEmacs uses this to do some of its work. Like vc-do-command, we
255;; need to enhance it to make VC work via TRAMP-mode.
256;;
257;; Like the previous function, this is a cut-and-paste job from the VC
258;; file. It's based on the vc-do-command code.
259;; CCC: this isn't used in Emacs 21, so do as before.
260(defun tramp-vc-simple-command (okstatus command file &rest args)
261 ;; Simple version of vc-do-command, for use in vc-hooks only.
262 ;; Don't switch to the *vc-info* buffer before running the
263 ;; command, because that would change its default directory
264 (save-match-data
265 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
266 (multi-method (tramp-file-name-multi-method v))
267 (method (tramp-file-name-method v))
268 (user (tramp-file-name-user v))
269 (host (tramp-file-name-host v))
270 (localname (tramp-file-name-localname v)))
271 (save-excursion (set-buffer (get-buffer-create "*vc-info*"))
272 (erase-buffer))
273 (let ((exec-path (append vc-path exec-path)) exec-status
274 ;; Add vc-path to PATH for the execution of this command.
275 (process-environment
276 (cons (concat "PATH=" (getenv "PATH")
277 path-separator
278 (mapconcat 'identity vc-path path-separator))
279 process-environment)))
280 ;; Call the actual process. See tramp-vc-do-command for discussion of
281 ;; why this does both (save-window-excursion) and (save-excursion).
282 ;;
283 ;; As a note, I don't think that the process-environment stuff above
284 ;; has any effect on the remote system. This is a hard one though as
285 ;; there is no real reason to expect local and remote paths to be
286 ;; identical...
287 ;;
288 ;; Daniel Pittman <daniel@danann.net>
289 (save-excursion
290 (save-window-excursion
291 ;; Actually execute remote command
292 ;; `shell-command' cannot be used; it isn't magic in XEmacs.
293 (tramp-handle-shell-command
294 (mapconcat 'tramp-shell-quote-argument
295 (append (list command) args (list localname)) " ")
296 (get-buffer-create"*vc-info*"))
297 ;(tramp-wait-for-output)
298 ;; Get status from command
299 (tramp-send-command multi-method method user host "echo $?")
300 (tramp-wait-for-output)
301 (setq exec-status (read (current-buffer)))
302 (message "Command %s returned status %d." command exec-status)))
303
304 ;; Maybe okstatus can be `async' here. But then, maybe the
305 ;; async thing is new in Emacs 21, but this function is only
306 ;; used in Emacs 20.
307 (cond ((> exec-status okstatus)
308 (switch-to-buffer (get-file-buffer file))
309 (shrink-window-if-larger-than-buffer
310 (display-buffer "*vc-info*"))
311 (error "Couldn't find version control information")))
312 exec-status))))
313
314;; This function does not exist any more in Emacs-21's VC
315(defadvice vc-simple-command
316 (around tramp-advice-vc-simple-command
317 (okstatus command file &rest args)
318 activate)
319 "Invoke tramp-vc-simple-command for tramp files."
320 (let ((file (symbol-value 'file))) ;pacify byte-compiler
321 (if (or (and (stringp file) (tramp-tramp-file-p file))
322 (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
323 (setq ad-return-value
324 (apply 'tramp-vc-simple-command okstatus command
325 (or file (buffer-file-name)) args))
326 ad-do-it)))
327
328(add-hook 'tramp-unload-hook
329 '(lambda () (ad-unadvise 'vc-simple-command)))
330
331
332;; `vc-workfile-unchanged-p'
333;; This function does not deal well with remote files, so we do the
334;; same as for `vc-do-command'.
335
336;; `vc-workfile-unchanged-p' checks the modification time, we cannot
337;; do that for remote files, so here's a version which relies on diff.
338;; CCC: this one probably works for Emacs 21, too.
339(defun tramp-vc-workfile-unchanged-p
340 (filename &optional want-differences-if-changed)
341 (if (fboundp 'vc-backend-diff)
342 ;; Old VC. Call `vc-backend-diff'.
343 (let ((status (funcall (symbol-function 'vc-backend-diff)
344 filename nil nil
345 (not want-differences-if-changed))))
346 (zerop status))
347 ;; New VC. Call `vc-default-workfile-unchanged-p'.
348 (funcall (symbol-function 'vc-default-workfile-unchanged-p)
349 (vc-backend filename) filename)))
350
351(defadvice vc-workfile-unchanged-p
352 (around tramp-advice-vc-workfile-unchanged-p
353 (filename &optional want-differences-if-changed)
354 activate)
355 "Invoke tramp-vc-workfile-unchanged-p for tramp files."
356 (if (and (stringp filename)
357 (tramp-tramp-file-p filename)
358 (not
359 (let ((v (tramp-dissect-file-name filename)))
360 ;; The following check is probably to test whether
361 ;; file-attributes returns correct last modification
362 ;; times. This check needs to be changed.
363 (tramp-get-remote-perl (tramp-file-name-multi-method v)
364 (tramp-file-name-method v)
365 (tramp-file-name-user v)
366 (tramp-file-name-host v)))))
367 (setq ad-return-value
368 (tramp-vc-workfile-unchanged-p filename want-differences-if-changed))
369 ad-do-it))
370
371(add-hook 'tramp-unload-hook
372 '(lambda () (ad-unadvise 'vc-workfile-unchanged-p)))
373
374
375;; Redefine a function from vc.el -- allow tramp files.
376;; `save-match-data' seems not to be required -- it isn't in
377;; the original version, either.
378;; CCC: this might need some work -- how does the Emacs 21 version
379;; work, anyway? Does it work over ange-ftp? Hm.
380(if (not (fboundp 'vc-backend-checkout))
381 () ;; our replacement won't work and is unnecessary anyway
382(defun vc-checkout (filename &optional writable rev)
383 "Retrieve a copy of the latest version of the given file."
384 ;; If ftp is on this system and the name matches the ange-ftp format
385 ;; for a remote file, the user is trying something that won't work.
386 (funcall (symbol-function 'vc-backend-checkout) filename writable rev)
387 (vc-resynch-buffer filename t t))
388)
389
390
391;; Do we need to advise the vc-user-login-name function anyway?
392;; This will return the correct login name for the owner of a
393;; file. It does not deal with the default remote user name...
394;;
395;; That is, when vc calls (vc-user-login-name), we return the
396;; local login name, something that may be different to the remote
397;; default.
398;;
399;; The remote VC operations will occur as the user that we logged
400;; in with however - not always the same as the local user.
401;;
402;; In the end, I did advise the function. This is because, well,
403;; the thing didn't work right otherwise ;)
404;;
405;; Daniel Pittman <daniel@danann.net>
406
407(defun tramp-handle-vc-user-login-name (&optional uid)
408 "Return the default user name on the remote machine.
409Whenever VC calls this function, `file' is bound to the file name
410in question. If no uid is provided or the uid is equal to the uid
411owning the file, then we return the user name given in the file name.
412
413This should only be called when `file' is bound to the
414filename we are thinking about..."
415 ;; Pacify byte-compiler; this symbol is bound in the calling
416 ;; function. CCC: Maybe it would be better to move the
417 ;; boundness-checking into this function?
418 (let* ((file (symbol-value 'file))
419 (remote-uid
420 ;; With Emacs 22, `file-attributes' has got an optional parameter
421 ;; ID-FORMAT. Handle this case backwards compatible.
422 (if (and (functionp 'subr-arity)
423 (= 2 (cdr (funcall (symbol-function 'subr-arity)
424 (symbol-function 'file-attributes)))))
425 (nth 2 (file-attributes file 'integer))
426 (nth 2 (file-attributes file)))))
427 (if (and uid (/= uid remote-uid))
428 (error "tramp-handle-vc-user-login-name cannot map a uid to a name")
429 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
430 (u (tramp-file-name-user v)))
431 (cond ((stringp u) u)
432 ((vectorp u) (elt u (1- (length u))))
433 ((null u) (user-login-name))
434 (t (error "tramp-handle-vc-user-login-name cannot cope!")))))))
435
436
437;; The following defadvice is no longer necessary after changes in VC
438;; on 2006-01-25, Andre.
439
440(unless (fboundp 'process-file)
441 (defadvice vc-user-login-name
442 (around tramp-vc-user-login-name activate)
443 "Support for files on remote machines accessed by TRAMP."
444 ;; We rely on the fact that `file' is bound when this is called.
445 ;; This appears to be the case everywhere in vc.el and vc-hooks.el
446 ;; as of Emacs 20.5.
447 ;;
448 ;; With Emacs 22, the definition of `vc-user-login-name' has been
449 ;; changed. It doesn't need to be adviced any longer.
450 (let ((file (when (boundp 'file)
451 (symbol-value 'file)))) ;pacify byte-compiler
452 (or (and (stringp file)
453 (tramp-tramp-file-p file) ; tramp file
454 (setq ad-return-value
455 (save-match-data
456 (tramp-handle-vc-user-login-name uid)))) ; get the owner name
457 ad-do-it))) ; else call the original
458
459 (add-hook 'tramp-unload-hook
460 '(lambda () (ad-unadvise 'vc-user-login-name))))
461
462
463;; Determine the name of the user owning a file.
464(defun tramp-file-owner (filename)
465 "Return who owns FILE (user name, as a string)."
466 (let ((v (tramp-dissect-file-name
467 (expand-file-name filename))))
468 (if (not (file-exists-p filename))
469 nil ; file cannot be opened
470 ;; file exists, find out stuff
471 (save-excursion
472 (tramp-send-command
473 (tramp-file-name-multi-method v) (tramp-file-name-method v)
474 (tramp-file-name-user v) (tramp-file-name-host v)
475 (format "%s -Lld %s"
476 (tramp-get-ls-command (tramp-file-name-multi-method v)
477 (tramp-file-name-method v)
478 (tramp-file-name-user v)
479 (tramp-file-name-host v))
480 (tramp-shell-quote-argument (tramp-file-name-localname v))))
481 (tramp-wait-for-output)
482 ;; parse `ls -l' output ...
483 ;; ... file mode flags
484 (read (current-buffer))
485 ;; ... number links
486 (read (current-buffer))
487 ;; ... uid (as a string)
488 (symbol-name (read (current-buffer)))))))
489
490;; Wire ourselves into the VC infrastructure...
491;; This function does not exist any more in Emacs-21's VC
492;; CCC: it appears that no substitute is needed for Emacs 21.
493(defadvice vc-file-owner
494 (around tramp-vc-file-owner activate)
495 "Support for files on remote machines accessed by TRAMP."
496 (let ((filename (ad-get-arg 0)))
497 (or (and (tramp-file-name-p filename) ; tramp file
498 (setq ad-return-value
499 (save-match-data
500 (tramp-file-owner filename)))) ; get the owner name
501 ad-do-it))) ; else call the original
502
503(add-hook 'tramp-unload-hook
504 '(lambda () (ad-unadvise 'vc-file-owner)))
505
506
507;; We need to make the version control software backend version
508;; information local to the current buffer. This is because each TRAMP
509;; buffer can (theoretically) have a different VC version and I am
510;; *way* too lazy to try and push the correct value into each new
511;; buffer.
512;;
513;; Remote VC costs will just have to be paid, at least for the moment.
514;; Well, at least, they will right until I feel guilty about doing a
515;; botch job here and fix it. :/
516;;
517;; Daniel Pittman <daniel@danann.net>
518;; CCC: this is probably still needed for Emacs 21.
519(defun tramp-vc-setup-for-remote ()
520 "Make the backend release variables buffer local.
521This makes remote VC work correctly at the cost of some processing time."
522 (when (and (buffer-file-name)
523 (tramp-tramp-file-p (buffer-file-name)))
524 (make-local-variable 'vc-rcs-release)
525 (setq vc-rcs-release nil)))
526
527(add-hook 'find-file-hooks 'tramp-vc-setup-for-remote t)
528(add-hook 'tramp-unload-hook
529 '(lambda ()
530 (remove-hook 'find-file-hooks 'tramp-vc-setup-for-remote)))
531
532;; No need to load this again if anyone asks.
533(provide 'tramp-vc)
534
535;;; arch-tag: 27cc42ce-da19-468d-ad5c-a2690558db60
536;;; tramp-vc.el ends here
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f85620ee323..021d3db6fac 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -14,8 +14,8 @@
14 14
15;; GNU Emacs is free software; you can redistribute it and/or modify 15;; GNU Emacs is free software; you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by 16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation; either version 2, or (at your option) 17;; the Free Software Foundation; either version 3 of the License, or
18;; any later version. 18;; (at your option) any later version.
19 19
20;; GNU Emacs is distributed in the hope that it will be useful, 20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -23,9 +23,8 @@
23;; GNU General Public License for more details. 23;; GNU General Public License for more details.
24 24
25;; You should have received a copy of the GNU General Public License 25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs; see the file COPYING. If not, write to the 26;; along with GNU Emacs; see the file COPYING. If not, see
27;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; <http://www.gnu.org/licenses/>.
28;; Boston, MA 02110-1301, USA.
29 28
30;;; Commentary: 29;;; Commentary:
31 30
@@ -39,10 +38,9 @@
39;; Notes: 38;; Notes:
40;; ----- 39;; -----
41;; 40;;
42;; This package only works for Emacs 20 and higher, and for XEmacs 21 41;; This package only works for Emacs 21.1 and higher, and for XEmacs 21.4
43;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs 42;; and higher. For XEmacs 21, you need the package `fsf-compat' for
44;; 19 is reported to have other problems. For XEmacs 21, you need the 43;; the `with-timeout' macro.)
45;; package `fsf-compat' for the `with-timeout' macro.)
46;; 44;;
47;; This version might not work with pre-Emacs 21 VC unless VC is 45;; This version might not work with pre-Emacs 21 VC unless VC is
48;; loaded before tramp.el. Could you please test this and tell me about 46;; loaded before tramp.el. Could you please test this and tell me about
@@ -74,6 +72,8 @@
74 (when (featurep 'trampver) 72 (when (featurep 'trampver)
75 (unload-feature 'trampver 'force)))) 73 (unload-feature 'trampver 'force))))
76 74
75(require 'custom)
76
77(if (featurep 'xemacs) 77(if (featurep 'xemacs)
78 (require 'timer-funcs) 78 (require 'timer-funcs)
79 (require 'timer)) 79 (require 'timer))
@@ -85,15 +85,24 @@
85 (load "password" 'noerror) 85 (load "password" 'noerror)
86 (require 'password nil 'noerror)) ;from No Gnus, also in tar ball 86 (require 'password nil 'noerror)) ;from No Gnus, also in tar ball
87 87
88;; The explicit check is not necessary in Emacs, which provides the
89;; feature even if implemented in C, but it appears to be necessary
90;; in XEmacs.
91(unless (and (fboundp 'base64-encode-region)
92 (fboundp 'base64-decode-region))
93 (require 'base64)) ;for the mimencode methods
94(require 'shell) 88(require 'shell)
95(require 'advice) 89(require 'advice)
96 90
91;; Requiring 'tramp-cache results in an endless loop.
92(autoload 'tramp-get-file-property "tramp-cache")
93(autoload 'tramp-set-file-property "tramp-cache")
94(autoload 'tramp-flush-file-property "tramp-cache")
95(autoload 'tramp-flush-directory-property "tramp-cache")
96(autoload 'tramp-cache-print "tramp-cache")
97(autoload 'tramp-get-connection-property "tramp-cache")
98(autoload 'tramp-set-connection-property "tramp-cache")
99(autoload 'tramp-flush-connection-property "tramp-cache")
100(autoload 'tramp-parse-connection-properties "tramp-cache")
101(add-hook 'tramp-unload-hook
102 '(lambda ()
103 (when (featurep 'tramp-cache)
104 (unload-feature 'tramp-cache 'force))))
105
97(autoload 'tramp-uuencode-region "tramp-uu" 106(autoload 'tramp-uuencode-region "tramp-uu"
98 "Implementation of `uuencode' in Lisp.") 107 "Implementation of `uuencode' in Lisp.")
99(add-hook 'tramp-unload-hook 108(add-hook 'tramp-unload-hook
@@ -101,75 +110,85 @@
101 (when (featurep 'tramp-uu) 110 (when (featurep 'tramp-uu)
102 (unload-feature 'tramp-uu 'force)))) 111 (unload-feature 'tramp-uu 'force))))
103 112
104(unless (fboundp 'uudecode-decode-region) 113(autoload 'uudecode-decode-region "uudecode")
105 (autoload 'uudecode-decode-region "uudecode"))
106 114
107;; XEmacs is distributed with few Lisp packages. Further packages are 115;; The following Tramp packages must be loaded after Tramp, because
108;; installed using EFS. If we use a unified filename format, then 116;; they require Tramp as well.
109;; Tramp is required in addition to EFS. (But why can't Tramp just 117(eval-after-load "tramp"
110;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS 118 '(progn
111;; just like before.) Another reason for using a separate filename 119
112;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but 120 ;; Load foreign FTP method.
113;; Tramp only knows how to deal with `file-name-handler-alist', not 121 (let ((feature (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)))
114;; the other places. 122 (require feature)
115;;;###autoload
116(defvar tramp-unified-filenames (not (featurep 'xemacs))
117 "Non-nil means to use unified Ange-FTP/Tramp filename syntax.
118Otherwise, use a separate filename syntax for Tramp.")
119
120;; Load foreign methods. Because they do require Tramp internally, this
121;; must be done with the `eval-after-load' trick.
122
123;; tramp-ftp supports Ange-FTP only. Not suited for XEmacs therefore.
124(unless (featurep 'xemacs)
125 (eval-after-load "tramp"
126 '(progn
127 (require 'tramp-ftp)
128 (add-hook 'tramp-unload-hook
129 '(lambda ()
130 (when (featurep 'tramp-ftp)
131 (unload-feature 'tramp-ftp 'force)))))))
132(when (and tramp-unified-filenames (featurep 'xemacs))
133 (eval-after-load "tramp"
134 '(progn
135 (require 'tramp-efs)
136 (add-hook 'tramp-unload-hook 123 (add-hook 'tramp-unload-hook
137 '(lambda () 124 `(lambda ()
138 (when (featurep 'tramp-efs) 125 (when (featurep ,feature)
139 (unload-feature 'tramp-efs 'force))))))) 126 (unload-feature ,feature 'force)))))
140 127
141;; tramp-smb uses "smbclient" from Samba. 128 ;; tramp-smb uses "smbclient" from Samba. Not available under
142;; Not available under Cygwin and Windows, because they don't offer 129 ;; Cygwin and Windows, because they don't offer "smbclient". And
143;; "smbclient". And even not necessary there, because Emacs supports 130 ;; even not necessary there, because Emacs supports UNC file names
144;; UNC file names like "//host/share/localname". 131 ;; like "//host/share/localname".
145(unless (memq system-type '(cygwin windows-nt)) 132 (unless (memq system-type '(cygwin windows-nt))
146 (eval-after-load "tramp"
147 '(progn
148 (require 'tramp-smb) 133 (require 'tramp-smb)
149 (add-hook 'tramp-unload-hook 134 (add-hook 'tramp-unload-hook
150 '(lambda () 135 '(lambda ()
151 (when (featurep 'tramp-smb) 136 (when (featurep 'tramp-smb)
152 (unload-feature 'tramp-smb 'force))))))) 137 (unload-feature 'tramp-smb 'force)))))
153 138
154(require 'custom) 139 ;; Load foreign FISH method.
155 140 (require 'tramp-fish)
156(unless (boundp 'custom-print-functions) 141 (add-hook 'tramp-unload-hook
157 (defvar custom-print-functions nil)) ; not autoloaded before Emacs 20.4 142 '(lambda ()
143 (when (featurep 'tramp-fish)
144 (unload-feature 'tramp-fish 'force))))
145
146 ;; Load gateways. It needs `make-network-process' from Emacs 22.
147 (if (functionp 'make-network-process)
148 (progn
149 (require 'tramp-gw)
150 (add-hook 'tramp-unload-hook
151 '(lambda ()
152 (when (featurep 'tramp-gw)
153 (unload-feature 'tramp-gw 'force)))))
154 ;; We need to declare used tramp-gw-* symbols at least.
155 (setq tramp-gw-tunnel-method ""
156 tramp-gw-socks-method "")
157 (defalias 'tramp-gw-open-connection 'ignore))
158
159 ;; tramp-util offers integration into other (X)Emacs packages like
160 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
161 (unless (functionp 'start-file-process)
162 (require 'tramp-util)
163 (add-hook 'tramp-unload-hook
164 '(lambda ()
165 (when (featurep 'tramp-util)
166 (unload-feature 'tramp-util 'force)))))))
158 167
159;; Avoid byte-compiler warnings if the byte-compiler supports this. 168;; Avoid byte-compiler warnings if the byte-compiler supports this.
160;; Currently, XEmacs supports this. 169;; Currently, XEmacs supports this.
161(eval-when-compile 170(eval-when-compile
162 (when (featurep 'xemacs) 171 (when (featurep 'xemacs)
163 (let (unused-vars) ; Pacify Emacs byte-compiler 172 (byte-compiler-options (warnings (- unused-vars)))))
164 (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler 173
165 (byte-compiler-options (warnings (- unused-vars)))))) 174;; `last-coding-system-used' is unknown in XEmacs.
175(eval-when-compile
176 (unless (boundp 'last-coding-system-used)
177 (defvar last-coding-system-used nil)))
166 178
167;; `directory-sep-char' is an obsolete variable in Emacs. But it is 179;; `directory-sep-char' is an obsolete variable in Emacs. But it is
168;; used in XEmacs, so we set it here and there. The following is needed 180;; used in XEmacs, so we set it here and there. The following is needed
169;; to pacify Emacs byte-compiler. 181;; to pacify Emacs byte-compiler.
170(eval-when-compile 182(eval-when-compile
171 (when (boundp 'byte-compile-not-obsolete-var) 183 (unless (boundp 'byte-compile-not-obsolete-var)
172 (setq byte-compile-not-obsolete-var 'directory-sep-char))) 184 (defvar byte-compile-not-obsolete-var nil))
185 (setq byte-compile-not-obsolete-var 'directory-sep-char))
186
187;; `with-temp-message' does not exists in XEmacs.
188(eval-and-compile
189 (condition-case nil
190 (with-temp-message (current-message) nil)
191 (error (defmacro with-temp-message (message &rest body) `(progn ,@body)))))
173 192
174;; `set-buffer-multibyte' comes from Emacs Leim. 193;; `set-buffer-multibyte' comes from Emacs Leim.
175(eval-and-compile 194(eval-and-compile
@@ -183,16 +202,23 @@ Otherwise, use a separate filename syntax for Tramp.")
183 :group 'files 202 :group 'files
184 :version "22.1") 203 :version "22.1")
185 204
186(defcustom tramp-verbose 9 205(defcustom tramp-verbose 3
187 "*Verbosity level for tramp.el. 0 means be silent, 10 is most verbose." 206 "*Verbosity level for tramp.
207Any level x includes messages for all levels 1 .. x-1. The levels are
208
209 0 silent (no tramp messages at all)
210 1 errors
211 2 warnings
212 3 connection to remote hosts (default level)
213 4 activities
214 5 internal
215 6 sent and received strings
216 7 file caching
217 8 connection properties
21810 traces (huge)."
188 :group 'tramp 219 :group 'tramp
189 :type 'integer) 220 :type 'integer)
190 221
191(defcustom tramp-debug-buffer nil
192 "*Whether to send all commands and responses to a debug buffer."
193 :group 'tramp
194 :type 'boolean)
195
196;; Emacs case 222;; Emacs case
197(eval-and-compile 223(eval-and-compile
198 (when (boundp 'backup-directory-alist) 224 (when (boundp 'backup-directory-alist)
@@ -201,7 +227,7 @@ Otherwise, use a separate filename syntax for Tramp.")
201Each element looks like (REGEXP . DIRECTORY), with the same meaning like 227Each element looks like (REGEXP . DIRECTORY), with the same meaning like
202in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY 228in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
203is a local file name, the backup directory is prepended with Tramp file 229is a local file name, the backup directory is prepended with Tramp file
204name prefix \(multi-method, method, user, host\) of file. 230name prefix \(method, user, host\) of file.
205 231
206\(setq tramp-backup-directory-alist backup-directory-alist\) 232\(setq tramp-backup-directory-alist backup-directory-alist\)
207 233
@@ -220,7 +246,7 @@ policy for local files."
220It has the same meaning like `bkup-backup-directory-info' from package 246It has the same meaning like `bkup-backup-directory-info' from package
221`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local 247`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
222file name, the backup directory is prepended with Tramp file name prefix 248file name, the backup directory is prepended with Tramp file name prefix
223\(multi-method, method, user, host\) of file. 249\(method, user, host\) of file.
224 250
225\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\) 251\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
226 252
@@ -240,8 +266,7 @@ policy for local files."
240 "*Put auto-save files in this directory, if set. 266 "*Put auto-save files in this directory, if set.
241The idea is to use a local directory so that auto-saving is faster." 267The idea is to use a local directory so that auto-saving is faster."
242 :group 'tramp 268 :group 'tramp
243 :type '(choice (const nil) 269 :type '(choice (const nil) string))
244 string))
245 270
246(defcustom tramp-encoding-shell 271(defcustom tramp-encoding-shell
247 (if (memq system-type '(windows-nt)) 272 (if (memq system-type '(windows-nt))
@@ -258,9 +283,7 @@ For encoding and deocding, commands like the following are executed:
258 /bin/sh -c COMMAND < INPUT > OUTPUT 283 /bin/sh -c COMMAND < INPUT > OUTPUT
259 284
260This variable can be used to change the \"/bin/sh\" part. See the 285This variable can be used to change the \"/bin/sh\" part. See the
261variable `tramp-encoding-command-switch' for the \"-c\" part. Also, see the 286variable `tramp-encoding-command-switch' for the \"-c\" part.
262variable `tramp-encoding-reads-stdin' to specify whether the commands read
263standard input or a file.
264 287
265Note that this variable is not used for remote commands. There are 288Note that this variable is not used for remote commands. There are
266mechanisms in tramp.el which automatically determine the right shell to 289mechanisms in tramp.el which automatically determine the right shell to
@@ -277,286 +300,313 @@ See the variable `tramp-encoding-shell' for more information."
277 :group 'tramp 300 :group 'tramp
278 :type 'string) 301 :type 'string)
279 302
280(defcustom tramp-encoding-reads-stdin t 303(defcustom tramp-copy-size-limit 10240
281 "*If non-nil, encoding commands read from standard input. 304 "*The maximum file size where inline copying is preferred over an out-of-the-band copy."
282If nil, the filename is the last argument.
283
284Note that the commands always must write to standard output."
285 :group 'tramp 305 :group 'tramp
286 :type 'boolean) 306 :type 'integer)
287
288(defcustom tramp-multi-sh-program
289 tramp-encoding-shell
290 "*Use this program for bootstrapping multi-hop connections.
291This variable is similar to `tramp-encoding-shell', but it is only used
292when initializing a multi-hop connection. Therefore, the set of
293commands sent to this shell is quite restricted, and if you are
294careful it works to use CMD.EXE under Windows (instead of a Bourne-ish
295shell which does not normally exist on Windows anyway).
296
297To use multi-hop methods from Windows, you also need suitable entries
298in `tramp-multi-connection-function-alist' for the first hop.
299 307
300This variable defaults to the value of `tramp-encoding-shell'." 308(defcustom tramp-terminal-type "dumb"
309 "*Value of TERM environment variable for logging in to remote host.
310Because Tramp wants to parse the output of the remote shell, it is easily
311confused by ANSI color escape sequences and suchlike. Often, shell init
312files conditionalize this setup based on the TERM environment variable."
301 :group 'tramp 313 :group 'tramp
302 :type '(file :must-match t)) 314 :type 'string)
303 315
304;; CCC I have changed all occurrences of comint-quote-filename with 316(defvar tramp-methods
305;; tramp-shell-quote-argument, except in tramp-handle-expand-many-files. 317 `(("rcp" (tramp-login-program "rsh")
306;; There, comint-quote-filename was removed altogether. If it turns 318 (tramp-login-args (("%h") ("-l" "%u")))
307;; out to be necessary there, something will need to be done. 319 (tramp-remote-sh "/bin/sh")
308;;-(defcustom tramp-file-name-quote-list 320 (tramp-copy-program "rcp")
309;;- '(?] ?[ ?\| ?& ?< ?> ?\( ?\) ?\; ?\ ?\* ?\? ?\! ?\" ?\' ?\` ?# ?\@ ?\+ ) 321 (tramp-copy-args (("-p" "%k")))
310;;- "*Protect these characters from the remote shell. 322 (tramp-copy-keep-date t)
311;;-Any character in this list is quoted (preceded with a backslash) 323 (tramp-password-end-of-line nil))
312;;-because it means something special to the shell. This takes effect 324 ("scp" (tramp-login-program "ssh")
313;;-when sending file and directory names to the remote shell. 325 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
314;;- 326 ("-e" "none")))
315;;-See `comint-file-name-quote-list' for details." 327 (tramp-remote-sh "/bin/sh")
316;;- :group 'tramp 328 (tramp-copy-program "scp")
317;;- :type '(repeat character)) 329 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")))
318 330 (tramp-copy-keep-date t)
319(defcustom tramp-methods 331 (tramp-password-end-of-line nil)
320 '( ("rcp" (tramp-connection-function tramp-open-connection-rsh) 332 (tramp-gw-args (("-o"
321 (tramp-login-program "rsh") 333 "GlobalKnownHostsFile=/dev/null")
322 (tramp-copy-program "rcp") 334 ("-o" "UserKnownHostsFile=/dev/null")
323 (tramp-remote-sh "/bin/sh") 335 ("-o" "StrictHostKeyChecking=no")))
324 (tramp-login-args nil) 336 (tramp-default-port 22))
325 (tramp-copy-args nil) 337 ("scp1" (tramp-login-program "ssh")
326 (tramp-copy-keep-date-arg "-p") 338 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
327 (tramp-password-end-of-line nil)) 339 ("-1" "-e" "none")))
328 ("scp" (tramp-connection-function tramp-open-connection-rsh) 340 (tramp-remote-sh "/bin/sh")
329 (tramp-login-program "ssh") 341 (tramp-copy-program "scp")
330 (tramp-copy-program "scp") 342 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
331 (tramp-remote-sh "/bin/sh") 343 ("-q")))
332 (tramp-login-args ("-e" "none")) 344 (tramp-copy-keep-date t)
333 (tramp-copy-args nil) 345 (tramp-password-end-of-line nil)
334 (tramp-copy-keep-date-arg "-p") 346 (tramp-gw-args (("-o"
335 (tramp-password-end-of-line nil)) 347 "GlobalKnownHostsFile=/dev/null")
336 ("scp1" (tramp-connection-function tramp-open-connection-rsh) 348 ("-o" "UserKnownHostsFile=/dev/null")
337 (tramp-login-program "ssh") 349 ("-o" "StrictHostKeyChecking=no")))
338 (tramp-copy-program "scp") 350 (tramp-default-port 22))
339 (tramp-remote-sh "/bin/sh") 351 ("scp2" (tramp-login-program "ssh")
340 (tramp-login-args ("-1" "-e" "none")) 352 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
341 (tramp-copy-args ("-1")) 353 ("-2" "-e" "none")))
342 (tramp-copy-keep-date-arg "-p") 354 (tramp-remote-sh "/bin/sh")
343 (tramp-password-end-of-line nil)) 355 (tramp-copy-program "scp")
344 ("scp2" (tramp-connection-function tramp-open-connection-rsh) 356 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
345 (tramp-login-program "ssh") 357 ("-q")))
346 (tramp-copy-program "scp") 358 (tramp-copy-keep-date t)
347 (tramp-remote-sh "/bin/sh") 359 (tramp-password-end-of-line nil)
348 (tramp-login-args ("-2" "-e" "none")) 360 (tramp-gw-args (("-o"
349 (tramp-copy-args ("-2")) 361 "GlobalKnownHostsFile=/dev/null")
350 (tramp-copy-keep-date-arg "-p") 362 ("-o" "UserKnownHostsFile=/dev/null")
351 (tramp-password-end-of-line nil)) 363 ("-o" "StrictHostKeyChecking=no")))
352 ("scp1_old" 364 (tramp-default-port 22))
353 (tramp-connection-function tramp-open-connection-rsh) 365 ("scp1_old"
354 (tramp-login-program "ssh1") 366 (tramp-login-program "ssh1")
355 (tramp-copy-program "scp1") 367 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
356 (tramp-remote-sh "/bin/sh") 368 ("-e" "none")))
357 (tramp-login-args ("-e" "none")) 369 (tramp-remote-sh "/bin/sh")
358 (tramp-copy-args nil) 370 (tramp-copy-program "scp1")
359 (tramp-copy-keep-date-arg "-p") 371 (tramp-copy-args (("-p" "%k")))
360 (tramp-password-end-of-line nil)) 372 (tramp-copy-keep-date t)
361 ("scp2_old" 373 (tramp-password-end-of-line nil))
362 (tramp-connection-function tramp-open-connection-rsh) 374 ("scp2_old"
363 (tramp-login-program "ssh2") 375 (tramp-login-program "ssh2")
364 (tramp-copy-program "scp2") 376 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
365 (tramp-remote-sh "/bin/sh") 377 ("-e" "none")))
366 (tramp-login-args ("-e" "none")) 378 (tramp-remote-sh "/bin/sh")
367 (tramp-copy-args nil) 379 (tramp-copy-program "scp2")
368 (tramp-copy-keep-date-arg "-p") 380 (tramp-copy-args (("-p" "%k")))
369 (tramp-password-end-of-line nil)) 381 (tramp-copy-keep-date t)
370 ("rsync" (tramp-connection-function tramp-open-connection-rsh) 382 (tramp-password-end-of-line nil))
371 (tramp-login-program "ssh") 383 ("sftp" (tramp-login-program "ssh")
372 (tramp-copy-program "rsync") 384 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
373 (tramp-remote-sh "/bin/sh") 385 ("-e" "none")))
374 (tramp-login-args ("-e" "none")) 386 (tramp-remote-sh "/bin/sh")
375 (tramp-copy-args ("-e" "ssh")) 387 (tramp-copy-program "sftp")
376 (tramp-copy-keep-date-arg "-t") 388 (tramp-copy-args nil)
377 (tramp-password-end-of-line nil)) 389 (tramp-copy-keep-date nil)
378 ("remcp" (tramp-connection-function tramp-open-connection-rsh) 390 (tramp-password-end-of-line nil))
379 (tramp-login-program "remsh") 391 ("rsync" (tramp-login-program "ssh")
380 (tramp-copy-program "rcp") 392 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
381 (tramp-remote-sh "/bin/sh") 393 ("-e" "none")))
382 (tramp-login-args nil) 394 (tramp-remote-sh "/bin/sh")
383 (tramp-copy-args nil) 395 (tramp-copy-program "rsync")
384 (tramp-copy-keep-date-arg "-p") 396 (tramp-copy-args (("-e" "ssh") ("-t" "%k")))
385 (tramp-password-end-of-line nil)) 397 (tramp-copy-keep-date t)
386 ("rsh" (tramp-connection-function tramp-open-connection-rsh) 398 (tramp-password-end-of-line nil))
387 (tramp-login-program "rsh") 399 ("remcp" (tramp-login-program "remsh")
388 (tramp-copy-program nil) 400 (tramp-login-args (("%h") ("-l" "%u")))
389 (tramp-remote-sh "/bin/sh") 401 (tramp-remote-sh "/bin/sh")
390 (tramp-login-args nil) 402 (tramp-copy-program "rcp")
391 (tramp-copy-args nil) 403 (tramp-copy-args (("-p" "%k")))
392 (tramp-copy-keep-date-arg nil) 404 (tramp-copy-keep-date t)
393 (tramp-password-end-of-line nil)) 405 (tramp-password-end-of-line nil))
394 ("ssh" (tramp-connection-function tramp-open-connection-rsh) 406 ("rsh" (tramp-login-program "rsh")
395 (tramp-login-program "ssh") 407 (tramp-login-args (("%h") ("-l" "%u")))
396 (tramp-copy-program nil) 408 (tramp-remote-sh "/bin/sh")
397 (tramp-remote-sh "/bin/sh") 409 (tramp-copy-program nil)
398 (tramp-login-args ("-e" "none")) 410 (tramp-copy-args nil)
399 (tramp-copy-args nil) 411 (tramp-copy-keep-date nil)
400 (tramp-copy-keep-date-arg nil) 412 (tramp-password-end-of-line nil))
401 (tramp-password-end-of-line nil)) 413 ("ssh" (tramp-login-program "ssh")
402 ("ssh1" (tramp-connection-function tramp-open-connection-rsh) 414 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
403 (tramp-login-program "ssh") 415 ("-e" "none")))
404 (tramp-copy-program nil) 416 (tramp-remote-sh "/bin/sh")
405 (tramp-remote-sh "/bin/sh") 417 (tramp-copy-program nil)
406 (tramp-login-args ("-1" "-e" "none")) 418 (tramp-copy-args nil)
407 (tramp-copy-args ("-1")) 419 (tramp-copy-keep-date nil)
408 (tramp-copy-keep-date-arg nil) 420 (tramp-password-end-of-line nil)
409 (tramp-password-end-of-line nil)) 421 (tramp-gw-args (("-o"
410 ("ssh2" (tramp-connection-function tramp-open-connection-rsh) 422 "GlobalKnownHostsFile=/dev/null")
411 (tramp-login-program "ssh") 423 ("-o" "UserKnownHostsFile=/dev/null")
412 (tramp-copy-program nil) 424 ("-o" "StrictHostKeyChecking=no")))
413 (tramp-remote-sh "/bin/sh") 425 (tramp-default-port 22))
414 (tramp-login-args ("-2" "-e" "none")) 426 ("ssh1" (tramp-login-program "ssh")
415 (tramp-copy-args ("-2")) 427 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
416 (tramp-copy-keep-date-arg nil) 428 ("-1" "-e" "none")))
417 (tramp-password-end-of-line nil)) 429 (tramp-remote-sh "/bin/sh")
418 ("ssh1_old" 430 (tramp-copy-program nil)
419 (tramp-connection-function tramp-open-connection-rsh) 431 (tramp-copy-args nil)
420 (tramp-login-program "ssh1") 432 (tramp-copy-keep-date nil)
421 (tramp-copy-program nil) 433 (tramp-password-end-of-line nil)
422 (tramp-remote-sh "/bin/sh") 434 (tramp-gw-args (("-o"
423 (tramp-login-args ("-e" "none")) 435 "GlobalKnownHostsFile=/dev/null")
424 (tramp-copy-args nil) 436 ("-o" "UserKnownHostsFile=/dev/null")
425 (tramp-copy-keep-date-arg nil) 437 ("-o" "StrictHostKeyChecking=no")))
426 (tramp-password-end-of-line nil)) 438 (tramp-default-port 22))
427 ("ssh2_old" 439 ("ssh2" (tramp-login-program "ssh")
428 (tramp-connection-function tramp-open-connection-rsh) 440 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
429 (tramp-login-program "ssh2") 441 ("-2" "-e" "none")))
430 (tramp-copy-program nil) 442 (tramp-remote-sh "/bin/sh")
431 (tramp-remote-sh "/bin/sh") 443 (tramp-copy-program nil)
432 (tramp-login-args ("-e" "none")) 444 (tramp-copy-args nil)
433 (tramp-copy-args nil) 445 (tramp-copy-keep-date nil)
434 (tramp-copy-keep-date-arg nil) 446 (tramp-password-end-of-line nil)
435 (tramp-password-end-of-line nil)) 447 (tramp-gw-args (("-o"
436 ("remsh" (tramp-connection-function tramp-open-connection-rsh) 448 "GlobalKnownHostsFile=/dev/null")
437 (tramp-login-program "remsh") 449 ("-o" "UserKnownHostsFile=/dev/null")
438 (tramp-copy-program nil) 450 ("-o" "StrictHostKeyChecking=no")))
439 (tramp-remote-sh "/bin/sh") 451 (tramp-default-port 22))
440 (tramp-login-args nil) 452 ("ssh1_old"
441 (tramp-copy-args nil) 453 (tramp-login-program "ssh1")
442 (tramp-copy-keep-date-arg nil) 454 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
443 (tramp-password-end-of-line nil)) 455 ("-e" "none")))
444 ("telnet" 456 (tramp-remote-sh "/bin/sh")
445 (tramp-connection-function tramp-open-connection-telnet) 457 (tramp-copy-program nil)
446 (tramp-login-program "telnet") 458 (tramp-copy-args nil)
447 (tramp-copy-program nil) 459 (tramp-copy-keep-date nil)
448 (tramp-remote-sh "/bin/sh") 460 (tramp-password-end-of-line nil))
449 (tramp-login-args nil) 461 ("ssh2_old"
450 (tramp-copy-args nil) 462 (tramp-login-program "ssh2")
451 (tramp-copy-keep-date-arg nil) 463 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
452 (tramp-password-end-of-line nil)) 464 ("-e" "none")))
453 ("su" (tramp-connection-function tramp-open-connection-su) 465 (tramp-remote-sh "/bin/sh")
454 (tramp-login-program "su") 466 (tramp-copy-program nil)
455 (tramp-copy-program nil) 467 (tramp-copy-args nil)
456 (tramp-remote-sh "/bin/sh") 468 (tramp-copy-keep-date nil)
457 (tramp-login-args ("-" "%u")) 469 (tramp-password-end-of-line nil))
458 (tramp-copy-args nil) 470 ("remsh" (tramp-login-program "remsh")
459 (tramp-copy-keep-date-arg nil) 471 (tramp-login-args (("%h") ("-l" "%u")))
460 (tramp-password-end-of-line nil)) 472 (tramp-remote-sh "/bin/sh")
461 ("sudo" (tramp-connection-function tramp-open-connection-su) 473 (tramp-copy-program nil)
462 (tramp-login-program "sudo") 474 (tramp-copy-args nil)
463 (tramp-copy-program nil) 475 (tramp-copy-keep-date nil)
464 (tramp-remote-sh "/bin/sh") 476 (tramp-password-end-of-line nil))
465 (tramp-login-args ("-u" "%u" "-s" 477 ("telnet"
466 "-p" "Password:")) 478 (tramp-login-program "telnet")
467 (tramp-copy-args nil) 479 (tramp-login-args (("%h") ("%p")))
468 (tramp-copy-keep-date-arg nil) 480 (tramp-remote-sh "/bin/sh")
469 (tramp-password-end-of-line nil)) 481 (tramp-copy-program nil)
470 ("multi" (tramp-connection-function tramp-open-connection-multi) 482 (tramp-copy-args nil)
471 (tramp-login-program nil) 483 (tramp-copy-keep-date nil)
472 (tramp-copy-program nil) 484 (tramp-password-end-of-line nil)
473 (tramp-remote-sh "/bin/sh") 485 (tramp-default-port 23))
474 (tramp-login-args nil) 486 ("su" (tramp-login-program "su")
475 (tramp-copy-args nil) 487 (tramp-login-args (("-") ("%u")))
476 (tramp-copy-keep-date-arg nil) 488 (tramp-remote-sh "/bin/sh")
477 (tramp-password-end-of-line nil)) 489 (tramp-copy-program nil)
478 ("scpc" (tramp-connection-function tramp-open-connection-rsh) 490 (tramp-copy-args nil)
479 (tramp-login-program "ssh") 491 (tramp-copy-keep-date nil)
480 (tramp-copy-program "scp") 492 (tramp-password-end-of-line nil))
481 (tramp-remote-sh "/bin/sh") 493 ("sudo" (tramp-login-program "sudo")
482 (tramp-login-args ("-o" "ControlPath=%t.%%r@%%h:%%p" 494 (tramp-login-args (("-u" "%u")
483 "-o" "ControlMaster=yes" 495 ("-s" "-p" "Password:")))
484 "-e" "none")) 496 (tramp-remote-sh "/bin/sh")
485 (tramp-copy-args ("-o" "ControlPath=%t.%%r@%%h:%%p" 497 (tramp-copy-program nil)
486 "-o" "ControlMaster=auto")) 498 (tramp-copy-args nil)
487 (tramp-copy-keep-date-arg "-p") 499 (tramp-copy-keep-date nil)
488 (tramp-password-end-of-line nil)) 500 (tramp-password-end-of-line nil))
489 ("scpx" (tramp-connection-function tramp-open-connection-rsh) 501 ("scpc" (tramp-login-program "ssh")
490 (tramp-login-program "ssh") 502 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
491 (tramp-copy-program "scp") 503 ("-o" "ControlPath=%t.%%r@%%h:%%p")
492 (tramp-remote-sh "/bin/sh") 504 ("-o" "ControlMaster=yes")
493 (tramp-login-args ("-e" "none" "-t" "-t" "/bin/sh")) 505 ("-e" "none")))
494 (tramp-copy-args nil) 506 (tramp-remote-sh "/bin/sh")
495 (tramp-copy-keep-date-arg "-p") 507 (tramp-copy-program "scp")
496 (tramp-password-end-of-line nil)) 508 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
497 ("sshx" (tramp-connection-function tramp-open-connection-rsh) 509 ("-o" "ControlPath=%t.%%r@%%h:%%p")
498 (tramp-login-program "ssh") 510 ("-o" "ControlMaster=auto")))
499 (tramp-copy-program nil) 511 (tramp-copy-keep-date t)
500 (tramp-remote-sh "/bin/sh") 512 (tramp-password-end-of-line nil)
501 (tramp-login-args ("-e" "none" "-t" "-t" "/bin/sh")) 513 (tramp-gw-args (("-o"
502 (tramp-copy-args nil) 514 "GlobalKnownHostsFile=/dev/null")
503 (tramp-copy-keep-date-arg nil) 515 ("-o" "UserKnownHostsFile=/dev/null")
504 (tramp-password-end-of-line nil)) 516 ("-o" "StrictHostKeyChecking=no")))
505 ("krlogin" 517 (tramp-default-port 22))
506 (tramp-connection-function tramp-open-connection-rsh) 518 ("scpx" (tramp-login-program "ssh")
507 (tramp-login-program "krlogin") 519 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
508 (tramp-copy-program nil) 520 ("-e" "none" "-t" "-t" "/bin/sh")))
509 (tramp-remote-sh "/bin/sh") 521 (tramp-remote-sh "/bin/sh")
510 (tramp-login-args ("-x")) 522 (tramp-copy-program "scp")
511 (tramp-copy-args nil) 523 (tramp-copy-args (("-p" "%k")))
512 (tramp-copy-keep-date-arg nil) 524 (tramp-copy-keep-date t)
513 (tramp-password-end-of-line nil)) 525 (tramp-password-end-of-line nil)
514 ("plink" 526 (tramp-gw-args (("-o"
515 (tramp-connection-function tramp-open-connection-rsh) 527 "GlobalKnownHostsFile=/dev/null")
516 (tramp-login-program "plink") 528 ("-o" "UserKnownHostsFile=/dev/null")
517 (tramp-copy-program nil) 529 ("-o" "StrictHostKeyChecking=no")))
518 (tramp-remote-sh "/bin/sh") 530 (tramp-default-port 22))
519 (tramp-login-args ("-ssh")) ;optionally add "-v" 531 ("sshx" (tramp-login-program "ssh")
520 (tramp-copy-args nil) 532 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
521 (tramp-copy-keep-date-arg nil) 533 ("-e" "none" "-t" "-t" "/bin/sh")))
522 (tramp-password-end-of-line "xy")) ;see docstring for "xy" 534 (tramp-remote-sh "/bin/sh")
523 ("plink1" 535 (tramp-copy-program nil)
524 (tramp-connection-function tramp-open-connection-rsh) 536 (tramp-copy-args nil)
525 (tramp-login-program "plink") 537 (tramp-copy-keep-date nil)
526 (tramp-copy-program nil) 538 (tramp-password-end-of-line nil)
527 (tramp-remote-sh "/bin/sh") 539 (tramp-gw-args (("-o"
528 (tramp-login-args ("-1" "-ssh")) ;optionally add "-v" 540 "GlobalKnownHostsFile=/dev/null")
529 (tramp-copy-args nil) 541 ("-o" "UserKnownHostsFile=/dev/null")
530 (tramp-copy-keep-date-arg nil) 542 ("-o" "StrictHostKeyChecking=no")))
531 (tramp-password-end-of-line "xy")) ;see docstring for "xy" 543 (tramp-default-port 22))
532 ("pscp" 544 ("krlogin"
533 (tramp-connection-function tramp-open-connection-rsh) 545 (tramp-login-program "krlogin")
534 (tramp-login-program "plink") 546 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
535 (tramp-copy-program "pscp") 547 (tramp-remote-sh "/bin/sh")
536 (tramp-remote-sh "/bin/sh") 548 (tramp-copy-program nil)
537 (tramp-login-args ("-ssh")) 549 (tramp-copy-args nil)
538 (tramp-copy-args nil) 550 (tramp-copy-keep-date nil)
539 (tramp-copy-keep-date-arg "-p") 551 (tramp-password-end-of-line nil))
540 (tramp-password-end-of-line "xy")) ;see docstring for "xy" 552 ("plink" (tramp-login-program "plink")
541 ("fcp" 553 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
542 (tramp-connection-function tramp-open-connection-rsh) 554 ("-ssh")))
543 (tramp-login-program "fsh") 555 (tramp-remote-sh "/bin/sh")
544 (tramp-copy-program "fcp") 556 (tramp-copy-program nil)
545 (tramp-remote-sh "/bin/sh -i") 557 (tramp-copy-args nil)
546 (tramp-login-args ("sh" "-i")) 558 (tramp-copy-keep-date nil)
547 (tramp-copy-args nil) 559 (tramp-password-end-of-line "xy") ;see docstring for "xy"
548 (tramp-copy-keep-date-arg "-p") 560 (tramp-default-port 22))
549 (tramp-password-end-of-line nil)) 561 ("plink1"
550 ) 562 (tramp-login-program "plink")
563 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
564 ("-1" "-ssh")))
565 (tramp-remote-sh "/bin/sh")
566 (tramp-copy-program nil)
567 (tramp-copy-args nil)
568 (tramp-copy-keep-date nil)
569 (tramp-password-end-of-line "xy") ;see docstring for "xy"
570 (tramp-default-port 22))
571 ("plinkx"
572 (tramp-login-program "plink")
573 (tramp-login-args (("-load" "%h") ("-t")
574 (,(format "env 'TERM=%s' 'PS1=$ '"
575 tramp-terminal-type))
576 ("/bin/sh")))
577 (tramp-remote-sh "/bin/sh")
578 (tramp-copy-program nil)
579 (tramp-copy-args nil)
580 (tramp-copy-keep-date nil)
581 (tramp-password-end-of-line nil))
582 ("pscp" (tramp-login-program "plink")
583 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
584 ("-ssh")))
585 (tramp-remote-sh "/bin/sh")
586 (tramp-copy-program "pscp")
587 (tramp-copy-args (("-scp") ("-p" "%k")))
588 (tramp-copy-keep-date t)
589 (tramp-password-end-of-line "xy") ;see docstring for "xy"
590 (tramp-default-port 22))
591 ("psftp" (tramp-login-program "plink")
592 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
593 ("-ssh")))
594 (tramp-remote-sh "/bin/sh")
595 (tramp-copy-program "pscp")
596 (tramp-copy-args (("-psftp") ("-p" "%k")))
597 (tramp-copy-keep-date t)
598 (tramp-password-end-of-line "xy")) ;see docstring for "xy"
599 ("fcp" (tramp-login-program "fsh")
600 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
601 (tramp-remote-sh "/bin/sh -i")
602 (tramp-copy-program "fcp")
603 (tramp-copy-args (("-p" "%k")))
604 (tramp-copy-keep-date t)
605 (tramp-password-end-of-line nil)))
551 "*Alist of methods for remote files. 606 "*Alist of methods for remote files.
552This is a list of entries of the form (NAME PARAM1 PARAM2 ...). 607This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
553Each NAME stands for a remote access method. Each PARAM is a 608Each NAME stands for a remote access method. Each PARAM is a
554pair of the form (KEY VALUE). The following KEYs are defined: 609pair of the form (KEY VALUE). The following KEYs are defined:
555 * `tramp-connection-function'
556 This specifies the function to use to connect to the remote host.
557 Currently, `tramp-open-connection-rsh', `tramp-open-connection-telnet'
558 and `tramp-open-connection-su' are defined. See the documentation
559 of these functions for more details.
560 * `tramp-remote-sh' 610 * `tramp-remote-sh'
561 This specifies the Bourne shell to use on the remote host. This 611 This specifies the Bourne shell to use on the remote host. This
562 MUST be a Bourne-like shell. It is normally not necessary to set 612 MUST be a Bourne-like shell. It is normally not necessary to set
@@ -566,21 +616,22 @@ pair of the form (KEY VALUE). The following KEYs are defined:
566 the value that you decide to use. You Have Been Warned. 616 the value that you decide to use. You Have Been Warned.
567 * `tramp-login-program' 617 * `tramp-login-program'
568 This specifies the name of the program to use for logging in to the 618 This specifies the name of the program to use for logging in to the
569 remote host. Depending on `tramp-connection-function', this may be 619 remote host. This may be the name of rsh or a workalike program,
570 the name of rsh or a workalike program (when 620 or the name of telnet or a workalike, or the name of su or a workalike.
571 `tramp-connection-function' is `tramp-open-connection-rsh'), or the
572 name of telnet or a workalike (for `tramp-open-connection-telnet'),
573 or the name of su or a workalike (for `tramp-open-connection-su').
574 * `tramp-login-args' 621 * `tramp-login-args'
575 This specifies the list of arguments to pass to the above 622 This specifies the list of arguments to pass to the above
576 mentioned program. Please note that this is a list of arguments, 623 mentioned program. Please note that this is a list of list of arguments,
577 that is, normally you don't want to put \"-a -b\" or \"-f foo\" 624 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
578 here. Instead, you want two list elements, one for \"-a\" and one 625 here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
579 for \"-b\", or one for \"-f\" and one for \"foo\". 626 There are some patterns: \"%h\" in this list is replaced by the host
580 If `tramp-connection-function' is `tramp-open-connection-su', then 627 name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
581 \"%u\" in this list is replaced by the user name, and \"%%\" can 628 port number, and \"%%\" can be used to obtain a literal percent character.
582 be used to obtain a literal percent character. 629 If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
583 \"%t\" is replaced by the temporary file name for `scp'-like methods. 630 expansion (i.e. no host or no user specified), this list is not used as
631 argument. By this, arguments like (\"-l\" \"%u\") are optional.
632 \"%t\" is replaced by the temporary file name produced with
633 `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
634 parameter of a program, if exists.
584 * `tramp-copy-program' 635 * `tramp-copy-program'
585 This specifies the name of the program to use for remotely copying 636 This specifies the name of the program to use for remotely copying
586 the file; this might be the absolute filename of rcp or the name of 637 the file; this might be the absolute filename of rcp or the name of
@@ -588,10 +639,16 @@ pair of the form (KEY VALUE). The following KEYs are defined:
588 * `tramp-copy-args' 639 * `tramp-copy-args'
589 This specifies the list of parameters to pass to the above mentioned 640 This specifies the list of parameters to pass to the above mentioned
590 program, the hints for `tramp-login-args' also apply here. 641 program, the hints for `tramp-login-args' also apply here.
591 * `tramp-copy-keep-date-arg' 642 * `tramp-copy-keep-date'
592 This specifies the parameter to use for the copying program when the 643 This specifies whether the copying program when the preserves the
593 timestamp of the original file should be kept. For `rcp', use `-p', for 644 timestamp of the original file.
594 `rsync', use `-t'. 645 * `tramp-default-port'
646 The default port of a method is needed in case of gateway connections.
647 Additionally, it is used as indication which method is prepared for
648 passing gateways.
649 * `tramp-gw-args'
650 As the attribute name says, additional arguments are specified here
651 when a method is applied via a gateway.
595 * `tramp-password-end-of-line' 652 * `tramp-password-end-of-line'
596 This specifies the string to use for terminating the line after 653 This specifies the string to use for terminating the line after
597 submitting the password. If this method parameter is nil, then the 654 submitting the password. If this method parameter is nil, then the
@@ -613,78 +670,22 @@ file is passed through the same buffer used by `tramp-login-program'. In
613this case, the file contents need to be protected since the 670this case, the file contents need to be protected since the
614`tramp-login-program' might use escape codes or the connection might not 671`tramp-login-program' might use escape codes or the connection might not
615be eight-bit clean. Therefore, file contents are encoded for transit. 672be eight-bit clean. Therefore, file contents are encoded for transit.
616See the variable `tramp-coding-commands' for details. 673See the variables `tramp-local-coding-commands' and
674`tramp-remote-coding-commands' for details.
617 675
618So, to summarize: if the method is an out-of-band method, then you 676So, to summarize: if the method is an out-of-band method, then you
619must specify `tramp-copy-program' and `tramp-copy-args'. If it is an 677must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
620inline method, then these two parameters should be nil. Every method, 678inline method, then these two parameters should be nil. Methods which
621inline or out of band, must specify `tramp-connection-function' plus 679are fit for gateways must have `tramp-default-port' at least.
622the associated arguments (for example, the login program if you chose
623`tramp-open-connection-telnet').
624 680
625Notes: 681Notes:
626 682
627When using `tramp-open-connection-su' the phrase `open connection to a 683When using `su' or `sudo' the phrase `open connection to a remote
628remote host' sounds strange, but it is used nevertheless, for 684host' sounds strange, but it is used nevertheless, for consistency.
629consistency. No connection is opened to a remote host, but `su' is 685No connection is opened to a remote host, but `su' or `sudo' is
630started on the local host. You are not allowed to specify a remote 686started on the local host. You should specify a remote host
631host other than `localhost' or the name of the local host." 687`localhost' or the name of the local host. Another host name is
632 :group 'tramp 688useful only in combination with `tramp-default-proxies-alist'.")
633 :type '(repeat
634 (cons string
635 (set (list (const tramp-connection-function) function)
636 (list (const tramp-login-program)
637 (choice (const nil) string))
638 (list (const tramp-copy-program)
639 (choice (const nil) string))
640 (list (const tramp-remote-sh)
641 (choice (const nil) string))
642 (list (const tramp-login-args) (repeat string))
643 (list (const tramp-copy-args) (repeat string))
644 (list (const tramp-copy-keep-date-arg)
645 (choice (const nil) string))
646 (list (const tramp-encoding-command)
647 (choice (const nil) string))
648 (list (const tramp-decoding-command)
649 (choice (const nil) string))
650 (list (const tramp-encoding-function)
651 (choice (const nil) function))
652 (list (const tramp-decoding-function)
653 (choice (const nil) function))
654 (list (const tramp-password-end-of-line)
655 (choice (const nil) string))))))
656
657(defcustom tramp-multi-methods '("multi" "multiu")
658 "*List of multi-hop methods.
659Each entry in this list should be a method name as mentioned in the
660variable `tramp-methods'."
661 :group 'tramp
662 :type '(repeat string))
663
664(defcustom tramp-multi-connection-function-alist
665 '(("telnet" tramp-multi-connect-telnet "telnet %h%n")
666 ("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
667 ("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n")
668 ("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
669 ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
670 ("su" tramp-multi-connect-su "su - %u%n")
671 ("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n"))
672 "*List of connection functions for multi-hop methods.
673Each list item is a list of three items (METHOD FUNCTION COMMAND),
674where METHOD is the name as used in the file name, FUNCTION is the
675function to be executed, and COMMAND is the shell command used for
676connecting.
677
678COMMAND may contain percent escapes. `%u' will be replaced with the
679user name, `%h' will be replaced with the host name, and `%n' will be
680replaced with an end-of-line character, as specified in the variable
681`tramp-rsh-end-of-line'. Use `%%' for a literal percent character.
682Note that the interpretation of the percent escapes also depends on
683the FUNCTION. For example, the `%u' escape is forbidden with the
684function `tramp-multi-connect-telnet'. See the documentation of the
685various functions for details."
686 :group 'tramp
687 :type '(repeat (list string function string)))
688 689
689(defcustom tramp-default-method 690(defcustom tramp-default-method
690 ;; An external copy method seems to be preferred, because it is much 691 ;; An external copy method seems to be preferred, because it is much
@@ -696,30 +697,26 @@ various functions for details."
696 ;; another good choice because of the "ControlMaster" option, but 697 ;; another good choice because of the "ControlMaster" option, but
697 ;; this is a more modern alternative in OpenSSH 4, which cannot be 698 ;; this is a more modern alternative in OpenSSH 4, which cannot be
698 ;; taken as default. 699 ;; taken as default.
699 (let ((e-f (fboundp 'executable-find))) 700 (cond
700 (cond 701 ;; PuTTY is installed.
701 ;; PuTTY is installed. 702 ((executable-find "pscp")
702 ((and e-f (funcall 'executable-find "pscp")) 703 (if (or (fboundp 'password-read)
703 (if (or (fboundp 'password-read) 704 ;; Pageant is running.
704 ;; Pageant is running. 705 (and (fboundp 'w32-window-exists-p)
705 (and (fboundp 'w32-window-exists-p) 706 (funcall (symbol-function 'w32-window-exists-p)
706 (funcall 'w32-window-exists-p "Pageant" "Pageant"))) 707 "Pageant" "Pageant")))
707 "pscp" 708 "pscp"
708 "plink")) 709 "plink"))
709 ;; There is an ssh installation. 710 ;; There is an ssh installation.
710 ((and e-f (funcall 'executable-find "scp")) 711 ((executable-find "scp")
711 (if (or (fboundp 'password-read) 712 (if (or (fboundp 'password-read)
712 ;; ssh-agent is running. 713 ;; ssh-agent is running.
713 (getenv "SSH_AUTH_SOCK") 714 (getenv "SSH_AUTH_SOCK")
714 (getenv "SSH_AGENT_PID")) 715 (getenv "SSH_AGENT_PID"))
715 "scp" 716 "scp"
716 "ssh")) 717 "ssh"))
717 ;; Under Emacs 20, `executable-find' does not exists. So we 718 ;; Fallback.
718 ;; couldn't check whether there is an ssh implementation. Let's 719 (t "ftp"))
719 ;; hope the best.
720 ((not e-f) "ssh")
721 ;; Fallback.
722 (t "ftp")))
723 "*Default method to use for transferring files. 720 "*Default method to use for transferring files.
724See `tramp-methods' for possibilities. 721See `tramp-methods' for possibilities.
725Also see `tramp-default-method-alist'." 722Also see `tramp-default-method-alist'."
@@ -728,7 +725,7 @@ Also see `tramp-default-method-alist'."
728 725
729(defcustom tramp-default-method-alist 726(defcustom tramp-default-method-alist
730 '(("\\`localhost\\'" "\\`root\\'" "su")) 727 '(("\\`localhost\\'" "\\`root\\'" "su"))
731 "*Default method to use for specific user/host pairs. 728 "*Default method to use for specific host/user pairs.
732This is an alist of items (HOST USER METHOD). The first matching item 729This is an alist of items (HOST USER METHOD). The first matching item
733specifies the method to use for a file name which does not specify a 730specifies the method to use for a file name which does not specify a
734method. HOST and USER are regular expressions or nil, which is 731method. HOST and USER are regular expressions or nil, which is
@@ -744,42 +741,90 @@ See `tramp-methods' for a list of possibilities for METHOD."
744 (regexp :tag "User regexp") 741 (regexp :tag "User regexp")
745 (string :tag "Method")))) 742 (string :tag "Method"))))
746 743
747;; Default values for non-Unices seeked 744(defcustom tramp-default-user
745 nil
746 "*Default user to use for transferring files.
747It is nil by default; otherwise settings in configuration files like
748\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
749
750This variable is regarded as obsolete, and will be removed soon."
751 :group 'tramp
752 :type '(choice (const nil) string))
753
754(defcustom tramp-default-user-alist
755 `(("\\`su\\(do\\)?\\'" nil "root")
756 ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
757 nil ,(user-login-name)))
758 "*Default user to use for specific method/host pairs.
759This is an alist of items (METHOD HOST USER). The first matching item
760specifies the user to use for a file name which does not specify a
761user. METHOD and USER are regular expressions or nil, which is
762interpreted as a regular expression which always matches. If no entry
763matches, the variable `tramp-default-user' takes effect.
764
765If the file name does not specify the method, lookup is done using the
766empty string for the method name."
767 :group 'tramp
768 :type '(repeat (list (regexp :tag "Method regexp")
769 (regexp :tag "Host regexp")
770 (string :tag "User"))))
771
772(defcustom tramp-default-host
773 (system-name)
774 "*Default host to use for transferring files.
775Useful for su and sudo methods mostly."
776 :group 'tramp
777 :type 'string)
778
779(defcustom tramp-default-proxies-alist nil
780 "*Route to be followed for specific host/user pairs.
781This is an alist of items (HOST USER PROXY). The first matching
782item specifies the proxy to be passed for a file name located on
783a remote target matching USER@HOST. HOST and USER are regular
784expressions or nil, which is interpreted as a regular expression
785which always matches. PROXY must be a Tramp filename without a
786localname part. Method and user name on PROXY are optional,
787which is interpreted with the default values. PROXY can contain
788the patterns %h and %u, which are replaced by the strings
789matching HOST or USER, respectively."
790 :group 'tramp
791 :type '(repeat (list (regexp :tag "Host regexp")
792 (regexp :tag "User regexp")
793 (string :tag "Proxy remote name"))))
794
748(defconst tramp-completion-function-alist-rsh 795(defconst tramp-completion-function-alist-rsh
749 (unless (memq system-type '(windows-nt)) 796 '((tramp-parse-rhosts "/etc/hosts.equiv")
750 '((tramp-parse-rhosts "/etc/hosts.equiv") 797 (tramp-parse-rhosts "~/.rhosts"))
751 (tramp-parse-rhosts "~/.rhosts")))
752 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.") 798 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
753 799
754;; Default values for non-Unices seeked
755(defconst tramp-completion-function-alist-ssh 800(defconst tramp-completion-function-alist-ssh
756 (unless (memq system-type '(windows-nt)) 801 '((tramp-parse-rhosts "/etc/hosts.equiv")
757 '((tramp-parse-rhosts "/etc/hosts.equiv") 802 (tramp-parse-rhosts "/etc/shosts.equiv")
758 (tramp-parse-rhosts "/etc/shosts.equiv") 803 (tramp-parse-shosts "/etc/ssh_known_hosts")
759 (tramp-parse-shosts "/etc/ssh_known_hosts") 804 (tramp-parse-sconfig "/etc/ssh_config")
760 (tramp-parse-sconfig "/etc/ssh_config") 805 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
761 (tramp-parse-shostkeys "/etc/ssh2/hostkeys") 806 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
762 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") 807 (tramp-parse-rhosts "~/.rhosts")
763 (tramp-parse-rhosts "~/.rhosts") 808 (tramp-parse-rhosts "~/.shosts")
764 (tramp-parse-rhosts "~/.shosts") 809 (tramp-parse-shosts "~/.ssh/known_hosts")
765 (tramp-parse-shosts "~/.ssh/known_hosts") 810 (tramp-parse-sconfig "~/.ssh/config")
766 (tramp-parse-sconfig "~/.ssh/config") 811 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
767 (tramp-parse-shostkeys "~/.ssh2/hostkeys") 812 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
768 (tramp-parse-sknownhosts "~/.ssh2/knownhosts")))
769 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") 813 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
770 814
771;; Default values for non-Unices seeked
772(defconst tramp-completion-function-alist-telnet 815(defconst tramp-completion-function-alist-telnet
773 (unless (memq system-type '(windows-nt)) 816 '((tramp-parse-hosts "/etc/hosts"))
774 '((tramp-parse-hosts "/etc/hosts")))
775 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.") 817 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
776 818
777;; Default values for non-Unices seeked
778(defconst tramp-completion-function-alist-su 819(defconst tramp-completion-function-alist-su
779 (unless (memq system-type '(windows-nt)) 820 '((tramp-parse-passwd "/etc/passwd"))
780 '((tramp-parse-passwd "/etc/passwd")))
781 "Default list of (FUNCTION FILE) pairs to be examined for su methods.") 821 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
782 822
823(defconst tramp-completion-function-alist-putty
824 '((tramp-parse-putty
825 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
826 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
827
783(defvar tramp-completion-function-alist nil 828(defvar tramp-completion-function-alist nil
784 "*Alist of methods for remote files. 829 "*Alist of methods for remote files.
785This is a list of entries of the form (NAME PAIR1 PAIR2 ...). 830This is a list of entries of the form (NAME PAIR1 PAIR2 ...).
@@ -795,6 +840,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists:
795 * `tramp-parse-hosts' for \"/etc/hosts\" like files, 840 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
796 * `tramp-parse-passwd' for \"/etc/passwd\" like files. 841 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
797 * `tramp-parse-netrc' for \"~/.netrc\" like files. 842 * `tramp-parse-netrc' for \"~/.netrc\" like files.
843 * `tramp-parse-putty' for PuTTY registry keys.
798 844
799FUNCTION can also be a customer defined function. For more details see 845FUNCTION can also be a customer defined function. For more details see
800the info pages.") 846the info pages.")
@@ -838,8 +884,6 @@ the info pages.")
838 (tramp-set-completion-function 884 (tramp-set-completion-function
839 "sudo" tramp-completion-function-alist-su) 885 "sudo" tramp-completion-function-alist-su)
840 (tramp-set-completion-function 886 (tramp-set-completion-function
841 "multi" nil)
842 (tramp-set-completion-function
843 "scpx" tramp-completion-function-alist-ssh) 887 "scpx" tramp-completion-function-alist-ssh)
844 (tramp-set-completion-function 888 (tramp-set-completion-function
845 "sshx" tramp-completion-function-alist-ssh) 889 "sshx" tramp-completion-function-alist-ssh)
@@ -850,10 +894,26 @@ the info pages.")
850 (tramp-set-completion-function 894 (tramp-set-completion-function
851 "plink1" tramp-completion-function-alist-ssh) 895 "plink1" tramp-completion-function-alist-ssh)
852 (tramp-set-completion-function 896 (tramp-set-completion-function
897 "plinkx" tramp-completion-function-alist-putty)
898 (tramp-set-completion-function
853 "pscp" tramp-completion-function-alist-ssh) 899 "pscp" tramp-completion-function-alist-ssh)
854 (tramp-set-completion-function 900 (tramp-set-completion-function
855 "fcp" tramp-completion-function-alist-ssh))) 901 "fcp" tramp-completion-function-alist-ssh)))
856 902
903(defconst tramp-echo-mark "_echo\b\b\b\b\b"
904 "String mark to be transmitted around shell commands.
905Used to separate their echo from the output they produce. This
906will only be used if we cannot disable remote echo via stty.
907This string must have no effect on the remote shell except for
908producing some echo which can later be detected by
909`tramp-echoed-echo-mark-regexp'. Using some characters followed
910by an equal number of backspaces to erase them will usually
911suffice.")
912
913(defconst tramp-echoed-echo-mark-regexp "_echo\\(\b\\( \b\\)?\\)\\{5\\}"
914 "Regexp which matches `tramp-echo-mark' as it gets echoed by
915the remote shell.")
916
857(defcustom tramp-rsh-end-of-line "\n" 917(defcustom tramp-rsh-end-of-line "\n"
858 "*String used for end of line in rsh connections. 918 "*String used for end of line in rsh connections.
859I don't think this ever needs to be changed, so please tell me about it 919I don't think this ever needs to be changed, so please tell me about it
@@ -878,17 +938,53 @@ The default value is to use the same value as `tramp-rsh-end-of-line'."
878 :group 'tramp 938 :group 'tramp
879 :type 'string) 939 :type 'string)
880 940
941;; "getconf PATH" yields:
942;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
943;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
944;; Linux (Debian, Suse): /bin:/usr/bin
945;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
881(defcustom tramp-remote-path 946(defcustom tramp-remote-path
882 ;; "/usr/xpg4/bin" has been placed first, because on Solaris a POSIX 947 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
883 ;; compatible "id" is needed. 948 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
884 '("/usr/xpg4/bin" "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
885 "/usr/ccs/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
886 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin") 949 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
887 "*List of directories to search for executables on remote host. 950 "*List of directories to search for executables on remote host.
888Please notify me about other semi-standard directories to include here. 951For every remote host, this variable will be set buffer local,
952keeping the list of existing directories on that host.
889 953
890You can use `~' in this list, but when searching for a shell which groks 954You can use `~' in this list, but when searching for a shell which groks
891tilde expansion, all directory names starting with `~' will be ignored." 955tilde expansion, all directory names starting with `~' will be ignored.
956
957`Default Directories' represent the list of directories given by
958the command \"getconf PATH\". It is recommended to use this
959entry on top of this list, because these are the default
960directories for POSIX compatible commands."
961 :group 'tramp
962 :type '(repeat (choice
963 (const :tag "Default Directories" tramp-default-remote-path)
964 (string :tag "Directory"))))
965
966(defcustom tramp-terminal-type "dumb"
967 "*Value of TERM environment variable for logging in to remote host.
968Because Tramp wants to parse the output of the remote shell, it is easily
969confused by ANSI color escape sequences and suchlike. Often, shell init
970files conditionalize this setup based on the TERM environment variable."
971 :group 'tramp
972 :type 'string)
973
974(defcustom tramp-remote-process-environment
975 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_TIME=C"
976 ,(concat "TERM=" tramp-terminal-type)
977 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
978 "autocorrect=" "correct=")
979
980 "*List of environment variables to be set on the remote host.
981
982Each element should be a string of the form ENVVARNAME=VALUE. An
983entry ENVVARNAME= diables the corresponding environment variable,
984which might have been set in the init files like ~/.profile.
985
986Special handling is applied to the PATH environment, which should
987not be set here. Instead of, it should be set via `tramp-remote-path'."
892 :group 'tramp 988 :group 'tramp
893 :type '(repeat string)) 989 :type '(repeat string))
894 990
@@ -915,7 +1011,7 @@ which should work well in many cases."
915 :type 'regexp) 1011 :type 'regexp)
916 1012
917(defcustom tramp-password-prompt-regexp 1013(defcustom tramp-password-prompt-regexp
918 "^.*\\([pP]assword\\|passphrase\\).*:\^@? *" 1014 "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
919 "*Regexp matching password-like prompts. 1015 "*Regexp matching password-like prompts.
920The regexp should match at end of buffer. 1016The regexp should match at end of buffer.
921 1017
@@ -930,10 +1026,12 @@ The `sudo' program appears to insert a `^@' character into the prompt."
930 "Login incorrect" 1026 "Login incorrect"
931 "Login Incorrect" 1027 "Login Incorrect"
932 "Connection refused" 1028 "Connection refused"
933 "Connection closed" 1029 "Connection closed by foreign host."
934 "Sorry, try again." 1030 "Sorry, try again."
935 "Name or service not known" 1031 "Name or service not known"
936 "Host key verification failed.") t) 1032 "Host key verification failed."
1033 "No supported authentication methods left to try!"
1034 "Tramp connection closed") t)
937 ".*" 1035 ".*"
938 "\\|" 1036 "\\|"
939 "^.*\\(" 1037 "^.*\\("
@@ -1006,7 +1104,7 @@ be ignored safely."
1006In fact this expression is empty by intention, it will be used only to 1104In fact this expression is empty by intention, it will be used only to
1007check regularly the status of the associated process. 1105check regularly the status of the associated process.
1008The answer will be provided by `tramp-action-process-alive', 1106The answer will be provided by `tramp-action-process-alive',
1009`tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see." 1107`tramp-action-out-of-band', which see."
1010 :group 'tramp 1108 :group 'tramp
1011 :type 'regexp) 1109 :type 'regexp)
1012 1110
@@ -1020,12 +1118,6 @@ part, though."
1020 :group 'tramp 1118 :group 'tramp
1021 :type 'string) 1119 :type 'string)
1022 1120
1023(defcustom tramp-discard-garbage nil
1024 "*If non-nil, try to discard garbage sent by remote shell.
1025Some shells send such garbage upon connection setup."
1026 :group 'tramp
1027 :type 'boolean)
1028
1029(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) 1121(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
1030 "*Alist specifying extra arguments to pass to the remote shell. 1122 "*Alist specifying extra arguments to pass to the remote shell.
1031Entries are (REGEXP . ARGS) where REGEXP is a regular expression 1123Entries are (REGEXP . ARGS) where REGEXP is a regular expression
@@ -1042,139 +1134,134 @@ shell from reading its init file."
1042 '(alist :key-type string :value-type string) 1134 '(alist :key-type string :value-type string)
1043 '(repeat (cons string string)))) 1135 '(repeat (cons string string))))
1044 1136
1045(defcustom tramp-prefix-format 1137;; XEmacs is distributed with few Lisp packages. Further packages are
1046 (if tramp-unified-filenames "/" "/[") 1138;; installed using EFS. If we use a unified filename format, then
1047 "*String matching the very beginning of tramp file names. 1139;; Tramp is required in addition to EFS. (But why can't Tramp just
1048Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'." 1140;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
1141;; just like before.) Another reason for using a separate filename
1142;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
1143;; Tramp only knows how to deal with `file-name-handler-alist', not
1144;; the other places.
1145
1146;; Currently, we have the choice between 'ftp, 'sep, and 'url.
1147;;;###autoload
1148(defcustom tramp-syntax
1149 (if (featurep 'xemacs) 'sep 'ftp)
1150 "Tramp filename syntax to be used.
1151
1152It can have the following values:
1153
1154 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
1155 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
1156 'url -- URL-like syntax."
1049 :group 'tramp 1157 :group 'tramp
1050 :type 'string) 1158 :type (if (featurep 'xemacs)
1159 '(choice (const :tag "EFS" ftp)
1160 (const :tag "XEmacs" sep)
1161 (const :tag "URL" url))
1162 '(choice (const :tag "Ange-FTP" ftp)
1163 (const :tag "URL" url))))
1164
1165(defconst tramp-prefix-format
1166 (cond ((equal tramp-syntax 'ftp) "/")
1167 ((equal tramp-syntax 'sep) "/[")
1168 ((equal tramp-syntax 'url) "/")
1169 (t (error "Wrong `tramp-syntax' defined")))
1170 "*String matching the very beginning of tramp file names.
1171Used in `tramp-make-tramp-file-name'.")
1051 1172
1052(defcustom tramp-prefix-regexp 1173(defconst tramp-prefix-regexp
1053 (concat "^" (regexp-quote tramp-prefix-format)) 1174 (concat "^" (regexp-quote tramp-prefix-format))
1054 "*Regexp matching the very beginning of tramp file names. 1175 "*Regexp matching the very beginning of tramp file names.
1055Should always start with \"^\". Derived from `tramp-prefix-format'." 1176Should always start with \"^\". Derived from `tramp-prefix-format'.")
1056 :group 'tramp
1057 :type 'regexp)
1058 1177
1059(defcustom tramp-method-regexp 1178(defconst tramp-method-regexp
1060 "[a-zA-Z_0-9-]+" 1179 "[a-zA-Z_0-9-]+"
1061 "*Regexp matching methods identifiers." 1180 "*Regexp matching methods identifiers.")
1062 :group 'tramp
1063 :type 'regexp)
1064
1065;; It is a little bit annoying that in XEmacs case this delimeter is different
1066;; for single-hop and multi-hop cases.
1067(defcustom tramp-postfix-single-method-format
1068 (if tramp-unified-filenames ":" "/")
1069 "*String matching delimeter between method and user or host names.
1070Applicable for single-hop methods.
1071Used in `tramp-make-tramp-file-name'."
1072 :group 'tramp
1073 :type 'string)
1074
1075(defcustom tramp-postfix-single-method-regexp
1076 (regexp-quote tramp-postfix-single-method-format)
1077 "*Regexp matching delimeter between method and user or host names.
1078Applicable for single-hop methods.
1079Derived from `tramp-postfix-single-method-format'."
1080 :group 'tramp
1081 :type 'regexp)
1082 1181
1083(defcustom tramp-postfix-multi-method-format 1182(defconst tramp-postfix-method-format
1084 ":" 1183 (cond ((equal tramp-syntax 'ftp) ":")
1184 ((equal tramp-syntax 'sep) "/")
1185 ((equal tramp-syntax 'url) "://")
1186 (t (error "Wrong `tramp-syntax' defined")))
1085 "*String matching delimeter between method and user or host names. 1187 "*String matching delimeter between method and user or host names.
1086Applicable for multi-hop methods. 1188Used in `tramp-make-tramp-file-name'.")
1087Used in `tramp-make-tramp-multi-file-name'."
1088 :group 'tramp
1089 :type 'string)
1090 1189
1091(defcustom tramp-postfix-multi-method-regexp 1190(defconst tramp-postfix-method-regexp
1092 (regexp-quote tramp-postfix-multi-method-format) 1191 (regexp-quote tramp-postfix-method-format)
1093 "*Regexp matching delimeter between method and user or host names. 1192 "*Regexp matching delimeter between method and user or host names.
1094Applicable for multi-hop methods. 1193Derived from `tramp-postfix-method-format'.")
1095Derived from `tramp-postfix-multi-method-format'."
1096 :group 'tramp
1097 :type 'regexp)
1098
1099(defcustom tramp-postfix-multi-hop-format
1100 (if tramp-unified-filenames ":" "/")
1101 "*String matching delimeter between host and next method.
1102Applicable for multi-hop methods.
1103Used in `tramp-make-tramp-multi-file-name'."
1104 :group 'tramp
1105 :type 'string)
1106
1107(defcustom tramp-postfix-multi-hop-regexp
1108 (regexp-quote tramp-postfix-multi-hop-format)
1109 "*Regexp matching delimeter between host and next method.
1110Applicable for multi-hop methods.
1111Derived from `tramp-postfix-multi-hop-format'."
1112 :group 'tramp
1113 :type 'regexp)
1114 1194
1115(defcustom tramp-user-regexp 1195(defconst tramp-user-regexp
1116 "[^:/ \t]*" 1196 "[^:/ \t]+"
1117 "*Regexp matching user names." 1197 "*Regexp matching user names.")
1118 :group 'tramp
1119 :type 'regexp)
1120 1198
1121(defcustom tramp-postfix-user-format 1199(defconst tramp-postfix-user-format
1122 "@" 1200 "@"
1123 "*String matching delimeter between user and host names. 1201 "*String matching delimeter between user and host names.
1124Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'." 1202Used in `tramp-make-tramp-file-name'.")
1125 :group 'tramp
1126 :type 'string)
1127 1203
1128(defcustom tramp-postfix-user-regexp 1204(defconst tramp-postfix-user-regexp
1129 (regexp-quote tramp-postfix-user-format) 1205 (regexp-quote tramp-postfix-user-format)
1130 "*Regexp matching delimeter between user and host names. 1206 "*Regexp matching delimeter between user and host names.
1131Derived from `tramp-postfix-user-format'." 1207Derived from `tramp-postfix-user-format'.")
1132 :group 'tramp 1208
1133 :type 'regexp) 1209(defconst tramp-host-regexp
1134 1210 "[a-zA-Z0-9_.-]+"
1135(defcustom tramp-host-regexp 1211 "*Regexp matching host names.")
1136 "[a-zA-Z0-9_.-]*" 1212
1137 "*Regexp matching host names." 1213(defconst tramp-prefix-port-format
1138 :group 'tramp 1214 (cond ((equal tramp-syntax 'ftp) "#")
1139 :type 'regexp) 1215 ((equal tramp-syntax 'sep) "#")
1140 1216 ((equal tramp-syntax 'url) ":")
1141(defcustom tramp-host-with-port-regexp 1217 (t (error "Wrong `tramp-syntax' defined")))
1142 "[a-zA-Z0-9_.#-]*" 1218 "*String matching delimeter between host names and port numbers.")
1143 "*Regexp matching host names." 1219
1144 :group 'tramp 1220(defconst tramp-prefix-port-regexp
1145 :type 'regexp) 1221 (regexp-quote tramp-prefix-port-format)
1146 1222 "*Regexp matching delimeter between host names and port numbers.
1147(defcustom tramp-postfix-host-format 1223Derived from `tramp-prefix-port-format'.")
1148 (if tramp-unified-filenames ":" "]") 1224
1225(defconst tramp-port-regexp
1226 "[0-9]+"
1227 "*Regexp matching port numbers.")
1228
1229(defconst tramp-host-with-port-regexp
1230 (concat "\\(" tramp-host-regexp "\\)"
1231 tramp-prefix-port-regexp
1232 "\\(" tramp-port-regexp "\\)")
1233 "*Regexp matching host names with port numbers.")
1234
1235(defconst tramp-postfix-host-format
1236 (cond ((equal tramp-syntax 'ftp) ":")
1237 ((equal tramp-syntax 'sep) "]")
1238 ((equal tramp-syntax 'url) "")
1239 (t (error "Wrong `tramp-syntax' defined")))
1149 "*String matching delimeter between host names and localnames. 1240 "*String matching delimeter between host names and localnames.
1150Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'." 1241Used in `tramp-make-tramp-file-name'.")
1151 :group 'tramp
1152 :type 'string)
1153 1242
1154(defcustom tramp-postfix-host-regexp 1243(defconst tramp-postfix-host-regexp
1155 (regexp-quote tramp-postfix-host-format) 1244 (regexp-quote tramp-postfix-host-format)
1156 "*Regexp matching delimeter between host names and localnames. 1245 "*Regexp matching delimeter between host names and localnames.
1157Derived from `tramp-postfix-host-format'." 1246Derived from `tramp-postfix-host-format'.")
1158 :group 'tramp
1159 :type 'regexp)
1160 1247
1161(defcustom tramp-localname-regexp 1248(defconst tramp-localname-regexp
1162 ".*$" 1249 ".*$"
1163 "*Regexp matching localnames." 1250 "*Regexp matching localnames.")
1164 :group 'tramp
1165 :type 'regexp)
1166 1251
1167;; File name format. 1252;; File name format.
1168 1253
1169(defcustom tramp-file-name-structure 1254(defconst tramp-file-name-structure
1170 (list 1255 (list
1171 (concat 1256 (concat
1172 tramp-prefix-regexp 1257 tramp-prefix-regexp
1173 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp "\\)?" 1258 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
1174 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" 1259 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
1175 "\\(" tramp-host-with-port-regexp "\\)" tramp-postfix-host-regexp 1260 "\\(" tramp-host-regexp
1176 "\\(" tramp-localname-regexp "\\)") 1261 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
1177 2 4 5 6) 1262 tramp-postfix-host-regexp
1263 "\\(" tramp-localname-regexp "\\)")
1264 2 4 5 7)
1178 1265
1179 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \ 1266 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
1180the tramp file name structure. 1267the tramp file name structure.
@@ -1190,69 +1277,81 @@ but for the host name. The fifth element FILE is for the file name.
1190These numbers are passed directly to `match-string', which see. That 1277These numbers are passed directly to `match-string', which see. That
1191means the opening parentheses are counted to identify the pair. 1278means the opening parentheses are counted to identify the pair.
1192 1279
1193See also `tramp-file-name-regexp'." 1280See also `tramp-file-name-regexp'.")
1194 :group 'tramp
1195 :type '(list (regexp :tag "File name regexp")
1196 (integer :tag "Paren pair for method name")
1197 (integer :tag "Paren pair for user name ")
1198 (integer :tag "Paren pair for host name ")
1199 (integer :tag "Paren pair for file name ")))
1200 1281
1201;;;###autoload 1282;;;###autoload
1202(defconst tramp-file-name-regexp-unified 1283(defconst tramp-file-name-regexp-unified
1203 "\\`/[^/:]+:" 1284 "\\`/[^/:]+:"
1204 "Value for `tramp-file-name-regexp' for unified remoting. 1285 "Value for `tramp-file-name-regexp' for unified remoting.
1205Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and 1286Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1206Tramp. See `tramp-file-name-structure-unified' for more explanations.") 1287Tramp. See `tramp-file-name-structure' for more explanations.")
1207 1288
1208;;;###autoload 1289;;;###autoload
1209(defconst tramp-file-name-regexp-separate 1290(defconst tramp-file-name-regexp-separate
1210 "\\`/\\[.*\\]" 1291 "\\`/\\[.*\\]"
1211 "Value for `tramp-file-name-regexp' for separate remoting. 1292 "Value for `tramp-file-name-regexp' for separate remoting.
1212XEmacs uses a separate filename syntax for Tramp and EFS. 1293XEmacs uses a separate filename syntax for Tramp and EFS.
1213See `tramp-file-name-structure-separate' for more explanations.") 1294See `tramp-file-name-structure' for more explanations.")
1214 1295
1215;;;###autoload 1296;;;###autoload
1216(defcustom tramp-file-name-regexp 1297(defconst tramp-file-name-regexp-url
1217 (if tramp-unified-filenames 1298 "\\`/[^/:]+://"
1218 tramp-file-name-regexp-unified 1299 "Value for `tramp-file-name-regexp' for URL-like remoting.
1219 tramp-file-name-regexp-separate) 1300See `tramp-file-name-structure' for more explanations.")
1301
1302;;;###autoload
1303(defconst tramp-file-name-regexp
1304 (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
1305 ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
1306 ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
1307 (t (error "Wrong `tramp-syntax' defined")))
1220 "*Regular expression matching file names handled by tramp. 1308 "*Regular expression matching file names handled by tramp.
1221This regexp should match tramp file names but no other file names. 1309This regexp should match tramp file names but no other file names.
1222\(When tramp.el is loaded, this regular expression is prepended to 1310\(When tramp.el is loaded, this regular expression is prepended to
1223`file-name-handler-alist', and that is searched sequentially. Thus, 1311`file-name-handler-alist', and that is searched sequentially. Thus,
1224if the tramp entry appears rather early in the `file-name-handler-alist' 1312if the tramp entry appears rather early in the `file-name-handler-alist'
1225and is a bit too general, then some files might be considered tramp 1313and is a bit too general, then some files might be considered tramp
1226files which are not really tramp files. 1314files which are not really Tramp files.
1227 1315
1228Please note that the entry in `file-name-handler-alist' is made when 1316Please note that the entry in `file-name-handler-alist' is made when
1229this file (tramp.el) is loaded. This means that this variable must be set 1317this file (tramp.el) is loaded. This means that this variable must be set
1230before loading tramp.el. Alternatively, `file-name-handler-alist' can be 1318before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1231updated after changing this variable. 1319updated after changing this variable.
1232 1320
1233Also see `tramp-file-name-structure'." 1321Also see `tramp-file-name-structure'.")
1234 :group 'tramp
1235 :type 'regexp)
1236 1322
1237;;;###autoload 1323;;;###autoload
1238(defconst tramp-completion-file-name-regexp-unified 1324(defconst tramp-completion-file-name-regexp-unified
1239 "^/$\\|^/[^/:][^/]*$" 1325 (if (memq system-type '(cygwin windows-nt))
1326 "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:][^/]*$"
1327 "^/$\\|^/[^/:][^/]*$")
1240 "Value for `tramp-completion-file-name-regexp' for unified remoting. 1328 "Value for `tramp-completion-file-name-regexp' for unified remoting.
1241Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and 1329Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1242Tramp. See `tramp-file-name-structure-unified' for more explanations.") 1330Tramp. See `tramp-file-name-structure' for more explanations.")
1243 1331
1244;;;###autoload 1332;;;###autoload
1245(defconst tramp-completion-file-name-regexp-separate 1333(defconst tramp-completion-file-name-regexp-separate
1246 "^/\\([[][^]]*\\)?$" 1334 (if (memq system-type '(cygwin windows-nt))
1335 "^\\([a-zA-Z]:\\)?/\\([[][^]]*\\)?$"
1336 "^/\\([[][^]]*\\)?$")
1247 "Value for `tramp-completion-file-name-regexp' for separate remoting. 1337 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1248XEmacs uses a separate filename syntax for Tramp and EFS. 1338XEmacs uses a separate filename syntax for Tramp and EFS.
1249See `tramp-file-name-structure-separate' for more explanations.") 1339See `tramp-file-name-structure' for more explanations.")
1340
1341;;;###autoload
1342(defconst tramp-completion-file-name-regexp-url
1343 (if (memq system-type '(cygwin windows-nt))
1344 "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$"
1345 "^/$\\|^/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
1346 "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
1347See `tramp-file-name-structure' for more explanations.")
1250 1348
1251;;;###autoload 1349;;;###autoload
1252(defcustom tramp-completion-file-name-regexp 1350(defconst tramp-completion-file-name-regexp
1253 (if tramp-unified-filenames 1351 (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
1254 tramp-completion-file-name-regexp-unified 1352 ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
1255 tramp-completion-file-name-regexp-separate) 1353 ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
1354 (t (error "Wrong `tramp-syntax' defined")))
1256 "*Regular expression matching file names handled by tramp completion. 1355 "*Regular expression matching file names handled by tramp completion.
1257This regexp should match partial tramp file names only. 1356This regexp should match partial tramp file names only.
1258 1357
@@ -1261,121 +1360,14 @@ this file (tramp.el) is loaded. This means that this variable must be set
1261before loading tramp.el. Alternatively, `file-name-handler-alist' can be 1360before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1262updated after changing this variable. 1361updated after changing this variable.
1263 1362
1264Also see `tramp-file-name-structure'." 1363Also see `tramp-file-name-structure'.")
1265 :group 'tramp
1266 :type 'regexp)
1267
1268(defcustom tramp-multi-file-name-structure
1269 (list
1270 (concat
1271 tramp-prefix-regexp
1272 "\\(" "\\(" tramp-method-regexp "\\)" "\\)?"
1273 "\\(" "\\(" tramp-postfix-multi-hop-regexp "%s" "\\)+" "\\)?"
1274 tramp-postfix-host-regexp "\\(" tramp-localname-regexp "\\)")
1275 2 3 -1)
1276 "*Describes the file name structure of `multi' files.
1277Multi files allow you to contact a remote host in several hops.
1278This is a list of four elements (REGEXP METHOD HOP LOCALNAME).
1279
1280The first element, REGEXP, gives a regular expression to match against
1281the file name. In this regular expression, `%s' is replaced with the
1282value of `tramp-multi-file-name-hop-structure'. (Note: in order to
1283allow multiple hops, you normally want to use something like
1284\"\\\\(\\\\(%s\\\\)+\\\\)\" in the regular expression. The outer pair
1285of parentheses is used for the HOP element, see below.)
1286
1287All remaining elements are numbers. METHOD gives the number of the
1288paren pair which matches the method name. HOP gives the number of the
1289paren pair which matches the hop sequence. LOCALNAME gives the number of
1290the paren pair which matches the localname (pathname) on the remote host.
1291
1292LOCALNAME can also be negative, which means to count from the end. Ie, a
1293value of -1 means the last paren pair.
1294
1295I think it would be good if the regexp matches the whole of the
1296string, but I haven't actually tried what happens if it doesn't..."
1297 :group 'tramp
1298 :type '(list (regexp :tag "File name regexp")
1299 (integer :tag "Paren pair for method name")
1300 (integer :tag "Paren pair for hops")
1301 (integer :tag "Paren pair to match localname")))
1302
1303(defcustom tramp-multi-file-name-hop-structure
1304 (list
1305 (concat
1306 "\\(" tramp-method-regexp "\\)" tramp-postfix-multi-method-regexp
1307 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
1308 "\\(" tramp-host-with-port-regexp "\\)")
1309 1 2 3)
1310 "*Describes the structure of a hop in multi files.
1311This is a list of four elements (REGEXP METHOD USER HOST). First
1312element REGEXP is used to match against the hop. Pair number METHOD
1313matches the method of one hop, pair number USER matches the user of
1314one hop, pair number HOST matches the host of one hop.
1315
1316This regular expression should match exactly all of one hop."
1317 :group 'tramp
1318 :type '(list (regexp :tag "Hop regexp")
1319 (integer :tag "Paren pair for method name")
1320 (integer :tag "Paren pair for user name")
1321 (integer :tag "Paren pair for host name")))
1322
1323(defcustom tramp-make-multi-tramp-file-format
1324 (list
1325 (concat tramp-prefix-format "%m")
1326 (concat tramp-postfix-multi-hop-format
1327 "%m" tramp-postfix-multi-method-format
1328 "%u" tramp-postfix-user-format
1329 "%h")
1330 (concat tramp-postfix-host-format "%p"))
1331 "*Describes how to construct a `multi' file name.
1332This is a list of three elements PREFIX, HOP and LOCALNAME.
1333
1334The first element PREFIX says how to construct the prefix, the second
1335element HOP specifies what each hop looks like, and the final element
1336LOCALNAME says how to construct the localname (pathname).
1337 1364
1338In PREFIX, `%%' means `%' and `%m' means the method name. 1365(defconst tramp-actions-before-shell
1339 1366 '((tramp-login-prompt-regexp tramp-action-login)
1340In HOP, `%%' means `%' and `%m', `%u', `%h' mean the hop method, hop 1367 (tramp-password-prompt-regexp tramp-action-password)
1341user and hop host, respectively. 1368 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1342
1343In LOCALNAME, `%%' means `%' and `%p' means the localname.
1344
1345The resulting file name always contains one copy of PREFIX and one
1346copy of LOCALNAME, but there is one copy of HOP for each hop in the file
1347name.
1348
1349Note: the current implementation requires the prefix to contain the
1350method name, followed by all the hops, and the localname must come
1351last."
1352 :group 'tramp
1353 :type '(list string string string))
1354
1355(defcustom tramp-terminal-type "dumb"
1356 "*Value of TERM environment variable for logging in to remote host.
1357Because Tramp wants to parse the output of the remote shell, it is easily
1358confused by ANSI color escape sequences and suchlike. Often, shell init
1359files conditionalize this setup based on the TERM environment variable."
1360 :group 'tramp
1361 :type 'string)
1362
1363(defcustom tramp-completion-without-shell-p nil
1364 "*If nil, use shell wildcards for completion, else rely on Lisp only.
1365Using shell wildcards for completions has the advantage that it can be
1366fast even in large directories, but completion is always
1367case-sensitive. Relying on Lisp only means that case-insensitive
1368completion is possible (subject to the variable `completion-ignore-case'),
1369but it might be slow on large directories."
1370 :group 'tramp
1371 :type 'boolean)
1372
1373(defcustom tramp-actions-before-shell
1374 '((tramp-password-prompt-regexp tramp-action-password)
1375 (tramp-login-prompt-regexp tramp-action-login)
1376 (shell-prompt-pattern tramp-action-succeed) 1369 (shell-prompt-pattern tramp-action-succeed)
1377 (tramp-shell-prompt-pattern tramp-action-succeed) 1370 (tramp-shell-prompt-pattern tramp-action-succeed)
1378 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1379 (tramp-yesno-prompt-regexp tramp-action-yesno) 1371 (tramp-yesno-prompt-regexp tramp-action-yesno)
1380 (tramp-yn-prompt-regexp tramp-action-yn) 1372 (tramp-yn-prompt-regexp tramp-action-yn)
1381 (tramp-terminal-prompt-regexp tramp-action-terminal) 1373 (tramp-terminal-prompt-regexp tramp-action-terminal)
@@ -1390,51 +1382,19 @@ regexp must match at the end of the buffer, \"\\'\" is implicitly
1390appended to it. 1382appended to it.
1391 1383
1392The ACTION should also be a symbol, but a function. When the 1384The ACTION should also be a symbol, but a function. When the
1393corresponding PATTERN matches, the ACTION function is called." 1385corresponding PATTERN matches, the ACTION function is called.")
1394 :group 'tramp
1395 :type '(repeat (list variable function)))
1396 1386
1397(defcustom tramp-actions-copy-out-of-band 1387(defconst tramp-actions-copy-out-of-band
1398 '((tramp-password-prompt-regexp tramp-action-password) 1388 '((tramp-password-prompt-regexp tramp-action-password)
1399 (tramp-wrong-passwd-regexp tramp-action-permission-denied) 1389 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1400 (tramp-copy-failed-regexp tramp-action-copy-failed) 1390 (tramp-copy-failed-regexp tramp-action-permission-denied)
1401 (tramp-process-alive-regexp tramp-action-out-of-band)) 1391 (tramp-process-alive-regexp tramp-action-out-of-band))
1402 "List of pattern/action pairs. 1392 "List of pattern/action pairs.
1403This list is used for copying/renaming with out-of-band methods. 1393This list is used for copying/renaming with out-of-band methods.
1404See `tramp-actions-before-shell' for more info."
1405 :group 'tramp
1406 :type '(repeat (list variable function)))
1407
1408(defcustom tramp-multi-actions
1409 '((tramp-password-prompt-regexp tramp-multi-action-password)
1410 (tramp-login-prompt-regexp tramp-multi-action-login)
1411 (shell-prompt-pattern tramp-multi-action-succeed)
1412 (tramp-shell-prompt-pattern tramp-multi-action-succeed)
1413 (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
1414 (tramp-process-alive-regexp tramp-multi-action-process-alive))
1415 "List of pattern/action pairs.
1416This list is used for each hop in multi-hop connections.
1417See `tramp-actions-before-shell' for more info."
1418 :group 'tramp
1419 :type '(repeat (list variable function)))
1420
1421(defcustom tramp-initial-commands
1422 '("unset HISTORY"
1423 "unset correct"
1424 "unset autocorrect")
1425 "List of commands to send to the first remote shell that we see.
1426These commands will be sent to any shell, and thus they should be
1427designed to work in such circumstances. Also, restrict the commands
1428to the bare necessity for getting the remote shell into a state
1429where it is possible to execute the Bourne-ish shell.
1430
1431At the moment, the command to execute the Bourne-ish shell uses strange
1432quoting which `tcsh' tries to correct, so we send the command \"unset
1433autocorrect\" to the remote host."
1434 :group 'tramp
1435 :type '(repeat string))
1436 1394
1437;; Chunked sending kluge. We set this to 500 for black-listed constellations 1395See `tramp-actions-before-shell' for more info.")
1396
1397;; Chunked sending kludge. We set this to 500 for black-listed constellations
1438;; known to have a bug in `process-send-string'; some ssh connections appear 1398;; known to have a bug in `process-send-string'; some ssh connections appear
1439;; to drop bytes when data is sent too quickly. There is also a connection 1399;; to drop bytes when data is sent too quickly. There is also a connection
1440;; buffer local variable, which is computed depending on remote host properties 1400;; buffer local variable, which is computed depending on remote host properties
@@ -1490,16 +1450,16 @@ You will see the number of bytes sent successfully to the remote host.
1490If that number exceeds 1000, you can stop the execution by hitting 1450If that number exceeds 1000, you can stop the execution by hitting
1491C-g, because your Emacs is likely clean. 1451C-g, because your Emacs is likely clean.
1492 1452
1493If your Emacs is buggy, the code stops and gives you an indication
1494about the value `tramp-chunksize' should be set. Maybe you could just
1495experiment a bit, e.g. changing the values of `init' and `step'
1496in the third line of the code.
1497
1498When it is necessary to set `tramp-chunksize', you might consider to 1453When it is necessary to set `tramp-chunksize', you might consider to
1499use an out-of-the-band method (like \"scp\") instead of an internal one 1454use an out-of-the-band method (like \"scp\") instead of an internal one
1500\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases 1455\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
1501performance. 1456performance.
1502 1457
1458If your Emacs is buggy, the code stops and gives you an indication
1459about the value `tramp-chunksize' should be set. Maybe you could just
1460experiment a bit, e.g. changing the values of `init' and `step'
1461in the third line of the code.
1462
1503Please raise a bug report via \"M-x tramp-bug\" if your system needs 1463Please raise a bug report via \"M-x tramp-bug\" if your system needs
1504this variable to be set as well." 1464this variable to be set as well."
1505 :group 'tramp 1465 :group 'tramp
@@ -1518,144 +1478,25 @@ opening a connection to a remote host."
1518 1478
1519;;; Internal Variables: 1479;;; Internal Variables:
1520 1480
1521(defvar tramp-buffer-file-attributes nil
1522 "Holds the `ls -ild' output for the current buffer.
1523This variable is local to each buffer. It is not used if the remote
1524machine groks Perl. If it is used, it's used as an emulation for
1525the visited file modtime.")
1526(make-variable-buffer-local 'tramp-buffer-file-attributes)
1527
1528(defvar tramp-md5-function
1529 (cond ((and (require 'md5) (fboundp 'md5)) 'md5)
1530 ((fboundp 'md5-encode)
1531 (lambda (x) (base64-encode-string
1532 (funcall (symbol-function 'md5-encode) x))))
1533 (t (error "Couldn't find an `md5' function")))
1534 "Function to call for running the MD5 algorithm.")
1535
1536(defvar tramp-end-of-output 1481(defvar tramp-end-of-output
1537 (concat "///" 1482 (concat
1538 (funcall tramp-md5-function 1483 "///" (md5 (concat
1539 (concat 1484 (prin1-to-string process-environment) (current-time-string))))
1540 (prin1-to-string process-environment)
1541 (current-time-string)
1542;; (prin1-to-string
1543;; (if (fboundp 'directory-files-and-attributes)
1544;; (funcall 'directory-files-and-attributes
1545;; (or (getenv "HOME")
1546;; (tramp-temporary-file-directory)))
1547;; (mapcar
1548;; (lambda (x)
1549;; (cons x (file-attributes x)))
1550;; (directory-files (or (getenv "HOME")
1551;; (tramp-temporary-file-directory))
1552;; t))))
1553 )))
1554 "String used to recognize end of output.") 1485 "String used to recognize end of output.")
1555 1486
1556(defvar tramp-connection-function nil
1557 "This internal variable holds a parameter for `tramp-methods'.
1558In the connection buffer, this variable has the value of the like-named
1559method parameter, as specified in `tramp-methods' (which see).")
1560
1561(defvar tramp-remote-sh nil
1562 "This internal variable holds a parameter for `tramp-methods'.
1563In the connection buffer, this variable has the value of the like-named
1564method parameter, as specified in `tramp-methods' (which see).")
1565
1566(defvar tramp-login-program nil
1567 "This internal variable holds a parameter for `tramp-methods'.
1568In the connection buffer, this variable has the value of the like-named
1569method parameter, as specified in `tramp-methods' (which see).")
1570
1571(defvar tramp-login-args nil
1572 "This internal variable holds a parameter for `tramp-methods'.
1573In the connection buffer, this variable has the value of the like-named
1574method parameter, as specified in `tramp-methods' (which see).")
1575
1576(defvar tramp-copy-program nil
1577 "This internal variable holds a parameter for `tramp-methods'.
1578In the connection buffer, this variable has the value of the like-named
1579method parameter, as specified in `tramp-methods' (which see).")
1580
1581(defvar tramp-copy-args nil
1582 "This internal variable holds a parameter for `tramp-methods'.
1583In the connection buffer, this variable has the value of the like-named
1584method parameter, as specified in `tramp-methods' (which see).")
1585
1586(defvar tramp-copy-keep-date-arg nil
1587 "This internal variable holds a parameter for `tramp-methods'.
1588In the connection buffer, this variable has the value of the like-named
1589method parameter, as specified in `tramp-methods' (which see).")
1590
1591(defvar tramp-encoding-command nil
1592 "This internal variable holds a parameter for `tramp-methods'.
1593In the connection buffer, this variable has the value of the like-named
1594method parameter, as specified in `tramp-methods' (which see).")
1595
1596(defvar tramp-decoding-command nil
1597 "This internal variable holds a parameter for `tramp-methods'.
1598In the connection buffer, this variable has the value of the like-named
1599method parameter, as specified in `tramp-methods' (which see).")
1600
1601(defvar tramp-encoding-function nil
1602 "This internal variable holds a parameter for `tramp-methods'.
1603In the connection buffer, this variable has the value of the like-named
1604method parameter, as specified in `tramp-methods' (which see).")
1605
1606(defvar tramp-decoding-function nil
1607 "This internal variable holds a parameter for `tramp-methods'.
1608In the connection buffer, this variable has the value of the like-named
1609method parameter, as specified in `tramp-methods' (which see).")
1610
1611(defvar tramp-password-end-of-line nil
1612 "This internal variable holds a parameter for `tramp-methods'.
1613In the connection buffer, this variable has the value of the like-named
1614method parameter, as specified in `tramp-methods' (which see).")
1615
1616;; CCC `local in each buffer'?
1617(defvar tramp-ls-command nil
1618 "This command is used to get a long listing with numeric user and group ids.
1619This variable is automatically made buffer-local to each rsh process buffer
1620upon opening the connection.")
1621
1622(defvar tramp-current-multi-method nil
1623 "Name of `multi' connection method for this *tramp* buffer, or nil if not multi.
1624This variable is automatically made buffer-local to each rsh process buffer
1625upon opening the connection.")
1626
1627(defvar tramp-current-method nil 1487(defvar tramp-current-method nil
1628 "Connection method for this *tramp* buffer. 1488 "Connection method for this *tramp* buffer.")
1629This variable is automatically made buffer-local to each rsh process buffer
1630upon opening the connection.")
1631 1489
1632(defvar tramp-current-user nil 1490(defvar tramp-current-user nil
1633 "Remote login name for this *tramp* buffer. 1491 "Remote login name for this *tramp* buffer.")
1634This variable is automatically made buffer-local to each rsh process buffer
1635upon opening the connection.")
1636 1492
1637(defvar tramp-current-host nil 1493(defvar tramp-current-host nil
1638 "Remote host for this *tramp* buffer. 1494 "Remote host for this *tramp* buffer.")
1639This variable is automatically made buffer-local to each rsh process buffer 1495
1640upon opening the connection.") 1496(defconst tramp-uudecode
1641 1497 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1642(defvar tramp-test-groks-nt nil
1643 "Whether the `test' command groks the `-nt' switch.
1644\(`test A -nt B' tests if file A is newer than file B.)
1645This variable is automatically made buffer-local to each rsh process buffer
1646upon opening the connection.")
1647
1648(defvar tramp-file-exists-command nil
1649 "Command to use for checking if a file exists.
1650This variable is automatically made buffer-local to each rsh process buffer
1651upon opening the connection.")
1652
1653(defconst tramp-uudecode "\
1654tramp_uudecode () {
1655\(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1656cat /tmp/tramp.$$ 1498cat /tmp/tramp.$$
1657rm -f /tmp/tramp.$$ 1499rm -f /tmp/tramp.$$"
1658}"
1659 "Shell function to implement `uudecode' to standard output. 1500 "Shell function to implement `uudecode' to standard output.
1660Many systems support `uudecode -o /dev/stdout' or `uudecode -o -' 1501Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
1661for this or `uudecode -p', but some systems don't, and for them 1502for this or `uudecode -p', but some systems don't, and for them
@@ -1667,7 +1508,8 @@ we have this shell function.")
1667;; end. 1508;; end.
1668;; The device number is returned as "-1", because there will be a virtual 1509;; The device number is returned as "-1", because there will be a virtual
1669;; device number set in `tramp-handle-file-attributes' 1510;; device number set in `tramp-handle-file-attributes'
1670(defconst tramp-perl-file-attributes "\ 1511(defconst tramp-perl-file-attributes
1512 "%s -e '
1671@stat = lstat($ARGV[0]); 1513@stat = lstat($ARGV[0]);
1672if (($stat[2] & 0170000) == 0120000) 1514if (($stat[2] & 0170000) == 0120000)
1673{ 1515{
@@ -1685,7 +1527,7 @@ else
1685$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; 1527$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1686$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; 1528$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1687printf( 1529printf(
1688 \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", 1530 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t (%%u . %%u) -1)\\n\",
1689 $type, 1531 $type,
1690 $stat[3], 1532 $stat[3],
1691 $uid, 1533 $uid,
@@ -1700,11 +1542,14 @@ printf(
1700 $stat[2], 1542 $stat[2],
1701 $stat[1] >> 16 & 0xffff, 1543 $stat[1] >> 16 & 0xffff,
1702 $stat[1] & 0xffff 1544 $stat[1] & 0xffff
1703);" 1545);' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1704 "Perl script to produce output suitable for use with `file-attributes' 1546 "Perl script to produce output suitable for use with `file-attributes'
1705on the remote file system.") 1547on the remote file system.
1548Escape sequence %s is replaced with name of Perl binary.
1549This string is passed to `format', so percent characters need to be doubled.")
1706 1550
1707(defconst tramp-perl-directory-files-and-attributes "\ 1551(defconst tramp-perl-directory-files-and-attributes
1552 "%s -e '
1708chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit(); 1553chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
1709opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit(); 1554opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
1710@list = readdir(DIR); 1555@list = readdir(DIR);
@@ -1731,7 +1576,7 @@ for($i = 0; $i < $n; $i++)
1731 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; 1576 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1732 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; 1577 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1733 printf( 1578 printf(
1734 \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\", 1579 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t (%%u . %%u) (%%u %%u))\\n\",
1735 $filename, 1580 $filename,
1736 $type, 1581 $type,
1737 $stat[3], 1582 $stat[3],
@@ -1750,9 +1595,11 @@ for($i = 0; $i < $n; $i++)
1750 $stat[0] >> 16 & 0xffff, 1595 $stat[0] >> 16 & 0xffff,
1751 $stat[0] & 0xffff); 1596 $stat[0] & 0xffff);
1752} 1597}
1753printf(\")\\n\");" 1598printf(\")\\n\");' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1754 "Perl script implementing `directory-files-attributes' as Lisp `read'able 1599 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1755output.") 1600output.
1601Escape sequence %s is replaced with name of Perl binary.
1602This string is passed to `format', so percent characters need to be doubled.")
1756 1603
1757;; ;; These two use uu encoding. 1604;; ;; These two use uu encoding.
1758;; (defvar tramp-perl-encode "%s -e'\ 1605;; (defvar tramp-perl-encode "%s -e'\
@@ -1775,25 +1622,25 @@ output.")
1775;; Escape sequence %s is replaced with name of Perl binary.") 1622;; Escape sequence %s is replaced with name of Perl binary.")
1776 1623
1777;; These two use base64 encoding. 1624;; These two use base64 encoding.
1778(defvar tramp-perl-encode-with-module 1625(defconst tramp-perl-encode-with-module
1779 "perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)'" 1626 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
1780 "Perl program to use for encoding a file. 1627 "Perl program to use for encoding a file.
1781Escape sequence %s is replaced with name of Perl binary. 1628Escape sequence %s is replaced with name of Perl binary.
1782This string is passed to `format', so percent characters need to be doubled. 1629This string is passed to `format', so percent characters need to be doubled.
1783This implementation requires the MIME::Base64 Perl module to be installed 1630This implementation requires the MIME::Base64 Perl module to be installed
1784on the remote host.") 1631on the remote host.")
1785 1632
1786(defvar tramp-perl-decode-with-module 1633(defconst tramp-perl-decode-with-module
1787 "perl -MMIME::Base64 -0777 -ne 'print decode_base64($_)'" 1634 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
1788 "Perl program to use for decoding a file. 1635 "Perl program to use for decoding a file.
1789Escape sequence %s is replaced with name of Perl binary. 1636Escape sequence %s is replaced with name of Perl binary.
1790This string is passed to `format', so percent characters need to be doubled. 1637This string is passed to `format', so percent characters need to be doubled.
1791This implementation requires the MIME::Base64 Perl module to be installed 1638This implementation requires the MIME::Base64 Perl module to be installed
1792on the remote host.") 1639on the remote host.")
1793 1640
1794(defvar tramp-perl-encode 1641(defconst tramp-perl-encode
1795 "%s -e ' 1642 "%s -e '
1796# This script contributed by Juanma Barranquero <lektu@terra.es>. 1643# This script is contributed by Juanma Barranquero <lektu@terra.es>.
1797# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 1644# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
1798# Free Software Foundation, Inc. 1645# Free Software Foundation, Inc.
1799use strict; 1646use strict;
@@ -1828,15 +1675,14 @@ while (my $data = <STDIN>) {
1828 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), 1675 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1829 $pad, 1676 $pad,
1830 qq(\\n); 1677 qq(\\n);
1831} 1678}' 2>/dev/null"
1832'"
1833 "Perl program to use for encoding a file. 1679 "Perl program to use for encoding a file.
1834Escape sequence %s is replaced with name of Perl binary. 1680Escape sequence %s is replaced with name of Perl binary.
1835This string is passed to `format', so percent characters need to be doubled.") 1681This string is passed to `format', so percent characters need to be doubled.")
1836 1682
1837(defvar tramp-perl-decode 1683(defconst tramp-perl-decode
1838 "%s -e ' 1684 "%s -e '
1839# This script contributed by Juanma Barranquero <lektu@terra.es>. 1685# This script is contributed by Juanma Barranquero <lektu@terra.es>.
1840# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 1686# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
1841# Free Software Foundation, Inc. 1687# Free Software Foundation, Inc.
1842use strict; 1688use strict;
@@ -1874,8 +1720,7 @@ while (my $data = <STDIN>) {
1874 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); 1720 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1875 1721
1876 last if $finished; 1722 last if $finished;
1877} 1723}' 2>/dev/null"
1878'"
1879 "Perl program to use for decoding a file. 1724 "Perl program to use for decoding a file.
1880Escape sequence %s is replaced with name of Perl binary. 1725Escape sequence %s is replaced with name of Perl binary.
1881This string is passed to `format', so percent characters need to be doubled.") 1726This string is passed to `format', so percent characters need to be doubled.")
@@ -1898,44 +1743,12 @@ This string is passed to `format', so percent characters need to be doubled.")
1898 "A list of file types returned from the `stat' system call. 1743 "A list of file types returned from the `stat' system call.
1899This is used to map a mode number to a permission string.") 1744This is used to map a mode number to a permission string.")
1900 1745
1901(defvar tramp-dos-coding-system
1902 (if (and (fboundp 'coding-system-p)
1903 (funcall 'coding-system-p '(dos)))
1904 'dos
1905 'undecided-dos)
1906 "Some Emacsen know the `dos' coding system, others need `undecided-dos'.")
1907
1908(defvar tramp-last-cmd nil
1909 "Internal Tramp variable recording the last command sent.
1910This variable is buffer-local in every buffer.")
1911(make-variable-buffer-local 'tramp-last-cmd)
1912
1913(defvar tramp-process-echoes nil
1914 "Whether to process echoes from the remote shell.")
1915
1916(defvar tramp-last-cmd-time nil
1917 "Internal Tramp variable recording the time when the last cmd was sent.
1918This variable is buffer-local in every buffer.")
1919(make-variable-buffer-local 'tramp-last-cmd-time)
1920
1921;; This variable does not have the right value in XEmacs. What should
1922;; I use instead of find-operation-coding-system in XEmacs?
1923(defvar tramp-feature-write-region-fix
1924 (when (fboundp 'find-operation-coding-system)
1925 (let ((file-coding-system-alist '(("test" emacs-mule))))
1926 (funcall (symbol-function 'find-operation-coding-system)
1927 'write-region 0 0 "" nil "test")))
1928 "Internal variable to say if `write-region' chooses the right coding.
1929Older versions of Emacs chose the coding system for `write-region' based
1930on the FILENAME argument, even if VISIT was a string.")
1931
1932;; New handlers should be added here. The following operations can be 1746;; New handlers should be added here. The following operations can be
1933;; handled using the normal primitives: file-name-as-directory, 1747;; handled using the normal primitives: file-name-as-directory,
1934;; file-name-directory, file-name-nondirectory, 1748;; file-name-directory, file-name-nondirectory,
1935;; file-name-sans-versions, get-file-buffer. 1749;; file-name-sans-versions, get-file-buffer.
1936(defconst tramp-file-name-handler-alist 1750(defconst tramp-file-name-handler-alist
1937 '( 1751 '((load . tramp-handle-load)
1938 (load . tramp-handle-load)
1939 (make-symbolic-link . tramp-handle-make-symbolic-link) 1752 (make-symbolic-link . tramp-handle-make-symbolic-link)
1940 (file-name-directory . tramp-handle-file-name-directory) 1753 (file-name-directory . tramp-handle-file-name-directory)
1941 (file-name-nondirectory . tramp-handle-file-name-nondirectory) 1754 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
@@ -1943,7 +1756,6 @@ on the FILENAME argument, even if VISIT was a string.")
1943 (file-exists-p . tramp-handle-file-exists-p) 1756 (file-exists-p . tramp-handle-file-exists-p)
1944 (file-directory-p . tramp-handle-file-directory-p) 1757 (file-directory-p . tramp-handle-file-directory-p)
1945 (file-executable-p . tramp-handle-file-executable-p) 1758 (file-executable-p . tramp-handle-file-executable-p)
1946 (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
1947 (file-readable-p . tramp-handle-file-readable-p) 1759 (file-readable-p . tramp-handle-file-readable-p)
1948 (file-regular-p . tramp-handle-file-regular-p) 1760 (file-regular-p . tramp-handle-file-regular-p)
1949 (file-symlink-p . tramp-handle-file-symlink-p) 1761 (file-symlink-p . tramp-handle-file-symlink-p)
@@ -1964,10 +1776,14 @@ on the FILENAME argument, even if VISIT was a string.")
1964 (delete-directory . tramp-handle-delete-directory) 1776 (delete-directory . tramp-handle-delete-directory)
1965 (delete-file . tramp-handle-delete-file) 1777 (delete-file . tramp-handle-delete-file)
1966 (directory-file-name . tramp-handle-directory-file-name) 1778 (directory-file-name . tramp-handle-directory-file-name)
1967 (shell-command . tramp-handle-shell-command) 1779 ;; `executable-find' is not official yet.
1780 (executable-find . tramp-handle-executable-find)
1781 (start-file-process . tramp-handle-start-file-process)
1968 (process-file . tramp-handle-process-file) 1782 (process-file . tramp-handle-process-file)
1783 (shell-command . tramp-handle-shell-command)
1969 (insert-directory . tramp-handle-insert-directory) 1784 (insert-directory . tramp-handle-insert-directory)
1970 (expand-file-name . tramp-handle-expand-file-name) 1785 (expand-file-name . tramp-handle-expand-file-name)
1786 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
1971 (file-local-copy . tramp-handle-file-local-copy) 1787 (file-local-copy . tramp-handle-file-local-copy)
1972 (file-remote-p . tramp-handle-file-remote-p) 1788 (file-remote-p . tramp-handle-file-remote-p)
1973 (insert-file-contents . tramp-handle-insert-file-contents) 1789 (insert-file-contents . tramp-handle-insert-file-contents)
@@ -1976,7 +1792,6 @@ on the FILENAME argument, even if VISIT was a string.")
1976 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) 1792 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
1977 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) 1793 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
1978 (dired-compress-file . tramp-handle-dired-compress-file) 1794 (dired-compress-file . tramp-handle-dired-compress-file)
1979 (dired-call-process . tramp-handle-dired-call-process)
1980 (dired-recursive-delete-directory 1795 (dired-recursive-delete-directory
1981 . tramp-handle-dired-recursive-delete-directory) 1796 . tramp-handle-dired-recursive-delete-directory)
1982 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) 1797 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
@@ -2006,37 +1821,115 @@ calling HANDLER.")
2006 1821
2007;;; Internal functions which must come first. 1822;;; Internal functions which must come first.
2008 1823
2009(defsubst tramp-message (level fmt-string &rest args) 1824(defsubst tramp-debug-message (vec fmt-string &rest args)
1825 "Append message to debug buffer.
1826Message is formatted with FMT-STRING as control string and the remaining
1827ARGS to actually emit the message (if applicable)."
1828 (when (get-buffer (tramp-buffer-name vec))
1829 (with-current-buffer (tramp-get-debug-buffer vec)
1830 (goto-char (point-max))
1831 (unless (bolp)
1832 (insert "\n"))
1833 ;; Timestamp
1834 (insert (format-time-string "%T "))
1835 ;; Calling function
1836 (let ((btn 1) btf fn)
1837 (while (not fn)
1838 (setq btf (nth 1 (backtrace-frame btn)))
1839 (if (not btf)
1840 (setq fn "")
1841 (when (symbolp btf)
1842 (setq fn (symbol-name btf))
1843 (unless (and (string-match "^tramp" fn)
1844 (not (string-match
1845 "^tramp\\(-debug\\)?\\(-message\\|-error\\)$"
1846 fn)))
1847 (setq fn nil)))
1848 (setq btn (1+ btn))))
1849 ;; The following code inserts filename and line number.
1850 ;; Should be deactivated by default, because it is time
1851 ;; consuming.
1852; (let ((ffn (find-function-noselect (intern fn))))
1853; (insert
1854; (format
1855; "%s:%d: "
1856; (file-name-nondirectory (buffer-file-name (car ffn)))
1857; (with-current-buffer (car ffn)
1858; (1+ (count-lines (point-min) (cdr ffn)))))))
1859 (insert (format "%s " fn)))
1860 ;; The message
1861 (insert (apply 'format fmt-string args)))))
1862
1863(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
2010 "Emit a message depending on verbosity level. 1864 "Emit a message depending on verbosity level.
2011First arg LEVEL says to be quiet if `tramp-verbose' is less than LEVEL. The 1865VEC-OR-PROC identifies the tramp buffer to use. It can be either a
2012message is emitted only if `tramp-verbose' is greater than or equal to LEVEL. 1866vector or a process. LEVEL says to be quiet if `tramp-verbose' is
2013Calls function `message' with FMT-STRING as control string and the remaining 1867less than LEVEL. The message is emitted only if `tramp-verbose' is
2014ARGS to actually emit the message (if applicable). 1868greater than or equal to LEVEL.
2015 1869
2016This function expects to be called from the tramp buffer only!" 1870The message is also logged into the debug buffer when `tramp-verbose'
2017 (when (<= level tramp-verbose) 1871is greater than or equal 4.
2018 (apply #'message (concat "tramp: " fmt-string) args) 1872
2019 (when tramp-debug-buffer 1873Calls functions `message' and `tramp-debug-message' with FMT-STRING as
2020 (save-excursion 1874control string and the remaining ARGS to actually emit the message (if
2021 (set-buffer 1875applicable)."
2022 (tramp-get-debug-buffer 1876 (condition-case nil
2023 tramp-current-multi-method tramp-current-method 1877 (when (<= level tramp-verbose)
2024 tramp-current-user tramp-current-host)) 1878 ;; Match data must be preserved!
2025 (goto-char (point-max)) 1879 (save-match-data
2026 (unless (bolp) 1880 ;; Display only when there is a minimum level.
2027 (insert "\n")) 1881 (when (<= level 3)
2028 (tramp-insert-with-face 1882 (apply 'message
2029 'italic 1883 (concat
2030 (concat "# " (apply #'format fmt-string args) "\n")))))) 1884 (cond
2031 1885 ((= level 0) "")
2032(defun tramp-message-for-buffer 1886 ((= level 1) "")
2033 (multi-method method user host level fmt-string &rest args) 1887 ((= level 2) "Warning: ")
2034 "Like `tramp-message' but temporarily switches to the tramp buffer. 1888 (t "Tramp: "))
2035First three args METHOD, USER, and HOST identify the tramp buffer to use, 1889 fmt-string)
2036remaining args passed to `tramp-message'." 1890 args))
2037 (save-excursion 1891 ;; Log only when there is a minimum level.
2038 (set-buffer (tramp-get-buffer multi-method method user host)) 1892 (when (>= tramp-verbose 4)
2039 (apply 'tramp-message level fmt-string args))) 1893 (when (and vec-or-proc
1894 (processp vec-or-proc)
1895 (buffer-name (process-buffer vec-or-proc)))
1896 (with-current-buffer (process-buffer vec-or-proc)
1897 ;; Translate proc to vec.
1898 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
1899 (when (and vec-or-proc (vectorp vec-or-proc))
1900 (apply 'tramp-debug-message
1901 vec-or-proc
1902 (concat (format "(%d) # " level) fmt-string)
1903 args)))))
1904 ;; Suppress all errors.
1905 (error nil)))
1906
1907(defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
1908 "Emit an error.
1909VEC-OR-PROC identifies the connection to use, SIGNAL is the
1910signal identifier to be raised, remaining args passed to
1911`tramp-message'. Finally, signal SIGNAL is raised."
1912 (tramp-message
1913 vec-or-proc 1 "%s"
1914 (error-message-string
1915 (list signal (get signal 'error-message) (apply 'format fmt-string args))))
1916 (signal signal (list (apply 'format fmt-string args))))
1917
1918(defsubst tramp-error-with-buffer
1919 (buffer vec-or-proc signal fmt-string &rest args)
1920 "Emit an error, and show BUFFER.
1921If BUFFER is nil, show the connection buffer. Wait for 30\", or until
1922an input event arrives. The other arguments are passed to `tramp-error'."
1923 (save-window-excursion
1924 (unwind-protect
1925 (apply 'tramp-error vec-or-proc signal fmt-string args)
1926 (when (and vec-or-proc (not (zerop tramp-verbose)))
1927 (let ((enable-recursive-minibuffers t))
1928 (pop-to-buffer
1929 (or (and (bufferp buffer) buffer)
1930 (and (processp vec-or-proc) (process-buffer vec-or-proc))
1931 (tramp-get-buffer vec-or-proc)))
1932 (sit-for 30))))))
2040 1933
2041(defsubst tramp-line-end-position nil 1934(defsubst tramp-line-end-position nil
2042 "Return point at end of line. 1935 "Return point at end of line.
@@ -2054,18 +1947,15 @@ First arg FILENAME is evaluated and dissected into its components.
2054Second arg VAR is a symbol. It is used as a variable name to hold 1947Second arg VAR is a symbol. It is used as a variable name to hold
2055the filename structure. It is also used as a prefix for the variables 1948the filename structure. It is also used as a prefix for the variables
2056holding the components. For example, if VAR is the symbol `foo', then 1949holding the components. For example, if VAR is the symbol `foo', then
2057`foo' will be bound to the whole structure, `foo-multi-method' will 1950`foo' will be bound to the whole structure, `foo-method' will be bound to
2058be bound to the multi-method component, and so on for `foo-method', 1951the method component, and so on for `foo-user', `foo-host', `foo-localname'.
2059`foo-user', `foo-host', `foo-localname'.
2060 1952
2061Remaining args are Lisp expressions to be evaluated (inside an implicit 1953Remaining args are Lisp expressions to be evaluated (inside an implicit
2062`progn'). 1954`progn').
2063 1955
2064If VAR is nil, then we bind `v' to the structure and `multi-method', 1956If VAR is nil, then we bind `v' to the structure and `method', `user',
2065`method', `user', `host', `localname' to the components." 1957`host', `localname' to the components."
2066 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) 1958 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
2067 (,(if var (intern (concat (symbol-name var) "-multi-method")) 'multi-method)
2068 (tramp-file-name-multi-method ,(or var 'v)))
2069 (,(if var (intern (concat (symbol-name var) "-method")) 'method) 1959 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
2070 (tramp-file-name-method ,(or var 'v))) 1960 (tramp-file-name-method ,(or var 'v)))
2071 (,(if var (intern (concat (symbol-name var) "-user")) 'user) 1961 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
@@ -2077,15 +1967,45 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
2077 ,@body)) 1967 ,@body))
2078 1968
2079(put 'with-parsed-tramp-file-name 'lisp-indent-function 2) 1969(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
1970(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
2080;; Enable debugging. 1971;; Enable debugging.
2081(eval-and-compile 1972;(eval-and-compile
2082 (when (featurep 'edebug) 1973; (when (featurep 'edebug)
2083 (def-edebug-spec with-parsed-tramp-file-name (form symbolp body)))) 1974; (def-edebug-spec with-parsed-tramp-file-name (form symbolp body))))
2084;; Highlight as keyword. 1975;; Highlight as keyword.
2085(when (functionp 'font-lock-add-keywords) 1976(when (functionp 'font-lock-add-keywords)
2086 (funcall 'font-lock-add-keywords 1977 (funcall 'font-lock-add-keywords
2087 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))) 1978 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")))
2088 1979
1980(defmacro with-file-property (vec file property &rest body)
1981 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
1982FILE must be a local file name on a connection identified via VEC."
1983 `(if (file-name-absolute-p ,file)
1984 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
1985 (when (eq value 'undef)
1986 ;; We cannot pass @body as parameter to
1987 ;; `tramp-set-file-property' because it mangles our
1988 ;; debug messages.
1989 (setq value (progn ,@body))
1990 (tramp-set-file-property ,vec ,file ,property value))
1991 value)
1992 ,@body))
1993(put 'with-file-property 'lisp-indent-function 3)
1994(put 'with-file-property 'edebug-form-spec t)
1995
1996(defmacro with-connection-property (key property &rest body)
1997 "Checks in Tramp for property PROPERTY, otherwise executes BODY and set."
1998 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
1999 (when (eq value 'undef)
2000 ;; We cannot pass ,@body as parameter to
2001 ;; `tramp-set-connection-property' because it mangles our debug
2002 ;; messages.
2003 (setq value (progn ,@body))
2004 (tramp-set-connection-property ,key ,property value))
2005 value))
2006(put 'with-connection-property 'lisp-indent-function 2)
2007(put 'with-connection-property 'edebug-form-spec t)
2008
2089(defmacro tramp-let-maybe (variable value &rest body) 2009(defmacro tramp-let-maybe (variable value &rest body)
2090 "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. 2010 "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
2091BODY is executed whether or not the variable is obsolete. 2011BODY is executed whether or not the variable is obsolete.
@@ -2122,12 +2042,17 @@ Example:
2122 tramp-completion-function-alist)) 2042 tramp-completion-function-alist))
2123 2043
2124 (while v 2044 (while v
2125 ;; Remove double entries 2045 ;; Remove double entries.
2126 (when (member (car v) (cdr v)) 2046 (when (member (car v) (cdr v))
2127 (setcdr v (delete (car v) (cdr v)))) 2047 (setcdr v (delete (car v) (cdr v))))
2128 ;; Check for function and file 2048 ;; Check for function and file or registry key.
2129 (unless (and (functionp (nth 0 (car v))) 2049 (unless (and (functionp (nth 0 (car v)))
2130 (file-exists-p (nth 1 (car v)))) 2050 (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
2051 ;; Windows registry.
2052 (and (memq system-type '(cygwin windows-nt))
2053 (zerop (call-process "reg" nil nil nil "query" (nth 1 (car v)))))
2054 ;; Configuration file.
2055 (file-exists-p (nth 1 (car v)))))
2131 (setq r (delete (car v) r))) 2056 (setq r (delete (car v) r)))
2132 (setq v (cdr v))) 2057 (setq v (cdr v)))
2133 2058
@@ -2136,15 +2061,19 @@ Example:
2136 (cons method r))))) 2061 (cons method r)))))
2137 2062
2138(defun tramp-get-completion-function (method) 2063(defun tramp-get-completion-function (method)
2139 "Returns list of completion functions for METHOD. 2064 "Returns a list of completion functions for METHOD.
2140For definition of that list see `tramp-set-completion-function'." 2065For definition of that list see `tramp-set-completion-function'."
2141 (cdr (assoc method tramp-completion-function-alist))) 2066 (cons
2067 ;; Hosts visited once shall be remembered.
2068 `(tramp-parse-connection-properties ,method)
2069 ;; The method related defaults.
2070 (cdr (assoc method tramp-completion-function-alist))))
2142 2071
2143;;; File Name Handler Functions: 2072;;; File Name Handler Functions:
2144 2073
2145(defun tramp-handle-make-symbolic-link 2074(defun tramp-handle-make-symbolic-link
2146 (filename linkname &optional ok-if-already-exists) 2075 (filename linkname &optional ok-if-already-exists)
2147 "Like `make-symbolic-link' for tramp files. 2076 "Like `make-symbolic-link' for Tramp files.
2148If LINKNAME is a non-Tramp file, it is used verbatim as the target of 2077If LINKNAME is a non-Tramp file, it is used verbatim as the target of
2149the symlink. If LINKNAME is a Tramp file, only the localname component is 2078the symlink. If LINKNAME is a Tramp file, only the localname component is
2150used as the target of the symlink. 2079used as the target of the symlink.
@@ -2154,12 +2083,12 @@ it is expanded first, before the localname component is taken. Note that
2154this can give surprising results if the user/host for the source and 2083this can give surprising results if the user/host for the source and
2155target of the symlink differ." 2084target of the symlink differ."
2156 (with-parsed-tramp-file-name linkname l 2085 (with-parsed-tramp-file-name linkname l
2157 (let ((ln (tramp-get-remote-ln l-multi-method l-method l-user l-host)) 2086 (let ((ln (tramp-get-remote-ln l))
2158 (cwd (file-name-directory l-localname))) 2087 (cwd (file-name-directory l-localname)))
2159 (unless ln 2088 (unless ln
2160 (signal 'file-error 2089 (tramp-error
2161 (list "Making a symbolic link." 2090 l 'file-error
2162 "ln(1) does not exist on the remote host."))) 2091 "Making a symbolic link. ln(1) does not exist on the remote host."))
2163 2092
2164 ;; Do the 'confirm if exists' thing. 2093 ;; Do the 'confirm if exists' thing.
2165 (when (file-exists-p linkname) 2094 (when (file-exists-p linkname)
@@ -2170,7 +2099,8 @@ target of the symlink differ."
2170 (format 2099 (format
2171 "File %s already exists; make it a link anyway? " 2100 "File %s already exists; make it a link anyway? "
2172 l-localname))))) 2101 l-localname)))))
2173 (signal 'file-already-exists (list "File already exists" l-localname)) 2102 (tramp-error
2103 l 'file-already-exists "File %s already exists" l-localname)
2174 (delete-file linkname))) 2104 (delete-file linkname)))
2175 2105
2176 ;; If FILENAME is a Tramp name, use just the localname component. 2106 ;; If FILENAME is a Tramp name, use just the localname component.
@@ -2184,19 +2114,12 @@ target of the symlink differ."
2184 ;; that FILENAME belongs to. 2114 ;; that FILENAME belongs to.
2185 (zerop 2115 (zerop
2186 (tramp-send-command-and-check 2116 (tramp-send-command-and-check
2187 l-multi-method l-method l-user l-host 2117 l (format "cd %s && %s -sf %s %s" cwd ln filename l-localname) t)))))
2188 (format "cd %s && %s -sf %s %s"
2189 cwd ln
2190 filename
2191 l-localname)
2192 t)))))
2193 2118
2194 2119
2195(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) 2120(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2196 "Like `load' for tramp files. Not implemented!" 2121 "Like `load' for Tramp files."
2197 (unless (file-name-absolute-p file) 2122 (with-parsed-tramp-file-name (expand-file-name file) nil
2198 (error "Tramp cannot `load' files without absolute file name"))
2199 (with-parsed-tramp-file-name file nil
2200 (unless nosuffix 2123 (unless nosuffix
2201 (cond ((file-exists-p (concat file ".elc")) 2124 (cond ((file-exists-p (concat file ".elc"))
2202 (setq file (concat file ".elc"))) 2125 (setq file (concat file ".elc")))
@@ -2207,138 +2130,138 @@ target of the symlink differ."
2207 ;; Included for safety's sake. 2130 ;; Included for safety's sake.
2208 (unless (or (file-name-directory file) 2131 (unless (or (file-name-directory file)
2209 (string-match "\\.elc?\\'" file)) 2132 (string-match "\\.elc?\\'" file))
2210 (error "File `%s' does not include a `.el' or `.elc' suffix" 2133 (tramp-error
2211 file))) 2134 v 'file-error
2135 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2212 (unless noerror 2136 (unless noerror
2213 (when (not (file-exists-p file)) 2137 (when (not (file-exists-p file))
2214 (error "Cannot load nonexistent file `%s'" file))) 2138 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2215 (if (not (file-exists-p file)) 2139 (if (not (file-exists-p file))
2216 nil 2140 nil
2217 (unless nomessage 2141 (unless nomessage (tramp-message v 0 "Loading %s..." file))
2218 (message "Loading %s..." file))
2219 (let ((local-copy (file-local-copy file))) 2142 (let ((local-copy (file-local-copy file)))
2220 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. 2143 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2221 (load local-copy noerror t t) 2144 (load local-copy noerror t t)
2222 (delete-file local-copy)) 2145 (delete-file local-copy))
2223 (unless nomessage 2146 (unless nomessage (tramp-message v 0 "Loading %s...done" file))
2224 (message "Loading %s...done" file))
2225 t))) 2147 t)))
2226 2148
2227;; Localname manipulation functions that grok TRAMP localnames... 2149;; Localname manipulation functions that grok TRAMP localnames...
2228(defun tramp-handle-file-name-directory (file) 2150(defun tramp-handle-file-name-directory (file)
2229 "Like `file-name-directory' but aware of TRAMP files." 2151 "Like `file-name-directory' but aware of Tramp files."
2230 ;; Everything except the last filename thing is the directory. 2152 ;; Everything except the last filename thing is the directory.
2231 (with-parsed-tramp-file-name file nil 2153 (with-parsed-tramp-file-name file nil
2232 ;; Run the command on the localname portion only. 2154 ;; Run the command on the localname portion only.
2233 (tramp-make-tramp-file-name 2155 (tramp-make-tramp-file-name
2234 multi-method method user host (file-name-directory (or localname ""))))) 2156 method user host (file-name-directory (or localname "")))))
2235 2157
2236(defun tramp-handle-file-name-nondirectory (file) 2158(defun tramp-handle-file-name-nondirectory (file)
2237 "Like `file-name-nondirectory' but aware of TRAMP files." 2159 "Like `file-name-nondirectory' but aware of Tramp files."
2238 (with-parsed-tramp-file-name file nil 2160 (with-parsed-tramp-file-name file nil
2239 (file-name-nondirectory localname))) 2161 (file-name-nondirectory localname)))
2240 2162
2241(defun tramp-handle-file-truename (filename &optional counter prev-dirs) 2163(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2242 "Like `file-truename' for tramp files." 2164 "Like `file-truename' for Tramp files."
2243 (with-parsed-tramp-file-name (expand-file-name filename) nil 2165 (with-parsed-tramp-file-name (expand-file-name filename) nil
2244 (let* ((steps (tramp-split-string localname "/")) 2166 (with-file-property v localname "file-truename"
2245 (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs 2167 (let* ((steps (tramp-split-string localname "/"))
2246 (file-name-as-directory localname))) 2168 (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
2247 (is-dir (string= localname localnamedir)) 2169 (file-name-as-directory localname)))
2248 (thisstep nil) 2170 (is-dir (string= localname localnamedir))
2249 (numchase 0) 2171 (thisstep nil)
2250 ;; Don't make the following value larger than necessary. 2172 (numchase 0)
2251 ;; People expect an error message in a timely fashion when 2173 ;; Don't make the following value larger than necessary.
2252 ;; something is wrong; otherwise they might think that Emacs 2174 ;; People expect an error message in a timely fashion when
2253 ;; is hung. Of course, correctness has to come first. 2175 ;; something is wrong; otherwise they might think that Emacs
2254 (numchase-limit 20) 2176 ;; is hung. Of course, correctness has to come first.
2255 (result nil) ;result steps in reverse order 2177 (numchase-limit 20)
2256 symlink-target) 2178 (result nil) ;result steps in reverse order
2257 (tramp-message-for-buffer 2179 symlink-target)
2258 multi-method method user host 2180 (tramp-message v 4 "Finding true name for `%s'" filename)
2259 10 "Finding true name for `%s'" filename) 2181 (while (and steps (< numchase numchase-limit))
2260 (while (and steps (< numchase numchase-limit)) 2182 (setq thisstep (pop steps))
2261 (setq thisstep (pop steps)) 2183 (tramp-message
2262 (tramp-message-for-buffer 2184 v 5 "Check %s"
2263 multi-method method user host 2185 (mapconcat 'identity
2264 10 "Check %s" 2186 (append '("") (reverse result) (list thisstep))
2265 (mapconcat 'identity 2187 "/"))
2266 (append '("") (reverse result) (list thisstep)) 2188 (setq symlink-target
2267 "/")) 2189 (nth 0 (file-attributes
2268 (setq symlink-target 2190 (tramp-make-tramp-file-name
2269 (nth 0 (file-attributes 2191 method user host
2270 (tramp-make-tramp-file-name 2192 (mapconcat 'identity
2271 multi-method method user host 2193 (append '("")
2272 (mapconcat 'identity 2194 (reverse result)
2273 (append '("") 2195 (list thisstep))
2274 (reverse result) 2196 "/")))))
2275 (list thisstep)) 2197 (cond ((string= "." thisstep)
2276 "/"))))) 2198 (tramp-message v 5 "Ignoring step `.'"))
2277 (cond ((string= "." thisstep) 2199 ((string= ".." thisstep)
2278 (tramp-message-for-buffer multi-method method user host 2200 (tramp-message v 5 "Processing step `..'")
2279 10 "Ignoring step `.'")) 2201 (pop result))
2280 ((string= ".." thisstep) 2202 ((stringp symlink-target)
2281 (tramp-message-for-buffer multi-method method user host 2203 ;; It's a symlink, follow it.
2282 10 "Processing step `..'") 2204 (tramp-message v 5 "Follow symlink to %s" symlink-target)
2283 (pop result)) 2205 (setq numchase (1+ numchase))
2284 ((stringp symlink-target) 2206 (when (file-name-absolute-p symlink-target)
2285 ;; It's a symlink, follow it. 2207 (setq result nil))
2286 (tramp-message-for-buffer 2208 ;; If the symlink was absolute, we'll get a string like
2287 multi-method method user host 2209 ;; "/user@host:/some/target"; extract the
2288 10 "Follow symlink to %s" symlink-target) 2210 ;; "/some/target" part from it.
2289 (setq numchase (1+ numchase)) 2211 (when (tramp-tramp-file-p symlink-target)
2290 (when (file-name-absolute-p symlink-target) 2212 (unless (tramp-equal-remote filename symlink-target)
2291 (setq result nil)) 2213 (tramp-error
2292 ;; If the symlink was absolute, we'll get a string like 2214 v 'file-error
2293 ;; "/user@host:/some/target"; extract the 2215 "Symlink target `%s' on wrong host" symlink-target))
2294 ;; "/some/target" part from it. 2216 (setq symlink-target localname))
2295 (when (tramp-tramp-file-p symlink-target) 2217 (setq steps
2296 (with-parsed-tramp-file-name symlink-target sym 2218 (append (tramp-split-string symlink-target "/")
2297 (unless (equal (list multi-method method user host) 2219 steps)))
2298 (list sym-multi-method sym-method 2220 (t
2299 sym-user sym-host)) 2221 ;; It's a file.
2300 (error "Symlink target `%s' on wrong host" 2222 (setq result (cons thisstep result)))))
2301 symlink-target)) 2223 (when (>= numchase numchase-limit)
2302 (setq symlink-target localname))) 2224 (tramp-error
2303 (setq steps 2225 v 'file-error
2304 (append (tramp-split-string symlink-target "/") steps))) 2226 "Maximum number (%d) of symlinks exceeded" numchase-limit))
2305 (t 2227 (setq result (reverse result))
2306 ;; It's a file. 2228 ;; Combine list to form string.
2307 (setq result (cons thisstep result))))) 2229 (setq result
2308 (when (>= numchase numchase-limit) 2230 (if result
2309 (error "Maximum number (%d) of symlinks exceeded" numchase-limit)) 2231 (mapconcat 'identity (cons "" result) "/")
2310 (setq result (reverse result)) 2232 "/"))
2311 ;; Combine list to form string. 2233 (when (and is-dir (or (string= "" result)
2312 (setq result 2234 (not (string= (substring result -1) "/"))))
2313 (if result 2235 (setq result (concat result "/")))
2314 (mapconcat 'identity (cons "" result) "/") 2236 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
2315 "/")) 2237 (tramp-make-tramp-file-name method user host result)))))
2316 (when (and is-dir (or (string= "" result)
2317 (not (string= (substring result -1) "/"))))
2318 (setq result (concat result "/")))
2319 (tramp-message-for-buffer
2320 multi-method method user host
2321 10 "True name of `%s' is `%s'" filename result)
2322 (tramp-make-tramp-file-name
2323 multi-method method user host result))))
2324 2238
2325;; Basic functions. 2239;; Basic functions.
2326 2240
2327(defun tramp-handle-file-exists-p (filename) 2241(defun tramp-handle-file-exists-p (filename)
2328 "Like `file-exists-p' for tramp files." 2242 "Like `file-exists-p' for Tramp files."
2329 (with-parsed-tramp-file-name filename nil 2243 (with-parsed-tramp-file-name filename nil
2330 (save-excursion 2244 (with-file-property v localname "file-exists-p"
2331 (zerop (tramp-send-command-and-check 2245 (zerop (tramp-send-command-and-check
2332 multi-method method user host 2246 v
2333 (format 2247 (format
2334 (tramp-get-file-exists-command multi-method method user host) 2248 "%s %s"
2249 (tramp-get-file-exists-command v)
2335 (tramp-shell-quote-argument localname))))))) 2250 (tramp-shell-quote-argument localname)))))))
2336 2251
2252;; Inodes don't exist for some file systems. Therefore we must
2253;; generate virtual ones. Used in `find-buffer-visiting'. The method
2254;; applied might be not so efficient (Ange-FTP uses hashes). But
2255;; performance isn't the major issue given that file transfer will
2256;; take time.
2257(defvar tramp-inodes nil
2258 "Keeps virtual inodes numbers.")
2259
2337;; Devices must distinguish physical file systems. The device numbers 2260;; Devices must distinguish physical file systems. The device numbers
2338;; provided by "lstat" aren't unique, because we operate on different hosts. 2261;; provided by "lstat" aren't unique, because we operate on different hosts.
2339;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and 2262;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
2340;; EFS use device number "-1". In order to be different, we use device number 2263;; EFS use device number "-1". In order to be different, we use device number
2341;; (-1 x), whereby "x" is unique for a given (multi-method method user host). 2264;; (-1 x), whereby "x" is unique for a given (method user host).
2342(defvar tramp-devices nil 2265(defvar tramp-devices nil
2343 "Keeps virtual device numbers.") 2266 "Keeps virtual device numbers.")
2344 2267
@@ -2346,123 +2269,133 @@ target of the symlink differ."
2346;; when something goes wrong. 2269;; when something goes wrong.
2347;; Daniel Pittman <daniel@danann.net> 2270;; Daniel Pittman <daniel@danann.net>
2348(defun tramp-handle-file-attributes (filename &optional id-format) 2271(defun tramp-handle-file-attributes (filename &optional id-format)
2349 "Like `file-attributes' for tramp files." 2272 "Like `file-attributes' for Tramp files."
2350 (when (file-exists-p filename) 2273 (unless id-format (setq id-format 'integer))
2351 ;; file exists, find out stuff 2274 (with-parsed-tramp-file-name (expand-file-name filename) nil
2352 (unless id-format (setq id-format 'integer)) 2275 (with-file-property v localname (format "file-attributes-%s" id-format)
2353 (with-parsed-tramp-file-name filename nil 2276 (when (file-exists-p filename)
2354 (save-excursion 2277 ;; file exists, find out stuff
2355 (tramp-convert-file-attributes 2278 (save-excursion
2356 multi-method method user host 2279 (tramp-convert-file-attributes
2357 (if (tramp-get-remote-perl multi-method method user host) 2280 v
2358 (tramp-handle-file-attributes-with-perl multi-method method user host 2281 (if (tramp-get-remote-stat v)
2359 localname id-format) 2282 (tramp-handle-file-attributes-with-stat v localname id-format)
2360 (tramp-handle-file-attributes-with-ls multi-method method user host 2283 (if (tramp-get-remote-perl v)
2361 localname id-format))))))) 2284 (tramp-handle-file-attributes-with-perl v localname id-format)
2362 2285 (tramp-handle-file-attributes-with-ls
2363(defun tramp-handle-file-attributes-with-ls 2286 v localname id-format)))))))))
2364 (multi-method method user host localname &optional id-format) 2287
2365 "Implement `file-attributes' for tramp files using the ls(1) command." 2288(defun tramp-handle-file-attributes-with-ls (vec localname &optional id-format)
2289 "Implement `file-attributes' for Tramp files using the ls(1) command."
2366 (let (symlinkp dirp 2290 (let (symlinkp dirp
2367 res-inode res-filemodes res-numlinks 2291 res-inode res-filemodes res-numlinks
2368 res-uid res-gid res-size res-symlink-target) 2292 res-uid res-gid res-size res-symlink-target)
2369 (tramp-message-for-buffer multi-method method user host 10 2293 (tramp-message vec 5 "file attributes with ls: %s" localname)
2370 "file attributes with ls: %s"
2371 (tramp-make-tramp-file-name
2372 multi-method method user host localname))
2373 (tramp-send-command 2294 (tramp-send-command
2374 multi-method method user host 2295 vec
2375 (format "%s %s %s" 2296 (format "%s %s %s"
2376 (tramp-get-ls-command multi-method method user host) 2297 (tramp-get-ls-command vec)
2377 (if (eq id-format 'integer) "-ildn" "-ild") 2298 (if (eq id-format 'integer) "-ildn" "-ild")
2378 (tramp-shell-quote-argument localname))) 2299 (tramp-shell-quote-argument localname)))
2379 (tramp-wait-for-output)
2380 ;; parse `ls -l' output ... 2300 ;; parse `ls -l' output ...
2381 ;; ... inode 2301 (with-current-buffer (tramp-get-buffer vec)
2382 (setq res-inode 2302 (goto-char (point-min))
2383 (condition-case err 2303 ;; ... inode
2384 (read (current-buffer)) 2304 (setq res-inode
2385 (invalid-read-syntax 2305 (condition-case err
2386 (when (and (equal (cadr err) 2306 (read (current-buffer))
2387 "Integer constant overflow in reader") 2307 (invalid-read-syntax
2388 (string-match 2308 (when (and (equal (cadr err)
2389 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'" 2309 "Integer constant overflow in reader")
2390 (car (cddr err)))) 2310 (string-match
2391 (let* ((big (read (substring (car (cddr err)) 0 2311 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
2392 (match-beginning 1)))) 2312 (car (cddr err))))
2393 (small (read (match-string 1 (car (cddr err))))) 2313 (let* ((big (read (substring (car (cddr err)) 0
2394 (twiddle (/ small 65536))) 2314 (match-beginning 1))))
2395 (cons (+ big twiddle) 2315 (small (read (match-string 1 (car (cddr err)))))
2396 (- small (* twiddle 65536)))))))) 2316 (twiddle (/ small 65536)))
2397 ;; ... file mode flags 2317 (cons (+ big twiddle)
2398 (setq res-filemodes (symbol-name (read (current-buffer)))) 2318 (- small (* twiddle 65536))))))))
2399 ;; ... number links 2319 ;; ... file mode flags
2400 (setq res-numlinks (read (current-buffer))) 2320 (setq res-filemodes (symbol-name (read (current-buffer))))
2401 ;; ... uid and gid 2321 ;; ... number links
2402 (setq res-uid (read (current-buffer))) 2322 (setq res-numlinks (read (current-buffer)))
2403 (setq res-gid (read (current-buffer))) 2323 ;; ... uid and gid
2404 (when (eq id-format 'integer) 2324 (setq res-uid (read (current-buffer)))
2405 (unless (numberp res-uid) (setq res-uid -1)) 2325 (setq res-gid (read (current-buffer)))
2406 (unless (numberp res-gid) (setq res-gid -1))) 2326 (if (eq id-format 'integer)
2407 ;; ... size 2327 (progn
2408 (setq res-size (read (current-buffer))) 2328 (unless (numberp res-uid) (setq res-uid -1))
2409 ;; From the file modes, figure out other stuff. 2329 (unless (numberp res-gid) (setq res-gid -1)))
2410 (setq symlinkp (eq ?l (aref res-filemodes 0))) 2330 (progn
2411 (setq dirp (eq ?d (aref res-filemodes 0))) 2331 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
2412 ;; if symlink, find out file name pointed to 2332 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
2413 (when symlinkp 2333 ;; ... size
2414 (search-forward "-> ") 2334 (setq res-size (read (current-buffer)))
2415 (setq res-symlink-target 2335 ;; From the file modes, figure out other stuff.
2416 (buffer-substring (point) 2336 (setq symlinkp (eq ?l (aref res-filemodes 0)))
2417 (tramp-line-end-position)))) 2337 (setq dirp (eq ?d (aref res-filemodes 0)))
2418 ;; return data gathered 2338 ;; if symlink, find out file name pointed to
2419 (list 2339 (when symlinkp
2420 ;; 0. t for directory, string (name linked to) for symbolic 2340 (search-forward "-> ")
2421 ;; link, or nil. 2341 (setq res-symlink-target
2422 (or dirp res-symlink-target nil) 2342 (buffer-substring (point) (tramp-line-end-position))))
2423 ;; 1. Number of links to file. 2343 ;; return data gathered
2424 res-numlinks 2344 (list
2425 ;; 2. File uid. 2345 ;; 0. t for directory, string (name linked to) for symbolic
2426 res-uid 2346 ;; link, or nil.
2427 ;; 3. File gid. 2347 (or dirp res-symlink-target)
2428 res-gid 2348 ;; 1. Number of links to file.
2429 ;; 4. Last access time, as a list of two integers. First 2349 res-numlinks
2430 ;; integer has high-order 16 bits of time, second has low 16 2350 ;; 2. File uid.
2431 ;; bits. 2351 res-uid
2432 ;; 5. Last modification time, likewise. 2352 ;; 3. File gid.
2433 ;; 6. Last status change time, likewise. 2353 res-gid
2434 '(0 0) '(0 0) '(0 0) ;CCC how to find out? 2354 ;; 4. Last access time, as a list of two integers. First
2435 ;; 7. Size in bytes (-1, if number is out of range). 2355 ;; integer has high-order 16 bits of time, second has low 16
2436 res-size 2356 ;; bits.
2437 ;; 8. File modes, as a string of ten letters or dashes as in ls -l. 2357 ;; 5. Last modification time, likewise.
2438 res-filemodes 2358 ;; 6. Last status change time, likewise.
2439 ;; 9. t iff file's gid would change if file were deleted and 2359 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2440 ;; recreated. Will be set in `tramp-convert-file-attributes' 2360 ;; 7. Size in bytes (-1, if number is out of range).
2441 t 2361 res-size
2442 ;; 10. inode number. 2362 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2443 res-inode 2363 res-filemodes
2444 ;; 11. Device number. Will be replaced by a virtual device number. 2364 ;; 9. t iff file's gid would change if file were deleted and
2445 -1 2365 ;; recreated. Will be set in `tramp-convert-file-attributes'
2446 ))) 2366 t
2367 ;; 10. inode number.
2368 res-inode
2369 ;; 11. Device number. Will be replaced by a virtual device number.
2370 -1
2371 ))))
2447 2372
2448(defun tramp-handle-file-attributes-with-perl 2373(defun tramp-handle-file-attributes-with-perl
2449 (multi-method method user host localname &optional id-format) 2374 (vec localname &optional id-format)
2450 "Implement `file-attributes' for tramp files using a Perl script." 2375 "Implement `file-attributes' for Tramp files using a Perl script."
2451 (tramp-message-for-buffer multi-method method user host 10 2376 (tramp-message vec 5 "file attributes with perl: %s" localname)
2452 "file attributes with perl: %s" 2377 (tramp-maybe-send-script
2453 (tramp-make-tramp-file-name 2378 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
2454 multi-method method user host localname)) 2379 (tramp-send-command-and-read
2455 (tramp-maybe-send-perl-script multi-method method user host 2380 vec
2456 tramp-perl-file-attributes 2381 (format "tramp_perl_file_attributes %s %s"
2457 "tramp_file_attributes") 2382 (tramp-shell-quote-argument localname) id-format)))
2458 (tramp-send-command multi-method method user host 2383
2459 (format "tramp_file_attributes %s %s" 2384(defun tramp-handle-file-attributes-with-stat
2460 (tramp-shell-quote-argument localname) id-format)) 2385 (vec localname &optional id-format)
2461 (tramp-wait-for-output) 2386 "Implement `file-attributes' for Tramp files using stat(1) command."
2462 (read (current-buffer))) 2387 (tramp-message vec 5 "file attributes with stat: %s" localname)
2388 (tramp-send-command-and-read
2389 vec
2390 (format
2391 "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s \"%%A\" t %%i.0 -1)' %s"
2392 (tramp-get-remote-stat vec)
2393 (if (eq id-format 'integer) "%u" "\"%U\"")
2394 (if (eq id-format 'integer) "%g" "\"%G\"")
2395 (tramp-shell-quote-argument localname))))
2463 2396
2464(defun tramp-handle-set-visited-file-modtime (&optional time-list) 2397(defun tramp-handle-set-visited-file-modtime (&optional time-list)
2465 "Like `set-visited-file-modtime' for tramp files." 2398 "Like `set-visited-file-modtime' for Tramp files."
2466 (unless (buffer-file-name) 2399 (unless (buffer-file-name)
2467 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" 2400 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2468 (buffer-name))) 2401 (buffer-name)))
@@ -2480,16 +2413,16 @@ target of the symlink differ."
2480 ;; `tramp-handle-file-attributes-with-ls'. 2413 ;; `tramp-handle-file-attributes-with-ls'.
2481 (if (not (equal modtime '(0 0))) 2414 (if (not (equal modtime '(0 0)))
2482 (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) 2415 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2483 (save-excursion 2416 (progn
2484 (tramp-send-command 2417 (tramp-send-command
2485 multi-method method user host 2418 v
2486 (format "%s -ild %s" 2419 (format "%s -ild %s"
2487 (tramp-get-ls-command multi-method method user host) 2420 (tramp-get-ls-command v)
2488 (tramp-shell-quote-argument localname))) 2421 (tramp-shell-quote-argument localname)))
2489 (tramp-wait-for-output)
2490 (setq attr (buffer-substring (point) 2422 (setq attr (buffer-substring (point)
2491 (progn (end-of-line) (point))))) 2423 (progn (end-of-line) (point)))))
2492 (setq tramp-buffer-file-attributes attr)) 2424 (tramp-set-file-property
2425 v localname "visited-file-modtime-ild" attr))
2493 (when (boundp 'last-coding-system-used) 2426 (when (boundp 'last-coding-system-used)
2494 (set 'last-coding-system-used coding-system-used)) 2427 (set 'last-coding-system-used coding-system-used))
2495 nil))))) 2428 nil)))))
@@ -2499,7 +2432,7 @@ target of the symlink differ."
2499;; This function makes the same assumption as 2432;; This function makes the same assumption as
2500;; `tramp-handle-set-visited-file-modtime'. 2433;; `tramp-handle-set-visited-file-modtime'.
2501(defun tramp-handle-verify-visited-file-modtime (buf) 2434(defun tramp-handle-verify-visited-file-modtime (buf)
2502 "Like `verify-visited-file-modtime' for tramp files. 2435 "Like `verify-visited-file-modtime' for Tramp files.
2503At the time `verify-visited-file-modtime' calls this function, we 2436At the time `verify-visited-file-modtime' calls this function, we
2504already know that the buffer is visiting a file and that 2437already know that the buffer is visiting a file and that
2505`visited-file-modtime' does not return 0. Do not call this 2438`visited-file-modtime' does not return 0. Do not call this
@@ -2531,53 +2464,48 @@ of."
2531 2)) 2464 2))
2532 ;; modtime has the don't know value. 2465 ;; modtime has the don't know value.
2533 (attr 2466 (attr
2534 (save-excursion 2467 (tramp-send-command
2535 (tramp-send-command 2468 v
2536 multi-method method user host 2469 (format "%s -ild %s"
2537 (format "%s -ild %s" 2470 (tramp-get-ls-command v)
2538 (tramp-get-ls-command multi-method method user host) 2471 (tramp-shell-quote-argument localname)))
2539 (tramp-shell-quote-argument localname))) 2472 (with-current-buffer (tramp-get-buffer v)
2540 (tramp-wait-for-output)
2541 (setq attr (buffer-substring 2473 (setq attr (buffer-substring
2542 (point) (progn (end-of-line) (point))))) 2474 (point) (progn (end-of-line) (point)))))
2543 (equal tramp-buffer-file-attributes attr)) 2475 (equal
2476 attr
2477 (tramp-get-file-property
2478 v localname "visited-file-modtime-ild" "")))
2544 ;; If file does not exist, say it is not modified 2479 ;; If file does not exist, say it is not modified
2545 ;; if and only if that agrees with the buffer's record. 2480 ;; if and only if that agrees with the buffer's record.
2546 (t (equal mt '(-1 65535)))))))))) 2481 (t (equal mt '(-1 65535))))))))))
2547 2482
2548(defun tramp-handle-set-file-modes (filename mode) 2483(defun tramp-handle-set-file-modes (filename mode)
2549 "Like `set-file-modes' for tramp files." 2484 "Like `set-file-modes' for Tramp files."
2550 (with-parsed-tramp-file-name filename nil 2485 (with-parsed-tramp-file-name filename nil
2551 (save-excursion 2486 (tramp-flush-file-property v localname)
2552 (unless (zerop (tramp-send-command-and-check 2487 (unless (zerop (tramp-send-command-and-check
2553 multi-method method user host 2488 v
2554 (format "chmod %s %s" 2489 (format "chmod %s %s"
2555 (tramp-decimal-to-octal mode) 2490 (tramp-decimal-to-octal mode)
2556 (tramp-shell-quote-argument localname)))) 2491 (tramp-shell-quote-argument localname))))
2557 (signal 'file-error 2492 ;; FIXME: extract the proper text from chmod's stderr.
2558 (list "Doing chmod" 2493 (tramp-error
2559 ;; FIXME: extract the proper text from chmod's stderr. 2494 v 'file-error "Error while changing file's mode %s" filename))))
2560 "error while changing file's mode"
2561 filename))))))
2562 2495
2563;; Simple functions using the `test' command. 2496;; Simple functions using the `test' command.
2564 2497
2565(defun tramp-handle-file-executable-p (filename) 2498(defun tramp-handle-file-executable-p (filename)
2566 "Like `file-executable-p' for tramp files." 2499 "Like `file-executable-p' for Tramp files."
2567 (with-parsed-tramp-file-name filename nil 2500 (with-parsed-tramp-file-name filename nil
2568 (zerop (tramp-run-test "-x" filename)))) 2501 (with-file-property v localname "file-executable-p"
2502 (zerop (tramp-run-test "-x" filename)))))
2569 2503
2570(defun tramp-handle-file-readable-p (filename) 2504(defun tramp-handle-file-readable-p (filename)
2571 "Like `file-readable-p' for tramp files." 2505 "Like `file-readable-p' for Tramp files."
2572 (with-parsed-tramp-file-name filename nil
2573 (zerop (tramp-run-test "-r" filename))))
2574
2575(defun tramp-handle-file-accessible-directory-p (filename)
2576 "Like `file-accessible-directory-p' for tramp files."
2577 (with-parsed-tramp-file-name filename nil 2506 (with-parsed-tramp-file-name filename nil
2578 (and (zerop (tramp-run-test "-d" filename)) 2507 (with-file-property v localname "file-readable-p"
2579 (zerop (tramp-run-test "-r" filename)) 2508 (zerop (tramp-run-test "-r" filename)))))
2580 (zerop (tramp-run-test "-x" filename)))))
2581 2509
2582;; When the remote shell is started, it looks for a shell which groks 2510;; When the remote shell is started, it looks for a shell which groks
2583;; tilde expansion. Here, we assume that all shells which grok tilde 2511;; tilde expansion. Here, we assume that all shells which grok tilde
@@ -2585,7 +2513,7 @@ of."
2585;; newer than). If this breaks, tell me about it and I'll try to do 2513;; newer than). If this breaks, tell me about it and I'll try to do
2586;; something smarter about it. 2514;; something smarter about it.
2587(defun tramp-handle-file-newer-than-file-p (file1 file2) 2515(defun tramp-handle-file-newer-than-file-p (file1 file2)
2588 "Like `file-newer-than-file-p' for tramp files." 2516 "Like `file-newer-than-file-p' for Tramp files."
2589 (cond ((not (file-exists-p file1)) 2517 (cond ((not (file-exists-p file1))
2590 nil) 2518 nil)
2591 ((not (file-exists-p file2)) 2519 ((not (file-exists-p file2))
@@ -2606,44 +2534,27 @@ of."
2606 ;; However, this only works if both files are Tramp 2534 ;; However, this only works if both files are Tramp
2607 ;; files and both have the same method, same user, same 2535 ;; files and both have the same method, same user, same
2608 ;; host. 2536 ;; host.
2609 (unless (and (tramp-tramp-file-p file1) 2537 (unless (tramp-equal-remote file1 file2)
2610 (tramp-tramp-file-p file2)) 2538 (with-parsed-tramp-file-name
2611 (signal 2539 (if (tramp-tramp-file-p file1) file1 file2) nil
2612 'file-error 2540 (tramp-error
2613 (list 2541 v 'file-error
2614 "Cannot check if Tramp file is newer than non-Tramp file" 2542 "Files %s and %s must have same method, user, host"
2615 file1 file2))) 2543 file1 file2)))
2616 (with-parsed-tramp-file-name file1 v1 2544 (with-parsed-tramp-file-name file1 nil
2617 (with-parsed-tramp-file-name file2 v2 2545 (zerop (tramp-run-test2
2618 (unless (and (equal v1-multi-method v2-multi-method) 2546 (tramp-get-test-nt-command v) file1 file2)))))))))
2619 (equal v1-method v2-method)
2620 (equal v1-user v2-user)
2621 (equal v1-host v2-host))
2622 (signal 'file-error
2623 (list "Files must have same method, user, host"
2624 file1 file2)))
2625 (unless (and (tramp-tramp-file-p file1)
2626 (tramp-tramp-file-p file2))
2627 (signal 'file-error
2628 (list "Files must be tramp files on same host"
2629 file1 file2)))
2630 (if (tramp-get-test-groks-nt
2631 v1-multi-method v1-method v1-user v1-host)
2632 (zerop (tramp-run-test2 "test" file1 file2 "-nt"))
2633 (zerop (tramp-run-test2
2634 "tramp_test_nt" file1 file2)))))))))))
2635 2547
2636;; Functions implemented using the basic functions above. 2548;; Functions implemented using the basic functions above.
2637 2549
2638(defun tramp-handle-file-modes (filename) 2550(defun tramp-handle-file-modes (filename)
2639 "Like `file-modes' for tramp files." 2551 "Like `file-modes' for Tramp files."
2640 (with-parsed-tramp-file-name filename nil 2552 (when (file-exists-p filename)
2641 (when (file-exists-p filename) 2553 (tramp-mode-string-to-int
2642 (tramp-mode-string-to-int 2554 (nth 8 (file-attributes filename)))))
2643 (nth 8 (file-attributes filename))))))
2644 2555
2645(defun tramp-handle-file-directory-p (filename) 2556(defun tramp-handle-file-directory-p (filename)
2646 "Like `file-directory-p' for tramp files." 2557 "Like `file-directory-p' for Tramp files."
2647 ;; Care must be taken that this function returns `t' for symlinks 2558 ;; Care must be taken that this function returns `t' for symlinks
2648 ;; pointing to directories. Surely the most obvious implementation 2559 ;; pointing to directories. Surely the most obvious implementation
2649 ;; would be `test -d', but that returns false for such symlinks. 2560 ;; would be `test -d', but that returns false for such symlinks.
@@ -2653,78 +2564,52 @@ of."
2653 ;; 2564 ;;
2654 ;; Alternatives: `cd %s', `test -d %s' 2565 ;; Alternatives: `cd %s', `test -d %s'
2655 (with-parsed-tramp-file-name filename nil 2566 (with-parsed-tramp-file-name filename nil
2656 (save-excursion 2567 (with-file-property v localname "file-directory-p"
2657 (zerop 2568 (zerop (tramp-run-test "-d" filename)))))
2658 (tramp-send-command-and-check
2659 multi-method method user host
2660 (format "test -d %s"
2661 (tramp-shell-quote-argument localname))
2662 t))))) ;run command in subshell
2663 2569
2664(defun tramp-handle-file-regular-p (filename) 2570(defun tramp-handle-file-regular-p (filename)
2665 "Like `file-regular-p' for tramp files." 2571 "Like `file-regular-p' for Tramp files."
2666 (with-parsed-tramp-file-name filename nil 2572 (and (file-exists-p filename)
2667 (and (file-exists-p filename) 2573 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
2668 (eq ?- (aref (nth 8 (file-attributes filename)) 0)))))
2669 2574
2670(defun tramp-handle-file-symlink-p (filename) 2575(defun tramp-handle-file-symlink-p (filename)
2671 "Like `file-symlink-p' for tramp files." 2576 "Like `file-symlink-p' for Tramp files."
2672 (with-parsed-tramp-file-name filename nil 2577 (with-parsed-tramp-file-name filename nil
2673 (let ((x (car (file-attributes filename)))) 2578 (let ((x (car (file-attributes filename))))
2674 (when (stringp x) 2579 (when (stringp x)
2675 ;; When Tramp is running on VMS, then `file-name-absolute-p' 2580 ;; When Tramp is running on VMS, then `file-name-absolute-p'
2676 ;; might do weird things. 2581 ;; might do weird things.
2677 (if (file-name-absolute-p x) 2582 (if (file-name-absolute-p x)
2678 (tramp-make-tramp-file-name 2583 (tramp-make-tramp-file-name method user host x)
2679 multi-method method user host x)
2680 x))))) 2584 x)))))
2681 2585
2682(defun tramp-handle-file-writable-p (filename) 2586(defun tramp-handle-file-writable-p (filename)
2683 "Like `file-writable-p' for tramp files." 2587 "Like `file-writable-p' for Tramp files."
2684 (with-parsed-tramp-file-name filename nil 2588 (with-parsed-tramp-file-name filename nil
2685 (if (file-exists-p filename) 2589 (with-file-property v localname "file-writable-p"
2686 ;; Existing files must be writable. 2590 (if (file-exists-p filename)
2687 (zerop (tramp-run-test "-w" filename)) 2591 ;; Existing files must be writable.
2688 ;; If file doesn't exist, check if directory is writable. 2592 (zerop (tramp-run-test "-w" filename))
2689 (and (zerop (tramp-run-test 2593 ;; If file doesn't exist, check if directory is writable.
2690 "-d" (file-name-directory filename))) 2594 (and (zerop (tramp-run-test
2691 (zerop (tramp-run-test 2595 "-d" (file-name-directory filename)))
2692 "-w" (file-name-directory filename))))))) 2596 (zerop (tramp-run-test
2597 "-w" (file-name-directory filename))))))))
2693 2598
2694(defun tramp-handle-file-ownership-preserved-p (filename) 2599(defun tramp-handle-file-ownership-preserved-p (filename)
2695 "Like `file-ownership-preserved-p' for tramp files." 2600 "Like `file-ownership-preserved-p' for Tramp files."
2696 (with-parsed-tramp-file-name filename nil 2601 (with-parsed-tramp-file-name filename nil
2697 (let ((attributes (file-attributes filename))) 2602 (with-file-property v localname "file-ownership-preserved-p"
2698 ;; Return t if the file doesn't exist, since it's true that no 2603 (let ((attributes (file-attributes filename)))
2699 ;; information would be lost by an (attempted) delete and create. 2604 ;; Return t if the file doesn't exist, since it's true that no
2700 (or (null attributes) 2605 ;; information would be lost by an (attempted) delete and create.
2701 (= (nth 2 attributes) 2606 (or (null attributes)
2702 (tramp-get-remote-uid multi-method method user host)))))) 2607 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
2703 2608
2704;; Other file name ops. 2609;; Other file name ops.
2705 2610
2706;; ;; Matthias K,Av(Bppe <mkoeppe@mail.math.uni-magdeburg.de>
2707;; (defun tramp-handle-directory-file-name (directory)
2708;; "Like `directory-file-name' for tramp files."
2709;; (if (and (eq (aref directory (- (length directory) 1)) ?/)
2710;; (not (eq (aref directory (- (length directory) 2)) ?:)))
2711;; (substring directory 0 (- (length directory) 1))
2712;; directory))
2713
2714;; ;; Philippe Troin <phil@fifi.org>
2715;; (defun tramp-handle-directory-file-name (directory)
2716;; "Like `directory-file-name' for tramp files."
2717;; (with-parsed-tramp-file-name directory nil
2718;; (let ((directory-length-1 (1- (length directory))))
2719;; (save-match-data
2720;; (if (and (eq (aref directory directory-length-1) ?/)
2721;; (eq (string-match tramp-file-name-regexp directory) 0)
2722;; (/= (match-end 0) directory-length-1))
2723;; (substring directory 0 directory-length-1)
2724;; directory)))))
2725
2726(defun tramp-handle-directory-file-name (directory) 2611(defun tramp-handle-directory-file-name (directory)
2727 "Like `directory-file-name' for tramp files." 2612 "Like `directory-file-name' for Tramp files."
2728 ;; If localname component of filename is "/", leave it unchanged. 2613 ;; If localname component of filename is "/", leave it unchanged.
2729 ;; Otherwise, remove any trailing slash from localname component. 2614 ;; Otherwise, remove any trailing slash from localname component.
2730 ;; Method, host, etc, are unchanged. Does it make sense to try 2615 ;; Method, host, etc, are unchanged. Does it make sense to try
@@ -2738,145 +2623,137 @@ of."
2738 2623
2739;; Directory listings. 2624;; Directory listings.
2740 2625
2741(defun tramp-handle-directory-files (directory 2626(defun tramp-handle-directory-files
2742 &optional full match nosort files-only) 2627 (directory &optional full match nosort files-only)
2743 "Like `directory-files' for tramp files." 2628 "Like `directory-files' for Tramp files."
2744 (with-parsed-tramp-file-name directory nil 2629 ;; FILES-ONLY is valid for XEmacs only.
2745 (let (result x) 2630 (when (file-directory-p directory)
2746 (save-excursion 2631 (setq directory (expand-file-name directory))
2747 (tramp-barf-unless-okay 2632 (let ((temp (nreverse (file-name-all-completions "" directory)))
2748 multi-method method user host 2633 result item)
2749 (concat "cd " (tramp-shell-quote-argument localname)) 2634
2750 nil 2635 (while temp
2751 'file-error 2636 (setq item (directory-file-name (pop temp)))
2752 "tramp-handle-directory-files: couldn't `cd %s'" 2637 (when (and (or (null match) (string-match match item))
2753 (tramp-shell-quote-argument localname)) 2638 (or (null files-only)
2754 (tramp-send-command 2639 ;; files only
2755 multi-method method user host 2640 (and (equal files-only t) (file-regular-p item))
2756 (concat (tramp-get-ls-command multi-method method user host) 2641 ;; directories only
2757 " -a | cat")) 2642 (file-directory-p item)))
2758 (tramp-wait-for-output) 2643 (push (if full (expand-file-name item directory) item)
2759 (goto-char (point-max)) 2644 result)))
2760 (while (zerop (forward-line -1))
2761 (setq x (buffer-substring (point)
2762 (tramp-line-end-position)))
2763 (when (or (not match) (string-match match x))
2764 (if full
2765 (push (concat (file-name-as-directory directory)
2766 x)
2767 result)
2768 (push x result))))
2769 (tramp-send-command multi-method method user host "cd")
2770 (tramp-wait-for-output)
2771 ;; Remove non-files or non-directories if necessary. Using
2772 ;; the remote shell for this would probably be way faster.
2773 ;; Maybe something could be adapted from
2774 ;; tramp-handle-file-name-all-completions.
2775 (when files-only
2776 (let ((temp (nreverse result))
2777 item)
2778 (setq result nil)
2779 (if (equal files-only t)
2780 ;; files only
2781 (while temp
2782 (setq item (pop temp))
2783 (when (file-regular-p item)
2784 (push item result)))
2785 ;; directories only
2786 (while temp
2787 (setq item (pop temp))
2788 (when (file-directory-p item)
2789 (push item result)))))))
2790 result))) 2645 result)))
2791 2646
2792(defun tramp-handle-directory-files-and-attributes 2647(defun tramp-handle-directory-files-and-attributes
2793 (directory &optional full match nosort id-format) 2648 (directory &optional full match nosort id-format)
2794 "Like `directory-files-and-attributes' for tramp files." 2649 "Like `directory-files-and-attributes' for Tramp files."
2795 (when (tramp-handle-file-exists-p directory) 2650 (unless id-format (setq id-format 'integer))
2796 (save-excursion 2651 (when (file-directory-p directory)
2797 (setq directory (tramp-handle-expand-file-name directory)) 2652 (setq directory (expand-file-name directory))
2798 (with-parsed-tramp-file-name directory nil 2653 (let* ((temp
2799 (tramp-maybe-send-perl-script multi-method method user host 2654 (copy-tree
2800 tramp-perl-directory-files-and-attributes 2655 (with-parsed-tramp-file-name directory nil
2801 "tramp_directory_files_and_attributes") 2656 (with-file-property
2802 (tramp-send-command multi-method method user host 2657 v localname
2803 (format "tramp_directory_files_and_attributes %s %s" 2658 (format "directory-files-and-attributes-%s" id-format)
2804 (tramp-shell-quote-argument localname) 2659 (save-excursion
2805 (or id-format 'integer))) 2660 (mapcar
2806 (tramp-wait-for-output) 2661 '(lambda (x)
2807 (let* ((root (cons nil (let ((object (read (current-buffer)))) 2662 (cons (car x)
2808 (when (stringp object) 2663 (tramp-convert-file-attributes v (cdr x))))
2809 (error object)) 2664 (if (tramp-get-remote-stat v)
2810 object))) 2665 (tramp-handle-directory-files-and-attributes-with-stat
2811 (cell root)) 2666 v localname id-format)
2812 (while (cdr cell) 2667 (if (tramp-get-remote-perl v)
2813 (if (and match (not (string-match match (car (cadr cell))))) 2668 (tramp-handle-directory-files-and-attributes-with-perl
2814 ;; Remove from list 2669 v localname id-format)))))))))
2815 (setcdr cell (cddr cell)) 2670 result item)
2816 ;; Include in list 2671
2817 (setq cell (cdr cell)) 2672 (while temp
2818 (let ((l (car cell))) 2673 (setq item (pop temp))
2819 (tramp-convert-file-attributes multi-method method user host 2674 (when (or (null match) (string-match match (car item)))
2820 (cdr l)) 2675 (when full
2821 ;; If FULL, make file name absolute 2676 (setcar item (expand-file-name (car item) directory)))
2822 (when full (setcar l (concat directory "/" (car l))))))) 2677 (push item result)))
2823 (if nosort 2678
2824 (cdr root) 2679 (if nosort
2825 (sort (cdr root) (lambda (x y) (string< (car x) (car y)))))))))) 2680 result
2681 (sort result (lambda (x y) (string< (car x) (car y))))))))
2682
2683(defun tramp-handle-directory-files-and-attributes-with-perl
2684 (vec localname &optional id-format)
2685 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
2686 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
2687 (tramp-maybe-send-script
2688 vec tramp-perl-directory-files-and-attributes
2689 "tramp_perl_directory_files_and_attributes")
2690 (let ((object
2691 (tramp-send-command-and-read
2692 vec
2693 (format "tramp_perl_directory_files_and_attributes %s %s"
2694 (tramp-shell-quote-argument localname) id-format))))
2695 (when (stringp object) (tramp-error vec 'file-error object))
2696 object))
2697
2698(defun tramp-handle-directory-files-and-attributes-with-stat
2699 (vec localname &optional id-format)
2700 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
2701 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
2702 (tramp-send-command-and-read
2703 vec
2704 (format
2705 (concat
2706 "cd %s; echo \"(\"; (%s -ab | xargs "
2707 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s \"%%A\" t %%i.0 -1)'); "
2708 "echo \")\"")
2709 (tramp-shell-quote-argument localname)
2710 (tramp-get-ls-command vec)
2711 (tramp-get-remote-stat vec)
2712 (if (eq id-format 'integer) "%u" "\"%U\"")
2713 (if (eq id-format 'integer) "%g" "\"%G\""))))
2826 2714
2827;; This function should return "foo/" for directories and "bar" for 2715;; This function should return "foo/" for directories and "bar" for
2828;; files. We use `ls -ad' to get a list of files (including 2716;; files.
2829;; directories), and `find . -type d \! -name . -prune' to get a list
2830;; of directories.
2831(defun tramp-handle-file-name-all-completions (filename directory) 2717(defun tramp-handle-file-name-all-completions (filename directory)
2832 "Like `file-name-all-completions' for tramp files." 2718 "Like `file-name-all-completions' for Tramp files."
2833 (with-parsed-tramp-file-name directory nil 2719 (unless (save-match-data (string-match "/" filename))
2834 (unless (save-match-data (string-match "/" filename)) 2720 (with-parsed-tramp-file-name directory nil
2835 (let* ((nowild tramp-completion-without-shell-p) 2721 (all-completions
2836 result) 2722 filename
2837 (save-excursion 2723 (mapcar
2838 (tramp-barf-unless-okay 2724 'list
2839 multi-method method user host 2725 (with-file-property v localname "file-name-all-completions"
2840 (format "cd %s" (tramp-shell-quote-argument localname)) 2726 (let (result)
2841 nil 'file-error 2727 (tramp-barf-unless-okay
2842 "tramp-handle-file-name-all-completions: Couldn't `cd %s'" 2728 v
2843 (tramp-shell-quote-argument localname)) 2729 (format "cd %s" (tramp-shell-quote-argument localname))
2844 2730 "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
2845 ;; Get a list of directories and files, including reliably 2731 (tramp-shell-quote-argument localname))
2846 ;; tagging the directories with a trailing '/'. Because I 2732
2847 ;; rock. --daniel@danann.net 2733 ;; Get a list of directories and files, including reliably
2848 (tramp-send-command 2734 ;; tagging the directories with a trailing '/'. Because I
2849 multi-method method user host 2735 ;; rock. --daniel@danann.net
2850 (format (concat "%s -a %s 2>/dev/null | while read f; do " 2736 (tramp-send-command
2851 "if test -d \"$f\" 2>/dev/null; " 2737 v
2852 "then echo \"$f/\"; else echo \"$f\"; fi; done") 2738 (format (concat "%s -ab 2>/dev/null | while read f; do "
2853 (tramp-get-ls-command multi-method method user host) 2739 "if %s -d \"$f\" 2>/dev/null; "
2854 (if (or nowild (zerop (length filename))) 2740 "then echo \"$f/\"; else echo \"$f\"; fi; done")
2855 "" 2741 (tramp-get-ls-command v)
2856 (format "-d %s*" 2742 (tramp-get-test-command v)))
2857 (tramp-shell-quote-argument filename))))) 2743
2858 2744 ;; Now grab the output.
2859 ;; Now grab the output. 2745 (with-current-buffer (tramp-get-buffer v)
2860 (tramp-wait-for-output) 2746 (goto-char (point-max))
2861 (goto-char (point-max)) 2747 (while (zerop (forward-line -1))
2862 (while (zerop (forward-line -1)) 2748 (push (buffer-substring (point) (tramp-line-end-position))
2863 (push (buffer-substring (point) 2749 result)))
2864 (tramp-line-end-position)) 2750
2865 result)) 2751 result)))))))
2866
2867 (tramp-send-command multi-method method user host "cd")
2868 (tramp-wait-for-output)
2869
2870 ;; Return the list.
2871 (if nowild
2872 (all-completions filename (mapcar 'list result))
2873 result))))))
2874
2875 2752
2876;; The following isn't needed for Emacs 20 but for 19.34? 2753;; The following isn't needed for Emacs 20 but for 19.34?
2877(defun tramp-handle-file-name-completion 2754(defun tramp-handle-file-name-completion
2878 (filename directory &optional predicate) 2755 (filename directory &optional predicate)
2879 "Like `file-name-completion' for tramp files." 2756 "Like `file-name-completion' for Tramp files."
2880 (unless (tramp-tramp-file-p directory) 2757 (unless (tramp-tramp-file-p directory)
2881 (error 2758 (error
2882 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" 2759 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
@@ -2891,18 +2768,17 @@ of."
2891 2768
2892(defun tramp-handle-add-name-to-file 2769(defun tramp-handle-add-name-to-file
2893 (filename newname &optional ok-if-already-exists) 2770 (filename newname &optional ok-if-already-exists)
2894 "Like `add-name-to-file' for tramp files." 2771 "Like `add-name-to-file' for Tramp files."
2772 (unless (tramp-equal-remote filename newname)
2773 (with-parsed-tramp-file-name
2774 (if (tramp-tramp-file-p filename) filename newname) nil
2775 (tramp-error
2776 v 'file-error
2777 "add-name-to-file: %s"
2778 "only implemented for same method, same user, same host")))
2895 (with-parsed-tramp-file-name filename v1 2779 (with-parsed-tramp-file-name filename v1
2896 (with-parsed-tramp-file-name newname v2 2780 (with-parsed-tramp-file-name newname v2
2897 (let ((ln (when v1 (tramp-get-remote-ln 2781 (let ((ln (when v1 (tramp-get-remote-ln v1))))
2898 v1-multi-method v1-method v1-user v1-host))))
2899 (unless (and v1-method v2-method v1-user v2-user v1-host v2-host
2900 (equal v1-multi-method v2-multi-method)
2901 (equal v1-method v2-method)
2902 (equal v1-user v2-user)
2903 (equal v1-host v2-host))
2904 (error "add-name-to-file: %s"
2905 "only implemented for same method, same user, same host"))
2906 (when (and (not ok-if-already-exists) 2782 (when (and (not ok-if-already-exists)
2907 (file-exists-p newname) 2783 (file-exists-p newname)
2908 (not (numberp ok-if-already-exists)) 2784 (not (numberp ok-if-already-exists))
@@ -2910,18 +2786,20 @@ of."
2910 (format 2786 (format
2911 "File %s already exists; make it a new name anyway? " 2787 "File %s already exists; make it a new name anyway? "
2912 newname))) 2788 newname)))
2913 (error "add-name-to-file: file %s already exists" newname)) 2789 (tramp-error
2790 v2 'file-error
2791 "add-name-to-file: file %s already exists" newname))
2792 (tramp-flush-file-property v2 v2-localname)
2914 (tramp-barf-unless-okay 2793 (tramp-barf-unless-okay
2915 v1-multi-method v1-method v1-user v1-host 2794 v1
2916 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname) 2795 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
2917 (tramp-shell-quote-argument v2-localname)) 2796 (tramp-shell-quote-argument v2-localname))
2918 nil 'file-error
2919 "error with add-name-to-file, see buffer `%s' for details" 2797 "error with add-name-to-file, see buffer `%s' for details"
2920 (buffer-name)))))) 2798 (buffer-name))))))
2921 2799
2922(defun tramp-handle-copy-file 2800(defun tramp-handle-copy-file
2923 (filename newname &optional ok-if-already-exists keep-date) 2801 (filename newname &optional ok-if-already-exists keep-date)
2924 "Like `copy-file' for tramp files." 2802 "Like `copy-file' for Tramp files."
2925 ;; Check if both files are local -- invoke normal copy-file. 2803 ;; Check if both files are local -- invoke normal copy-file.
2926 ;; Otherwise, use tramp from local system. 2804 ;; Otherwise, use tramp from local system.
2927 (setq filename (expand-file-name filename)) 2805 (setq filename (expand-file-name filename))
@@ -2932,12 +2810,11 @@ of."
2932 (tramp-do-copy-or-rename-file 2810 (tramp-do-copy-or-rename-file
2933 'copy filename newname ok-if-already-exists keep-date) 2811 'copy filename newname ok-if-already-exists keep-date)
2934 (tramp-run-real-handler 2812 (tramp-run-real-handler
2935 'copy-file 2813 'copy-file (list filename newname ok-if-already-exists keep-date))))
2936 (list filename newname ok-if-already-exists keep-date))))
2937 2814
2938(defun tramp-handle-rename-file 2815(defun tramp-handle-rename-file
2939 (filename newname &optional ok-if-already-exists) 2816 (filename newname &optional ok-if-already-exists)
2940 "Like `rename-file' for tramp files." 2817 "Like `rename-file' for Tramp files."
2941 ;; Check if both files are local -- invoke normal rename-file. 2818 ;; Check if both files are local -- invoke normal rename-file.
2942 ;; Otherwise, use tramp from local system. 2819 ;; Otherwise, use tramp from local system.
2943 (setq filename (expand-file-name filename)) 2820 (setq filename (expand-file-name filename))
@@ -2946,9 +2823,9 @@ of."
2946 (if (or (tramp-tramp-file-p filename) 2823 (if (or (tramp-tramp-file-p filename)
2947 (tramp-tramp-file-p newname)) 2824 (tramp-tramp-file-p newname))
2948 (tramp-do-copy-or-rename-file 2825 (tramp-do-copy-or-rename-file
2949 'rename filename newname ok-if-already-exists) 2826 'rename filename newname ok-if-already-exists t)
2950 (tramp-run-real-handler 'rename-file 2827 (tramp-run-real-handler
2951 (list filename newname ok-if-already-exists)))) 2828 'rename-file (list filename newname ok-if-already-exists))))
2952 2829
2953(defun tramp-do-copy-or-rename-file 2830(defun tramp-do-copy-or-rename-file
2954 (op filename newname &optional ok-if-already-exists keep-date) 2831 (op filename newname &optional ok-if-already-exists keep-date)
@@ -2965,169 +2842,148 @@ This function is invoked by `tramp-handle-copy-file' and
2965and `rename'. FILENAME and NEWNAME must be absolute file names." 2842and `rename'. FILENAME and NEWNAME must be absolute file names."
2966 (unless (memq op '(copy rename)) 2843 (unless (memq op '(copy rename))
2967 (error "Unknown operation `%s', must be `copy' or `rename'" op)) 2844 (error "Unknown operation `%s', must be `copy' or `rename'" op))
2968 (unless ok-if-already-exists
2969 (when (file-exists-p newname)
2970 (signal 'file-already-exists
2971 (list "File already exists" newname))))
2972 (let ((t1 (tramp-tramp-file-p filename)) 2845 (let ((t1 (tramp-tramp-file-p filename))
2973 (t2 (tramp-tramp-file-p newname)) 2846 (t2 (tramp-tramp-file-p newname)))
2974 v1-multi-method v1-method v1-user v1-host v1-localname
2975 v2-multi-method v2-method v2-user v2-host v2-localname)
2976
2977 ;; Check which ones of source and target are Tramp files.
2978 ;; We cannot invoke `with-parsed-tramp-file-name';
2979 ;; it fails if the file isn't a Tramp file name.
2980 (if t1
2981 (with-parsed-tramp-file-name filename l
2982 (setq v1-multi-method l-multi-method
2983 v1-method l-method
2984 v1-user l-user
2985 v1-host l-host
2986 v1-localname l-localname))
2987 (setq v1-localname filename))
2988 (if t2
2989 (with-parsed-tramp-file-name newname l
2990 (setq v2-multi-method l-multi-method
2991 v2-method l-method
2992 v2-user l-user
2993 v2-host l-host
2994 v2-localname l-localname))
2995 (setq v2-localname newname))
2996 2847
2997 (cond 2848 (unless ok-if-already-exists
2998 ;; Both are Tramp files. 2849 (when (and t2 (file-exists-p newname))
2999 ((and t1 t2) 2850 (with-parsed-tramp-file-name newname nil
3000 (cond 2851 (tramp-error
3001 ;; Shortcut: if method, host, user are the same for both 2852 v 'file-already-exists "File %s already exists" newname))))
3002 ;; files, we invoke `cp' or `mv' on the remote host
3003 ;; directly.
3004 ((and (equal v1-multi-method v2-multi-method)
3005 (equal v1-method v2-method)
3006 (equal v1-user v2-user)
3007 (equal v1-host v2-host))
3008 (tramp-do-copy-or-rename-file-directly
3009 op v1-multi-method v1-method v1-user v1-host
3010 v1-localname v2-localname keep-date))
3011 ;; If both source and target are Tramp files,
3012 ;; both are using the same copy-program, then we
3013 ;; can invoke rcp directly. Note that
3014 ;; default-directory should point to a local
3015 ;; directory if we want to invoke rcp.
3016 ((and (not v1-multi-method)
3017 (not v2-multi-method)
3018 (equal v1-method v2-method)
3019 (tramp-method-out-of-band-p
3020 v1-multi-method v1-method v1-user v1-host)
3021 (not (string-match "\\([^#]*\\)#\\(.*\\)" v1-host))
3022 (not (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)))
3023 (tramp-do-copy-or-rename-file-out-of-band
3024 op filename newname keep-date))
3025 ;; No shortcut was possible. So we copy the
3026 ;; file first. If the operation was `rename', we go
3027 ;; back and delete the original file (if the copy was
3028 ;; successful). The approach is simple-minded: we
3029 ;; create a new buffer, insert the contents of the
3030 ;; source file into it, then write out the buffer to
3031 ;; the target file. The advantage is that it doesn't
3032 ;; matter which filename handlers are used for the
3033 ;; source and target file.
3034 (t
3035 (tramp-do-copy-or-rename-file-via-buffer
3036 op filename newname keep-date))))
3037
3038 ;; One file is a Tramp file, the other one is local.
3039 ((or t1 t2)
3040 ;; If the Tramp file has an out-of-band method, the corresponding
3041 ;; copy-program can be invoked.
3042 (if (and (not v1-multi-method)
3043 (not v2-multi-method)
3044 (or (and t1 (tramp-method-out-of-band-p
3045 v1-multi-method v1-method v1-user v1-host))
3046 (and t2 (tramp-method-out-of-band-p
3047 v2-multi-method v2-method v2-user v2-host))))
3048 (tramp-do-copy-or-rename-file-out-of-band
3049 op filename newname keep-date)
3050 ;; Use the generic method via a Tramp buffer.
3051 (tramp-do-copy-or-rename-file-via-buffer
3052 op filename newname keep-date)))
3053 2853
3054 (t 2854 (prog1
3055 ;; One of them must be a Tramp file. 2855 (cond
3056 (error "Tramp implementation says this cannot happen"))))) 2856 ;; Both are Tramp files.
2857 ((and t1 t2)
2858 (with-parsed-tramp-file-name filename v1
2859 (with-parsed-tramp-file-name newname v2
2860 (cond
2861 ;; Shortcut: if method, host, user are the same for both
2862 ;; files, we invoke `cp' or `mv' on the remote host
2863 ;; directly.
2864 ((tramp-equal-remote filename newname)
2865 (tramp-do-copy-or-rename-file-directly
2866 op v1 v1-localname v2-localname keep-date))
2867 ;; If both source and target are Tramp files,
2868 ;; both are using the same copy-program, then we
2869 ;; can invoke rcp directly. Note that
2870 ;; default-directory should point to a local
2871 ;; directory if we want to invoke rcp.
2872 ((and (equal v1-method v2-method)
2873 (tramp-method-out-of-band-p v1)
2874 (> (nth 7 (file-attributes filename))
2875 tramp-copy-size-limit))
2876 (tramp-do-copy-or-rename-file-out-of-band
2877 op filename newname keep-date))
2878 ;; No shortcut was possible. So we copy the
2879 ;; file first. If the operation was `rename', we go
2880 ;; back and delete the original file (if the copy was
2881 ;; successful). The approach is simple-minded: we
2882 ;; create a new buffer, insert the contents of the
2883 ;; source file into it, then write out the buffer to
2884 ;; the target file. The advantage is that it doesn't
2885 ;; matter which filename handlers are used for the
2886 ;; source and target file.
2887 (t
2888 (tramp-do-copy-or-rename-file-via-buffer
2889 op filename newname keep-date))))))
2890
2891 ;; One file is a Tramp file, the other one is local.
2892 ((or t1 t2)
2893 (with-parsed-tramp-file-name (if t1 filename newname) nil
2894 ;; If the Tramp file has an out-of-band method, the corresponding
2895 ;; copy-program can be invoked.
2896 (if (and (tramp-method-out-of-band-p v)
2897 (> (nth 7 (file-attributes filename))
2898 tramp-copy-size-limit))
2899 (tramp-do-copy-or-rename-file-out-of-band
2900 op filename newname keep-date)
2901 ;; Use the generic method via a Tramp buffer.
2902 (tramp-do-copy-or-rename-file-via-buffer
2903 op filename newname keep-date))))
2904
2905 (t
2906 ;; One of them must be a Tramp file.
2907 (error "Tramp implementation says this cannot happen")))
2908 ;; When newname did exist, we have wrong cached values.
2909 (when t2
2910 (with-parsed-tramp-file-name newname nil
2911 (tramp-flush-file-property v localname))))))
3057 2912
3058(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date) 2913(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
3059 "Use an Emacs buffer to copy or rename a file. 2914 "Use an Emacs buffer to copy or rename a file.
3060First arg OP is either `copy' or `rename' and indicates the operation. 2915First arg OP is either `copy' or `rename' and indicates the operation.
3061FILENAME is the source file, NEWNAME the target file. 2916FILENAME is the source file, NEWNAME the target file.
3062KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." 2917KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
3063 (let ((trampbuf (get-buffer-create "*tramp output*")) 2918 (let ((modtime (nth 5 (file-attributes filename))))
3064 (modtime (nth 5 (file-attributes filename)))) 2919 (unwind-protect
3065 (when (and keep-date (or (null modtime) (equal modtime '(0 0)))) 2920 (with-temp-buffer
3066 (tramp-message 2921 (let ((coding-system-for-read 'binary))
3067 1 (concat "Warning: cannot preserve file time stamp" 2922 (insert-file-contents-literally filename))
3068 " with inline copying across machines"))) 2923 ;; We don't want the target file to be compressed, so we
3069 (save-excursion 2924 ;; let-bind `jka-compr-inhibit' to t.
3070 (set-buffer trampbuf) (erase-buffer) 2925 (let ((coding-system-for-write 'binary)
3071 (insert-file-contents-literally filename) 2926 (jka-compr-inhibit t))
3072 ;; We don't want the target file to be compressed, so we let-bind 2927 (write-region (point-min) (point-max) newname))))
3073 ;; `jka-compr-inhibit' to t. 2928 ;; KEEP-DATE handling.
3074 (let ((coding-system-for-write 'binary) 2929 (when keep-date
3075 (jka-compr-inhibit t)) 2930 (when (and (not (null modtime))
3076 (write-region (point-min) (point-max) newname)) 2931 (not (equal modtime '(0 0))))
3077 ;; KEEP-DATE handling. 2932 (tramp-touch newname modtime)))
3078 (when keep-date 2933 ;; Set the mode.
3079 (when (and (not (null modtime)) 2934 (set-file-modes newname (file-modes filename))
3080 (not (equal modtime '(0 0))))
3081 (tramp-touch newname modtime)))
3082 ;; Set the mode.
3083 (set-file-modes newname (file-modes filename)))
3084 ;; If the operation was `rename', delete the original file. 2935 ;; If the operation was `rename', delete the original file.
3085 (unless (eq op 'copy) 2936 (unless (eq op 'copy)
3086 (delete-file filename)))) 2937 (delete-file filename))))
3087 2938
3088(defun tramp-do-copy-or-rename-file-directly 2939(defun tramp-do-copy-or-rename-file-directly
3089 (op multi-method method user host localname1 localname2 keep-date) 2940 (op vec localname1 localname2 keep-date)
3090 "Invokes `cp' or `mv' on the remote system. 2941 "Invokes `cp' or `mv' on the remote system.
3091OP must be one of `copy' or `rename', indicating `cp' or `mv', 2942OP must be one of `copy' or `rename', indicating `cp' or `mv',
3092respectively. METHOD, USER, and HOST specify the connection. 2943respectively. VEC specifies the connection. LOCALNAME1 and
3093LOCALNAME1 and LOCALNAME2 specify the two arguments of `cp' or `mv'. 2944LOCALNAME2 specify the two arguments of `cp' or `mv'. If
3094If KEEP-DATE is non-nil, preserve the time stamp when copying." 2945KEEP-DATE is non-nil, preserve the time stamp when copying."
3095 ;; CCC: What happens to the timestamp when renaming? 2946 ;; CCC: What happens to the timestamp when renaming?
3096 (let ((cmd (cond ((and (eq op 'copy) keep-date) "cp -f -p") 2947 (let ((cmd (cond ((and (eq op 'copy) keep-date) "cp -f -p")
3097 ((eq op 'copy) "cp -f") 2948 ((eq op 'copy) "cp -f")
3098 ((eq op 'rename) "mv -f") 2949 ((eq op 'rename) "mv -f")
3099 (t (error 2950 (t (tramp-error
2951 vec 'file-error
3100 "Unknown operation `%s', must be `copy' or `rename'" 2952 "Unknown operation `%s', must be `copy' or `rename'"
3101 op))))) 2953 op)))))
3102 (save-excursion 2954 (tramp-send-command
3103 (tramp-send-command 2955 vec
3104 multi-method method user host 2956 (format "%s %s %s"
3105 (format "%s %s %s" 2957 cmd
3106 cmd 2958 (tramp-shell-quote-argument localname1)
3107 (tramp-shell-quote-argument localname1) 2959 (tramp-shell-quote-argument localname2)))
3108 (tramp-shell-quote-argument localname2))) 2960 (with-current-buffer (tramp-get-buffer vec)
3109 (tramp-wait-for-output)
3110 (goto-char (point-min)) 2961 (goto-char (point-min))
3111 (unless 2962 (unless
3112 (or 2963 (or
3113 (and (eq op 'copy) keep-date 2964 (and (eq op 'copy) keep-date
3114 ;; Mask cp -f error. 2965 ;; Mask cp -f error.
3115 (re-search-forward tramp-operation-not-permitted-regexp nil t)) 2966 (re-search-forward tramp-operation-not-permitted-regexp nil t))
3116 (zerop (tramp-send-command-and-check 2967 (zerop (tramp-send-command-and-check vec nil)))
3117 multi-method method user host nil nil))) 2968 (tramp-error-with-buffer
3118 (pop-to-buffer (current-buffer)) 2969 nil vec 'file-error
3119 (signal 'file-error 2970 "Copying directly failed, see buffer `%s' for details."
3120 (format "Copying directly failed, see buffer `%s' for details." 2971 (buffer-name))))
3121 (buffer-name)))))
3122 ;; Set the mode. 2972 ;; Set the mode.
3123 ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used 2973 ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
3124 ;; where available? 2974 ;; where available?
3125 (unless (or (eq op 'rename) keep-date) 2975 (unless (or (eq op 'rename) keep-date)
3126 (set-file-modes 2976 (set-file-modes
3127 (tramp-make-tramp-file-name multi-method method user host localname2) 2977 (tramp-make-tramp-file-name
3128 (file-modes 2978 (tramp-file-name-method vec)
3129 (tramp-make-tramp-file-name 2979 (tramp-file-name-user vec)
3130 multi-method method user host localname1)))))) 2980 (tramp-file-name-host vec)
2981 localname2)
2982 (file-modes (tramp-make-tramp-file-name
2983 (tramp-file-name-method vec)
2984 (tramp-file-name-user vec)
2985 (tramp-file-name-host vec)
2986 localname1))))))
3131 2987
3132(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) 2988(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
3133 "Invoke rcp program to copy. 2989 "Invoke rcp program to copy.
@@ -3135,176 +2991,137 @@ One of FILENAME and NEWNAME must be a Tramp name, the other must
3135be a local filename. The method used must be an out-of-band method." 2991be a local filename. The method used must be an out-of-band method."
3136 (let ((t1 (tramp-tramp-file-p filename)) 2992 (let ((t1 (tramp-tramp-file-p filename))
3137 (t2 (tramp-tramp-file-p newname)) 2993 (t2 (tramp-tramp-file-p newname))
3138 v1-multi-method v1-method v1-user v1-host v1-localname 2994 copy-program copy-args copy-keep-date port spec
3139 v2-multi-method v2-method v2-user v2-host v2-localname 2995 source target)
3140 multi-method method user host copy-program copy-args 2996
3141 source target trampbuf) 2997 (with-parsed-tramp-file-name (if t1 filename newname) nil
3142 2998
3143 ;; Check which ones of source and target are Tramp files. 2999 ;; Expand hops. Might be necessary for gateway methods.
3144 ;; We cannot invoke `with-parsed-tramp-file-name'; 3000 (setq v (car (tramp-compute-multi-hops v)))
3145 ;; it fails if the file isn't a Tramp file name. 3001 (aset v 3 localname)
3146 (if t1 3002
3147 (with-parsed-tramp-file-name filename l 3003 ;; Check which ones of source and target are Tramp files.
3148 (setq v1-multi-method l-multi-method 3004 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
3149 v1-method l-method 3005 target (if t2 (tramp-make-copy-program-file-name v) newname))
3150 v1-user l-user 3006
3151 v1-host l-host 3007 ;; Check for port number. Until now, there's no need for handling
3152 v1-localname l-localname 3008 ;; like method, user, host.
3153 multi-method l-multi-method 3009 (setq host (tramp-file-name-real-host v)
3154 method (tramp-find-method 3010 port (tramp-file-name-port v)
3155 v1-multi-method v1-method v1-user v1-host) 3011 port (or (and port (number-to-string port)) ""))
3156 user l-user 3012
3157 host l-host 3013 ;; Compose copy command.
3158 copy-program (tramp-get-method-parameter 3014 (setq spec `((?h . ,host) (?u . ,user) (?p . ,port)
3159 v1-multi-method method 3015 (?t . ,(tramp-make-tramp-temp-file v))
3160 v1-user v1-host 'tramp-copy-program) 3016 (?k . ,(if keep-date " " "")))
3161 copy-args (tramp-get-method-parameter 3017 copy-program (tramp-get-method-parameter
3162 v1-multi-method method 3018 method 'tramp-copy-program)
3163 v1-user v1-host 'tramp-copy-args))) 3019 copy-keep-date (tramp-get-method-parameter
3164 (setq v1-localname filename)) 3020 method 'tramp-copy-keep-date)
3165 3021 copy-args
3166 (if t2 3022 (delq
3167 (with-parsed-tramp-file-name newname l 3023 nil
3168 (setq v2-multi-method l-multi-method 3024 (mapcar
3169 v2-method l-method 3025 '(lambda (x)
3170 v2-user l-user 3026 (setq
3171 v2-host l-host 3027 ;; " " is indication for keep-date argument.
3172 v2-localname l-localname 3028 x (delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
3173 multi-method l-multi-method 3029 (unless (member "" x) (mapconcat 'identity x " ")))
3174 method (tramp-find-method 3030 (tramp-get-method-parameter
3175 v2-multi-method v2-method v2-user v2-host) 3031 method 'tramp-copy-args))))
3176 user l-user
3177 host l-host
3178 copy-program (tramp-get-method-parameter
3179 v2-multi-method method
3180 v2-user v2-host 'tramp-copy-program)
3181 copy-args (tramp-get-method-parameter
3182 v2-multi-method method
3183 v2-user v2-host 'tramp-copy-args)))
3184 (setq v2-localname newname))
3185
3186 ;; The following should be changed. We need a more general
3187 ;; mechanism to parse extra host args.
3188 (if (not t1)
3189 (setq source v1-localname)
3190 (when (string-match "\\([^#]*\\)#\\(.*\\)" v1-host)
3191 (setq copy-args (cons "-P" (cons (match-string 2 v1-host) copy-args)))
3192 (setq v1-host (match-string 1 v1-host)))
3193 (setq source
3194 (tramp-make-copy-program-file-name
3195 v1-user v1-host
3196 (tramp-shell-quote-argument v1-localname))))
3197
3198 (if (not t2)
3199 (setq target v2-localname)
3200 (when (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)
3201 (setq copy-args (cons "-P" (cons (match-string 2 v2-host) copy-args)))
3202 (setq v2-host (match-string 1 v2-host)))
3203 (setq target
3204 (tramp-make-copy-program-file-name
3205 v2-user v2-host
3206 (tramp-shell-quote-argument v2-localname))))
3207
3208 ;; Handle ControlMaster/ControlPath
3209 (setq copy-args
3210 (mapcar
3211 (lambda (x)
3212 (format-spec
3213 x `((?t . ,(format "/tmp/%s" tramp-temp-name-prefix)))))
3214 copy-args))
3215
3216 ;; Handle keep-date argument
3217 (when keep-date
3218 (if t1
3219 (setq copy-args
3220 (cons (tramp-get-method-parameter
3221 v1-multi-method method
3222 v1-user v1-host 'tramp-copy-keep-date-arg)
3223 copy-args))
3224 (setq copy-args
3225 (cons (tramp-get-method-parameter
3226 v2-multi-method method
3227 v2-user v2-host 'tramp-copy-keep-date-arg)
3228 copy-args))))
3229
3230 (setq copy-args (append copy-args (list source target))
3231 trampbuf (generate-new-buffer
3232 (tramp-buffer-name multi-method method user host)))
3233
3234 ;; Use an asynchronous process. By this, password can be handled.
3235 (save-excursion
3236 3032
3237 ;; Check for program. 3033 ;; Check for program.
3238 (when (and (fboundp 'executable-find) 3034 (when (and (fboundp 'executable-find)
3239 (not (executable-find copy-program))) 3035 (not (let ((default-directory
3240 (error "Cannot find copy program: %s" copy-program)) 3036 (tramp-temporary-file-directory)))
3037 (executable-find copy-program))))
3038 (tramp-error
3039 v 'file-error "Cannot find copy program: %s" copy-program))
3241 3040
3242 (set-buffer trampbuf) 3041 (tramp-message v 0 "Transferring %s to %s..." filename newname)
3243 (setq tramp-current-multi-method multi-method
3244 tramp-current-method method
3245 tramp-current-user user
3246 tramp-current-host host)
3247 (message "Transferring %s to %s..." filename newname)
3248 3042
3249 ;; Use rcp-like program for file transfer.
3250 (unwind-protect 3043 (unwind-protect
3251 (let* ((default-directory 3044 (with-temp-buffer
3252 (if (and (stringp default-directory) 3045 ;; The default directory must be remote.
3253 (file-accessible-directory-p default-directory)) 3046 (let ((default-directory
3254 default-directory 3047 (file-name-directory (if t1 filename newname))))
3255 (tramp-temporary-file-directory))) 3048 ;; Set the transfer process properties.
3256 (p (apply 'start-process (buffer-name trampbuf) trampbuf 3049 (tramp-set-connection-property
3257 copy-program copy-args))) 3050 v "process-name" (buffer-name (current-buffer)))
3258 (tramp-set-process-query-on-exit-flag p nil) 3051 (tramp-set-connection-property
3259 (tramp-process-actions p multi-method method user host 3052 v "process-buffer" (current-buffer))
3260 tramp-actions-copy-out-of-band)) 3053
3261 (kill-buffer trampbuf)) 3054 ;; Use an asynchronous process. By this, password can
3262 (message "Transferring %s to %s...done" filename newname) 3055 ;; be handled. The default directory must be local, in
3056 ;; order to apply the correct `copy-program'. We don't
3057 ;; set a timeout, because the copying of large files can
3058 ;; last longer than 60 secs.
3059 (let ((p (let ((default-directory
3060 (tramp-temporary-file-directory)))
3061 (apply 'start-process
3062 (tramp-get-connection-property
3063 v "process-name" nil)
3064 (tramp-get-connection-property
3065 v "process-buffer" nil)
3066 copy-program
3067 (append copy-args (list source target))))))
3068 (tramp-message
3069 v 6 "%s" (mapconcat 'identity (process-command p) " "))
3070 (set-process-sentinel p 'tramp-flush-connection-property)
3071 (tramp-set-process-query-on-exit-flag p nil)
3072 (tramp-process-actions p v tramp-actions-copy-out-of-band))))
3073
3074 ;; Reset the transfer process properties.
3075 (tramp-set-connection-property v "process-name" nil)
3076 (tramp-set-connection-property v "process-buffer" nil))
3077
3078 (tramp-message v 0 "Transferring %s to %s...done" filename newname)
3079
3080 ;; Handle KEEP-DATE argument.
3081 (when (and keep-date (not copy-keep-date))
3082 (set-file-times newname (nth 5 (file-attributes filename))))
3263 3083
3264 ;; Set the mode. 3084 ;; Set the mode.
3265 (unless keep-date 3085 (unless (and keep-date copy-keep-date)
3266 (set-file-modes newname (file-modes filename)))) 3086 (set-file-modes newname (file-modes filename))))
3267 3087
3268 ;; If the operation was `rename', delete the original file. 3088 ;; If the operation was `rename', delete the original file.
3269 (unless (eq op 'copy) 3089 (unless (eq op 'copy)
3270 (delete-file filename)))) 3090 (delete-file filename))))
3271 3091
3272;; mkdir
3273(defun tramp-handle-make-directory (dir &optional parents) 3092(defun tramp-handle-make-directory (dir &optional parents)
3274 "Like `make-directory' for tramp files." 3093 "Like `make-directory' for Tramp files."
3275 (setq dir (expand-file-name dir)) 3094 (setq dir (expand-file-name dir))
3276 (with-parsed-tramp-file-name dir nil 3095 (with-parsed-tramp-file-name dir nil
3277 (save-excursion 3096 (save-excursion
3278 (tramp-barf-unless-okay 3097 (tramp-barf-unless-okay
3279 multi-method method user host 3098 v
3280 (format " %s %s" 3099 (format " %s %s"
3281 (if parents "mkdir -p" "mkdir") 3100 (if parents "mkdir -p" "mkdir")
3282 (tramp-shell-quote-argument localname)) 3101 (tramp-shell-quote-argument localname))
3283 nil 'file-error
3284 "Couldn't make directory %s" dir)))) 3102 "Couldn't make directory %s" dir))))
3285 3103
3286;; CCC error checking?
3287(defun tramp-handle-delete-directory (directory) 3104(defun tramp-handle-delete-directory (directory)
3288 "Like `delete-directory' for tramp files." 3105 "Like `delete-directory' for Tramp files."
3289 (setq directory (expand-file-name directory)) 3106 (setq directory (expand-file-name directory))
3290 (with-parsed-tramp-file-name directory nil 3107 (with-parsed-tramp-file-name directory nil
3291 (save-excursion 3108 (tramp-flush-directory-property v localname)
3292 (tramp-send-command 3109 (unless (zerop (tramp-send-command-and-check
3293 multi-method method user host 3110 v
3294 (format "rmdir %s ; echo ok" 3111 (format "rmdir %s"
3295 (tramp-shell-quote-argument localname))) 3112 (tramp-shell-quote-argument localname))))
3296 (tramp-wait-for-output)))) 3113 (tramp-error v 'file-error "Couldn't delete %s" directory))))
3297 3114
3298(defun tramp-handle-delete-file (filename) 3115(defun tramp-handle-delete-file (filename)
3299 "Like `delete-file' for tramp files." 3116 "Like `delete-file' for Tramp files."
3300 (setq filename (expand-file-name filename)) 3117 (setq filename (expand-file-name filename))
3301 (with-parsed-tramp-file-name filename nil 3118 (with-parsed-tramp-file-name filename nil
3302 (save-excursion 3119 (tramp-flush-file-property v localname)
3303 (unless (zerop (tramp-send-command-and-check 3120 (unless (zerop (tramp-send-command-and-check
3304 multi-method method user host 3121 v
3305 (format "rm -f %s" 3122 (format "rm -f %s"
3306 (tramp-shell-quote-argument localname)))) 3123 (tramp-shell-quote-argument localname))))
3307 (signal 'file-error "Couldn't delete Tramp file"))))) 3124 (tramp-error v 'file-error "Couldn't delete %s" filename))))
3308 3125
3309;; Dired. 3126;; Dired.
3310 3127
@@ -3312,57 +3129,33 @@ be a local filename. The method used must be an out-of-band method."
3312;; we try and delete two directories under TRAMP :/ 3129;; we try and delete two directories under TRAMP :/
3313(defun tramp-handle-dired-recursive-delete-directory (filename) 3130(defun tramp-handle-dired-recursive-delete-directory (filename)
3314 "Recursively delete the directory given. 3131 "Recursively delete the directory given.
3315This is like `dired-recursive-delete-directory' for tramp files." 3132This is like `dired-recursive-delete-directory' for Tramp files."
3316 (with-parsed-tramp-file-name filename nil 3133 (with-parsed-tramp-file-name filename nil
3317 ;; run a shell command 'rm -r <localname>' 3134 (tramp-flush-directory-property v filename)
3135 ;; Run a shell command 'rm -r <localname>'
3318 ;; Code shamelessly stolen for the dired implementation and, um, hacked :) 3136 ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
3319 (or (file-exists-p filename) 3137 (unless (file-exists-p filename)
3320 (signal 3138 (tramp-error v 'file-error "No such directory: %s" filename))
3321 'file-error
3322 (list "Removing old file name" "no such directory" filename)))
3323 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>) 3139 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
3324 (tramp-send-command multi-method method user host 3140 (tramp-send-command
3325 (format "rm -r %s" (tramp-shell-quote-argument localname))) 3141 v
3142 (format "rm -r %s" (tramp-shell-quote-argument localname))
3143 ;; Don't read the output, do it explicitely.
3144 nil t)
3326 ;; Wait for the remote system to return to us... 3145 ;; Wait for the remote system to return to us...
3327 ;; This might take a while, allow it plenty of time. 3146 ;; This might take a while, allow it plenty of time.
3328 (tramp-wait-for-output 120) 3147 (tramp-wait-for-output (tramp-get-connection-process v) 120)
3329 ;; Make sure that it worked... 3148 ;; Make sure that it worked...
3330 (and (file-exists-p filename) 3149 (and (file-exists-p filename)
3331 (error "Failed to recursively delete %s" filename)))) 3150 (tramp-error
3332 3151 v 'file-error "Failed to recursively delete %s" filename))))
3333(defun tramp-handle-dired-call-process (program discard &rest arguments)
3334 "Like `dired-call-process' for tramp files."
3335 (with-parsed-tramp-file-name default-directory nil
3336 (save-excursion
3337 (tramp-barf-unless-okay
3338 multi-method method user host
3339 (format "cd %s" (tramp-shell-quote-argument localname))
3340 nil 'file-error
3341 "tramp-handle-dired-call-process: Couldn't `cd %s'"
3342 (tramp-shell-quote-argument localname))
3343 (tramp-send-command
3344 multi-method method user host
3345 (mapconcat #'tramp-shell-quote-argument (cons program arguments) " "))
3346 (tramp-wait-for-output))
3347 (unless discard
3348 ;; We cannot use `insert-buffer' because the tramp buffer
3349 ;; changes its contents before insertion due to calling
3350 ;; `expand-file' and alike.
3351 (insert
3352 (with-current-buffer
3353 (tramp-get-buffer multi-method method user host)
3354 (buffer-string))))
3355 (save-excursion
3356 (prog1
3357 (tramp-send-command-and-check multi-method method user host nil)
3358 (tramp-send-command multi-method method user host "cd")
3359 (tramp-wait-for-output)))))
3360 3152
3361(defun tramp-handle-dired-compress-file (file &rest ok-flag) 3153(defun tramp-handle-dired-compress-file (file &rest ok-flag)
3362 "Like `dired-compress-file' for tramp files." 3154 "Like `dired-compress-file' for Tramp files."
3363 ;; OK-FLAG is valid for XEmacs only, but not implemented. 3155 ;; OK-FLAG is valid for XEmacs only, but not implemented.
3364 ;; Code stolen mainly from dired-aux.el. 3156 ;; Code stolen mainly from dired-aux.el.
3365 (with-parsed-tramp-file-name file nil 3157 (with-parsed-tramp-file-name file nil
3158 (tramp-flush-file-property v localname)
3366 (save-excursion 3159 (save-excursion
3367 (let ((suffixes 3160 (let ((suffixes
3368 (if (not (featurep 'xemacs)) 3161 (if (not (featurep 'xemacs))
@@ -3388,11 +3181,10 @@ This is like `dired-recursive-delete-directory' for tramp files."
3388 nil) 3181 nil)
3389 ((and suffix (nth 2 suffix)) 3182 ((and suffix (nth 2 suffix))
3390 ;; We found an uncompression rule. 3183 ;; We found an uncompression rule.
3391 (message "Uncompressing %s..." file) 3184 (tramp-message v 0 "Uncompressing %s..." file)
3392 (when (zerop (tramp-send-command-and-check 3185 (when (zerop (tramp-send-command-and-check
3393 multi-method method user host 3186 v (concat (nth 2 suffix) " " localname)))
3394 (concat (nth 2 suffix) " " localname))) 3187 (tramp-message v 0 "Uncompressing %s...done" file)
3395 (message "Uncompressing %s...done" file)
3396 ;; `dired-remove-file' is not defined in XEmacs 3188 ;; `dired-remove-file' is not defined in XEmacs
3397 (funcall (symbol-function 'dired-remove-file) file) 3189 (funcall (symbol-function 'dired-remove-file) file)
3398 (string-match (car suffix) file) 3190 (string-match (car suffix) file)
@@ -3400,11 +3192,10 @@ This is like `dired-recursive-delete-directory' for tramp files."
3400 (t 3192 (t
3401 ;; We don't recognize the file as compressed, so compress it. 3193 ;; We don't recognize the file as compressed, so compress it.
3402 ;; Try gzip. 3194 ;; Try gzip.
3403 (message "Compressing %s..." file) 3195 (tramp-message v 0 "Compressing %s..." file)
3404 (when (zerop (tramp-send-command-and-check 3196 (when (zerop (tramp-send-command-and-check
3405 multi-method method user host 3197 v (concat "gzip -f " localname)))
3406 (concat "gzip -f " localname))) 3198 (tramp-message v 0 "Compressing %s...done" file)
3407 (message "Compressing %s...done" file)
3408 ;; `dired-remove-file' is not defined in XEmacs 3199 ;; `dired-remove-file' is not defined in XEmacs
3409 (funcall (symbol-function 'dired-remove-file) file) 3200 (funcall (symbol-function 'dired-remove-file) file)
3410 (cond ((file-exists-p (concat file ".gz")) 3201 (cond ((file-exists-p (concat file ".gz"))
@@ -3428,21 +3219,21 @@ This is like `dired-recursive-delete-directory' for tramp files."
3428 3219
3429(defun tramp-handle-insert-directory 3220(defun tramp-handle-insert-directory
3430 (filename switches &optional wildcard full-directory-p) 3221 (filename switches &optional wildcard full-directory-p)
3431 "Like `insert-directory' for tramp files." 3222 "Like `insert-directory' for Tramp files."
3432 (if (and (featurep 'ls-lisp) 3223 (setq filename (expand-file-name filename))
3433 (not (symbol-value 'ls-lisp-use-insert-directory-program))) 3224 (with-parsed-tramp-file-name filename nil
3434 (tramp-run-real-handler 3225 (tramp-flush-file-property v localname)
3435 'insert-directory (list filename switches wildcard full-directory-p)) 3226 (if (and (featurep 'ls-lisp)
3436 ;; For the moment, we assume that the remote "ls" program does not 3227 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
3437 ;; grok "--dired". In the future, we should detect this on 3228 (tramp-run-real-handler
3438 ;; connection setup. 3229 'insert-directory (list filename switches wildcard full-directory-p))
3439 (when (string-match "^--dired\\s-+" switches) 3230 ;; For the moment, we assume that the remote "ls" program does not
3440 (setq switches (replace-match "" nil t switches))) 3231 ;; grok "--dired". In the future, we should detect this on
3441 (setq filename (expand-file-name filename)) 3232 ;; connection setup.
3442 (with-parsed-tramp-file-name filename nil 3233 (when (string-match "^--dired\\s-+" switches)
3443 (tramp-message-for-buffer 3234 (setq switches (replace-match "" nil t switches)))
3444 multi-method method user host 10 3235 (tramp-message
3445 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" 3236 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
3446 switches filename (if wildcard "yes" "no") 3237 switches filename (if wildcard "yes" "no")
3447 (if full-directory-p "yes" "no")) 3238 (if full-directory-p "yes" "no"))
3448 (when wildcard 3239 (when wildcard
@@ -3454,80 +3245,45 @@ This is like `dired-recursive-delete-directory' for tramp files."
3454 (setq switches (concat "-d " switches))) 3245 (setq switches (concat "-d " switches)))
3455 (when wildcard 3246 (when wildcard
3456 (setq switches (concat switches " " wildcard))) 3247 (setq switches (concat switches " " wildcard)))
3457 (save-excursion 3248 ;; If `full-directory-p', we just say `ls -l FILENAME'.
3458 ;; If `full-directory-p', we just say `ls -l FILENAME'. 3249 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
3459 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. 3250 (if full-directory-p
3460 (if full-directory-p 3251 (tramp-send-command
3461 (tramp-send-command 3252 v
3462 multi-method method user host 3253 (format "%s %s %s"
3463 (format "%s %s %s" 3254 (tramp-get-ls-command v)
3464 (tramp-get-ls-command multi-method method user host) 3255 switches
3465 switches 3256 (if wildcard
3466 (if wildcard 3257 localname
3467 localname 3258 (tramp-shell-quote-argument (concat localname ".")))))
3468 (tramp-shell-quote-argument (concat localname "."))))) 3259 (tramp-barf-unless-okay
3469 (tramp-barf-unless-okay 3260 v
3470 multi-method method user host 3261 (format "cd %s" (tramp-shell-quote-argument
3471 (format "cd %s" (tramp-shell-quote-argument 3262 (file-name-directory localname)))
3472 (file-name-directory localname))) 3263 "Couldn't `cd %s'"
3473 nil 'file-error 3264 (tramp-shell-quote-argument (file-name-directory localname)))
3474 "Couldn't `cd %s'" 3265 (tramp-send-command
3475 (tramp-shell-quote-argument (file-name-directory localname))) 3266 v
3476 (tramp-send-command 3267 (format "%s %s %s"
3477 multi-method method user host 3268 (tramp-get-ls-command v)
3478 (format "%s %s %s" 3269 switches
3479 (tramp-get-ls-command multi-method method user host) 3270 (if (or wildcard
3480 switches 3271 (zerop (length (file-name-nondirectory localname))))
3481 (if wildcard 3272 ""
3482 localname 3273 (tramp-shell-quote-argument
3483 (if (zerop (length (file-name-nondirectory localname))) 3274 (file-name-nondirectory localname))))))
3484 "" 3275 ;; We cannot use `insert-buffer-substring' because the tramp buffer
3485 (tramp-shell-quote-argument 3276 ;; changes its contents before insertion due to calling
3486 (file-name-nondirectory localname))))))) 3277 ;; `expand-file' and alike.
3487 (sit-for 1) ;needed for rsh but not ssh? 3278 (insert
3488 (tramp-wait-for-output)) 3279 (with-current-buffer (tramp-get-buffer v)
3489 ;; The following let-binding is used by code that's commented 3280 (buffer-string))))))
3490 ;; out. Let's leave the let-binding in for a while to see
3491 ;; that the commented-out code is really not needed. Commenting-out
3492 ;; happened on 2003-03-13.
3493 (let ((old-pos (point)))
3494 ;; We cannot use `insert-buffer' because the tramp buffer
3495 ;; changes its contents before insertion due to calling
3496 ;; `expand-file' and alike.
3497 (insert
3498 (with-current-buffer
3499 (tramp-get-buffer multi-method method user host)
3500 (buffer-string)))
3501 ;; On XEmacs, we want to call (exchange-point-and-mark t), but
3502 ;; that doesn't exist on Emacs, so we use this workaround instead.
3503 ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
3504 ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>.
3505 ;; (let ((zmacs-region-stays t))
3506 ;; (exchange-point-and-mark))
3507 (save-excursion
3508 (tramp-send-command multi-method method user host "cd")
3509 (tramp-wait-for-output))
3510 ;; For the time being, the XEmacs kludge is commented out.
3511 ;; Please test it on various XEmacs versions to see if it works.
3512 ;; ;; Another XEmacs specialty follows. What's the right way to do
3513 ;; ;; it?
3514 ;; (when (and (featurep 'xemacs)
3515 ;; (eq major-mode 'dired-mode))
3516 ;; (save-excursion
3517 ;; (require 'dired)
3518 ;; (dired-insert-set-properties old-pos (point))))
3519 ))))
3520
3521;; Continuation of kluge to pacify byte-compiler.
3522;;(eval-when-compile
3523;; (when (eq (symbol-function 'dired-insert-set-properties) 'ignore)
3524;; (fmakunbound 'dired-insert-set-properties)))
3525 3281
3526;; CCC is this the right thing to do? 3282;; CCC is this the right thing to do?
3527(defun tramp-handle-unhandled-file-name-directory (filename) 3283(defun tramp-handle-unhandled-file-name-directory (filename)
3528 "Like `unhandled-file-name-directory' for tramp files." 3284 "Like `unhandled-file-name-directory' for Tramp files."
3529 (with-parsed-tramp-file-name filename nil 3285 (with-parsed-tramp-file-name filename nil
3530 (expand-file-name "~/"))) 3286 (expand-file-name (tramp-make-tramp-file-name method user host "~/"))))
3531 3287
3532;; Canonicalization of file names. 3288;; Canonicalization of file names.
3533 3289
@@ -3548,7 +3304,7 @@ Doesn't do anything if the NAME does not start with a drive letter."
3548 name)) 3304 name))
3549 3305
3550(defun tramp-handle-expand-file-name (name &optional dir) 3306(defun tramp-handle-expand-file-name (name &optional dir)
3551 "Like `expand-file-name' for tramp files. 3307 "Like `expand-file-name' for Tramp files.
3552If the localname part of the given filename starts with \"/../\" then 3308If the localname part of the given filename starts with \"/../\" then
3553the result will be a local, non-Tramp, filename." 3309the result will be a local, non-Tramp, filename."
3554 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". 3310 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -3556,223 +3312,107 @@ the result will be a local, non-Tramp, filename."
3556 ;; Unless NAME is absolute, concat DIR and NAME. 3312 ;; Unless NAME is absolute, concat DIR and NAME.
3557 (unless (file-name-absolute-p name) 3313 (unless (file-name-absolute-p name)
3558 (setq name (concat (file-name-as-directory dir) name))) 3314 (setq name (concat (file-name-as-directory dir) name)))
3559 ;; If NAME is not a tramp file, run the real handler 3315 ;; If NAME is not a Tramp file, run the real handler.
3560 (if (not (tramp-tramp-file-p name)) 3316 (if (not (tramp-tramp-file-p name))
3561 (tramp-run-real-handler 'expand-file-name 3317 (tramp-run-real-handler 'expand-file-name (list name nil))
3562 (list name nil))
3563 ;; Dissect NAME. 3318 ;; Dissect NAME.
3564 (with-parsed-tramp-file-name name nil 3319 (with-parsed-tramp-file-name name nil
3565 (unless (file-name-absolute-p localname) 3320 (unless (file-name-absolute-p localname)
3566 (setq localname (concat "~/" localname))) 3321 (setq localname (concat "~/" localname)))
3567 (save-excursion 3322 ;; Tilde expansion if necessary. This needs a shell which
3568 ;; Tilde expansion if necessary. This needs a shell which 3323 ;; groks tilde expansion! The function `tramp-find-shell' is
3569 ;; groks tilde expansion! The function `tramp-find-shell' is 3324 ;; supposed to find such a shell on the remote host. Please
3570 ;; supposed to find such a shell on the remote host. Please 3325 ;; tell me about it when this doesn't work on your system.
3571 ;; tell me about it when this doesn't work on your system. 3326 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
3572 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) 3327 (let ((uname (match-string 1 localname))
3573 (let ((uname (match-string 1 localname)) 3328 (fname (match-string 2 localname)))
3574 (fname (match-string 2 localname))) 3329 ;; We cannot simply apply "~/", because under sudo "~/" is
3575 ;; We cannot simply apply "~/", because under sudo "~/" is 3330 ;; expanded to the local user home directory but to the
3576 ;; expanded to the local user home directory but to the 3331 ;; root home directory. On the other hand, using always
3577 ;; root home directory. On the other hand, using always 3332 ;; the default user name for tilde expansion is not
3578 ;; the default user name for tilde expansion is not 3333 ;; appropriate either, because ssh and companions might
3579 ;; appropriate either, because ssh and companions might 3334 ;; use a user name from the config file.
3580 ;; use a user name from the config file. 3335 (when (and (string-equal uname "~")
3581 (when (and (string-equal uname "~") 3336 (string-match "\\`su\\(do\\)?\\'" method))
3582 (string-match 3337 (setq uname (concat uname user)))
3583 "\\`su\\(do\\)?\\'" 3338 (setq uname
3584 (tramp-find-method multi-method method user host))) 3339 (with-connection-property v uname
3585 (setq uname (concat uname (or user "root")))) 3340 (tramp-send-command v (format "cd %s; pwd" uname))
3586 ;; CCC fanatic error checking? 3341 (with-current-buffer (tramp-get-buffer v)
3587 (set-buffer (tramp-get-buffer multi-method method user host)) 3342 (goto-char (point-min))
3588 (erase-buffer) 3343 (buffer-substring (point) (tramp-line-end-position)))))
3589 (tramp-send-command 3344 (setq localname (concat uname fname))))
3590 multi-method method user host 3345 ;; There might be a double slash, for example when "~/"
3591 (format "cd %s; pwd" uname) 3346 ;; expands to "/". Remove this.
3592 t) 3347 (while (string-match "//" localname)
3593 (tramp-wait-for-output) 3348 (setq localname (replace-match "/" t t localname)))
3594 (goto-char (point-min)) 3349 ;; No tilde characters in file name, do normal
3595 (setq uname (buffer-substring (point) (tramp-line-end-position))) 3350 ;; expand-file-name (this does "/./" and "/../"). We bind
3596 (setq localname (concat uname fname)) 3351 ;; `directory-sep-char' here for XEmacs on Windows, which
3597 (erase-buffer))) 3352 ;; would otherwise use backslash. `default-directory' is
3598 ;; There might be a double slash, for example when "~/" 3353 ;; bound, because on Windows there would be problems with UNC
3599 ;; expands to "/". Remove this. 3354 ;; shares or Cygwin mounts.
3600 (while (string-match "//" localname) 3355 (tramp-let-maybe directory-sep-char ?/
3601 (setq localname (replace-match "/" t t localname))) 3356 (let ((default-directory (tramp-temporary-file-directory)))
3602 ;; No tilde characters in file name, do normal 3357 (tramp-make-tramp-file-name
3603 ;; expand-file-name (this does "/./" and "/../"). We bind 3358 method user host
3604 ;; directory-sep-char here for XEmacs on Windows, which would 3359 (tramp-drop-volume-letter
3605 ;; otherwise use backslash. `default-directory' is bound to 3360 (tramp-run-real-handler 'expand-file-name
3606 ;; "/", because on Windows there would be problems with UNC 3361 (list localname)))))))))
3607 ;; shares or Cygwin mounts. 3362
3608 (tramp-let-maybe directory-sep-char ?/ 3363(defun tramp-handle-substitute-in-file-name (filename)
3609 (let ((default-directory "/")) 3364 "Like `substitute-in-file-name' for Tramp files.
3610 (tramp-make-tramp-file-name 3365\"//\" and \"/~\" substitute only in the local filename part.
3611 multi-method (or method (tramp-find-default-method user host)) 3366If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
3612 user host 3367beginning of local filename are not substituted."
3613 (tramp-drop-volume-letter 3368 (with-parsed-tramp-file-name filename nil
3614 (tramp-run-real-handler 'expand-file-name 3369 (if (equal tramp-syntax 'url)
3615 (list localname)))))))))) 3370 ;; We need to check localname only. The other parts cannot contain
3616 3371 ;; "//" or "/~".
3617;; old version follows. it uses ".." to cross file handler 3372 (if (and (> (length localname) 1)
3618;; boundaries. 3373 (or (string-match "//" localname)
3619;; ;; Look if localname starts with "/../" construct. If this is 3374 (string-match "/~" localname 1)))
3620;; ;; the case, then we return a local name instead of a remote name. 3375 (tramp-run-real-handler 'substitute-in-file-name (list filename))
3621;; (if (string-match "^/\\.\\./" localname) 3376 (tramp-make-tramp-file-name
3622;; (expand-file-name (substring localname 3)) 3377 (when method (substitute-in-file-name method))
3623;; ;; No tilde characters in file name, do normal 3378 (when user (substitute-in-file-name user))
3624;; ;; expand-file-name (this does "/./" and "/../"). We bind 3379 (when host (substitute-in-file-name host))
3625;; ;; directory-sep-char here for XEmacs on Windows, which 3380 (when localname (substitute-in-file-name localname))))
3626;; ;; would otherwise use backslash. 3381 ;; Ignore in LOCALNAME everything before "//" or "/~".
3627;; (let ((directory-sep-char ?/)) 3382 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
3628;; (tramp-make-tramp-file-name 3383 (setq filename
3629;; multi-method method user host 3384 (tramp-make-tramp-file-name
3630;; (tramp-drop-volume-letter 3385 method user host (replace-match "\\1" nil nil localname)))
3631;; (tramp-run-real-handler 'expand-file-name 3386 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
3632;; (list localname)))))))))) 3387 (when (string-match "~$" filename)
3633 3388 (setq filename (concat filename "/"))))
3634;; Remote commands. 3389 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
3635 3390
3636(defvar tramp-async-proc nil 3391;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
3637 "Global variable keeping asynchronous process object. 3392;; which calls corresponding functions (see minibuf.el).
3638Used in `tramp-handle-shell-command'") 3393(when (fboundp 'minibuffer-electric-separator)
3639 3394 (mapcar
3640(defvar tramp-display-shell-command-buffer t 3395 '(lambda (x)
3641 "Whether to display output buffer of `shell-command'. 3396 (eval
3642This is necessary for handling DISPLAY of `process-file'.") 3397 `(defadvice ,x
3643 3398 (around ,(intern (format "tramp-advice-%s" x)) activate)
3644(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) 3399 "Invoke `substitute-in-file-name' for Tramp files."
3645 "Like `shell-command' for tramp files. 3400 (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
3646This will break if COMMAND prints a newline, followed by the value of 3401 (tramp-tramp-file-p (buffer-substring)))
3647`tramp-end-of-output', followed by another newline." 3402 ;; We don't need to handle `last-input-event', because
3648 ;; Asynchronous processes are far from being perfect. But it works at least 3403 ;; due to the key map we know it must be ?/ or ?~.
3649 ;; for `find-grep-dired' and `find-name-dired' in Emacs 22. 3404 (let ((s (concat (buffer-substring (point-min) (point))
3650 (if (tramp-tramp-file-p default-directory) 3405 (string last-command-char))))
3651 (with-parsed-tramp-file-name default-directory nil 3406 (delete-region (point-min) (point))
3652 (let ((curbuf (current-buffer)) 3407 (insert (substitute-in-file-name s))
3653 (asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) 3408 (setq ad-return-value last-command-char))
3654 status) 3409 ad-do-it))))
3655 (unless output-buffer 3410
3656 (setq output-buffer 3411 '(minibuffer-electric-separator
3657 (get-buffer-create 3412 minibuffer-electric-tilde)))
3658 (if asynchronous 3413
3659 "*Async Shell Command*" 3414
3660 "*Shell Command Output*"))) 3415;;; Remote commands.
3661 (set-buffer output-buffer)
3662 (erase-buffer))
3663 (unless (bufferp output-buffer)
3664 (setq output-buffer (current-buffer)))
3665 (set-buffer output-buffer)
3666 ;; Tramp doesn't handle the asynchronous case by an asynchronous
3667 ;; process. Instead of, another asynchronous process is opened
3668 ;; which gets the output of the (synchronous) Tramp process
3669 ;; via process-filter. ERROR-BUFFER is disabled.
3670 (when asynchronous
3671 (setq command (substring command 0 (match-beginning 0))
3672 error-buffer nil
3673 tramp-async-proc (start-process (buffer-name output-buffer)
3674 output-buffer "cat")))
3675 (save-excursion
3676 (tramp-barf-unless-okay
3677 multi-method method user host
3678 (format "cd %s" (tramp-shell-quote-argument localname))
3679 nil 'file-error
3680 "tramp-handle-shell-command: Couldn't `cd %s'"
3681 (tramp-shell-quote-argument localname))
3682 ;; Define the process filter
3683 (when asynchronous
3684 (set-process-filter
3685 (get-buffer-process
3686 (tramp-get-buffer multi-method method user host))
3687 '(lambda (process string)
3688 ;; Write the output into the Tramp Process
3689 (save-current-buffer
3690 (set-buffer (process-buffer process))
3691 (goto-char (point-max))
3692 (insert string))
3693 ;; Hand-over output to asynchronous process.
3694 (let ((end
3695 (string-match
3696 (regexp-quote tramp-end-of-output) string)))
3697 (when end
3698 (setq string
3699 (substring string 0 (1- (match-beginning 0)))))
3700 (process-send-string tramp-async-proc string)
3701 (when end
3702 (set-process-filter process nil)
3703 (process-send-eof tramp-async-proc))))))
3704 ;; Send the command
3705 (tramp-send-command
3706 multi-method method user host
3707 (if error-buffer
3708 (format "( %s ) 2>/tmp/tramp.$$.err; tramp_old_status=$?"
3709 command)
3710 (format "%s; tramp_old_status=$?" command)))
3711 (unless asynchronous
3712 (tramp-wait-for-output)))
3713 (unless asynchronous
3714 ;; We cannot use `insert-buffer' because the tramp buffer
3715 ;; changes its contents before insertion due to calling
3716 ;; `expand-file' and alike.
3717 (insert
3718 (with-current-buffer
3719 (tramp-get-buffer multi-method method user host)
3720 (buffer-string))))
3721 (when error-buffer
3722 (save-excursion
3723 (unless (bufferp error-buffer)
3724 (setq error-buffer (get-buffer-create error-buffer)))
3725 (tramp-send-command
3726 multi-method method user host
3727 "cat /tmp/tramp.$$.err")
3728 (tramp-wait-for-output)
3729 (set-buffer error-buffer)
3730 ;; Same comment as above
3731 (insert
3732 (with-current-buffer
3733 (tramp-get-buffer multi-method method user host)
3734 (buffer-string)))
3735 (tramp-send-command-and-check
3736 multi-method method user host "rm -f /tmp/tramp.$$.err")))
3737 (save-excursion
3738 (tramp-send-command multi-method method user host "cd")
3739 (unless asynchronous
3740 (tramp-wait-for-output))
3741 (tramp-send-command
3742 multi-method method user host
3743 (concat "tramp_set_exit_status $tramp_old_status;"
3744 " echo tramp_exit_status $?"))
3745 (unless asynchronous
3746 (tramp-wait-for-output)
3747 (goto-char (point-max))
3748 (unless (search-backward "tramp_exit_status " nil t)
3749 (error "Couldn't find exit status of `%s'" command))
3750 (skip-chars-forward "^ ")
3751 (setq status (read (current-buffer)))))
3752 (unless (zerop (buffer-size))
3753 (when tramp-display-shell-command-buffer
3754 (display-buffer output-buffer)))
3755 (set-buffer curbuf)
3756 status))
3757 ;; The following is only executed if something strange was
3758 ;; happening. Emit a helpful message and do it anyway.
3759 (message "tramp-handle-shell-command called with non-tramp directory: `%s'"
3760 default-directory)
3761 (tramp-run-real-handler 'shell-command
3762 (list command output-buffer error-buffer))))
3763
3764(defun tramp-handle-process-file (program &optional infile buffer display &rest args)
3765 "Like `process-file' for Tramp files."
3766 (when infile (error "Implementation does not handle input from file"))
3767 (when (and (numberp buffer) (zerop buffer))
3768 (error "Implementation does not handle immediate return"))
3769 (when (consp buffer) (error "Implementation does not handle error files"))
3770 (let ((tramp-display-shell-command-buffer display))
3771 (shell-command
3772 (mapconcat 'tramp-shell-quote-argument (cons program args) " ")
3773 buffer)))
3774
3775;; File Editing.
3776 3416
3777(defsubst tramp-make-temp-file (filename) 3417(defsubst tramp-make-temp-file (filename)
3778 (concat 3418 (concat
@@ -3781,102 +3421,254 @@ This will break if COMMAND prints a newline, followed by the value of
3781 (tramp-temporary-file-directory))) 3421 (tramp-temporary-file-directory)))
3782 (file-name-extension filename t))) 3422 (file-name-extension filename t)))
3783 3423
3424(defsubst tramp-make-tramp-temp-file (vec)
3425 (format
3426 "/tmp/%s%s"
3427 tramp-temp-name-prefix
3428 (if (get-buffer-process (tramp-get-connection-buffer vec))
3429 (process-id (get-buffer-process (tramp-get-connection-buffer vec)))
3430 (emacs-pid))))
3431
3432(defun tramp-handle-executable-find (command)
3433 "Like `executable-find' for Tramp files."
3434 (with-parsed-tramp-file-name default-directory nil
3435 (tramp-find-executable v command tramp-remote-path t)))
3436
3437;; We use BUFFER also as connection buffer during setup. Because of
3438;; this, its original contents must be saved, and restored once
3439;; connection has been setup.
3440(defun tramp-handle-start-file-process (name buffer program &rest args)
3441 "Like `start-file-process' for Tramp files."
3442 (with-parsed-tramp-file-name default-directory nil
3443 (unwind-protect
3444 (progn
3445 ;; Set the new process properties.
3446 (tramp-set-connection-property v "process-name" name)
3447 (tramp-set-connection-property
3448 v "process-buffer"
3449 (get-buffer-create
3450 ;; BUFFER can be nil.
3451 (or buffer (generate-new-buffer-name (tramp-buffer-name v)))))
3452 ;; Activate narrowing in order to save BUFFER contents.
3453 (with-current-buffer (tramp-get-connection-buffer v)
3454 (narrow-to-region (point-max) (point-max)))
3455 ;; Goto working directory. `tramp-send-command' opens a new
3456 ;; connection.
3457 (tramp-send-command
3458 v (format "cd %s" (tramp-shell-quote-argument localname)))
3459 ;; Send the command.
3460 (tramp-send-command
3461 v
3462 (format "%s; exit"
3463 (mapconcat 'tramp-shell-quote-argument
3464 (cons program args) " "))
3465 nil t) ; nooutput
3466 ;; Return process.
3467 (tramp-get-connection-process v))
3468 ;; Save exit.
3469 (with-current-buffer (tramp-get-connection-buffer v) (widen))
3470 (tramp-set-connection-property v "process-name" nil)
3471 (tramp-set-connection-property v "process-buffer" nil))))
3472
3473(defun tramp-handle-process-file
3474 (program &optional infile destination display &rest args)
3475 "Like `process-file' for Tramp files."
3476 ;; The implementation is not complete yet.
3477 (when (and (numberp destination) (zerop destination))
3478 (error "Implementation does not handle immediate return"))
3479
3480 (with-parsed-tramp-file-name default-directory nil
3481 (let ((temp-name-prefix (tramp-make-tramp-temp-file v))
3482 command input stderr outbuf ret)
3483 ;; Compute command.
3484 (setq command (mapconcat 'tramp-shell-quote-argument
3485 (cons program args) " "))
3486 ;; Determine input.
3487 (if (null infile)
3488 (setq input "/dev/null")
3489 (setq infile (expand-file-name infile))
3490 (if (tramp-equal-remote default-directory infile)
3491 ;; INFILE is on the same remote host.
3492 (setq input (with-parsed-tramp-file-name infile nil localname))
3493 ;; INFILE must be copied to remote host.
3494 (setq input (concat temp-name-prefix ".in"))
3495 (copy-file
3496 infile
3497 (tramp-make-tramp-file-name method user host input)
3498 t)))
3499 (when input (setq command (format "%s <%s" command input)))
3500
3501 ;; Determine output.
3502 (cond
3503 ;; Just a buffer
3504 ((bufferp destination)
3505 (setq outbuf destination))
3506 ;; A buffer name
3507 ((stringp destination)
3508 (setq outbuf (get-buffer-create destination)))
3509 ;; (REAL-DESTINATION ERROR-DESTINATION)
3510 ((consp destination)
3511 ;; output
3512 (cond
3513 ((bufferp (car destination))
3514 (setq outbuf (car destination)))
3515 ((stringp (car destination))
3516 (setq outbuf (get-buffer-create (car destination)))))
3517 ;; stderr
3518 (cond
3519 ((stringp (cadr destination))
3520 (setcar (cdr destination) (expand-file-name (cadr destination)))
3521 (if (tramp-equal-remote default-directory (cadr destination))
3522 ;; stderr is on the same remote host.
3523 (setq stderr (with-parsed-tramp-file-name
3524 (cadr destination) nil localname))
3525 ;; stderr must be copied to remote host. The temporary
3526 ;; file must be deleted after execution.
3527 (setq stderr (concat temp-name-prefix ".err"))))
3528 ;; stderr to be discarded
3529 ((null (cadr destination))
3530 (setq stderr "/dev/null"))))
3531 ;; 't
3532 (destination
3533 (setq outbuf (current-buffer))))
3534 (when stderr (setq command (format "%s 2>%s" command stderr)))
3535
3536 ;; If we have a temporary file, it must be removed after operation.
3537 (when (and input (string-match temp-name-prefix input))
3538 (setq command (format "%s; rm %s" command input)))
3539 ;; Goto working directory.
3540 (tramp-send-command
3541 v (format "cd %s" (tramp-shell-quote-argument localname)))
3542 ;; Send the command. It might not return in time, so we protect it.
3543 (condition-case nil
3544 (unwind-protect
3545 (tramp-send-command v command)
3546 ;; We should show the output anyway.
3547 (when outbuf
3548 (with-current-buffer outbuf
3549 (insert-buffer-substring (tramp-get-connection-buffer v)))
3550 (when display (display-buffer outbuf))))
3551 ;; When the user did interrupt, we should do it also.
3552 (error
3553 (kill-buffer (tramp-get-connection-buffer v))
3554 (setq ret 1)))
3555 (unless ret
3556 ;; Check return code.
3557 (setq ret (tramp-send-command-and-check v nil))
3558 ;; Provide error file.
3559 (when (and stderr (string-match temp-name-prefix stderr))
3560 (rename-file (tramp-make-tramp-file-name method user host stderr)
3561 (cadr destination) t)))
3562 ;; Return exit status.
3563 ret)))
3564
3565(defun tramp-handle-call-process-region
3566 (start end program &optional delete buffer display &rest args)
3567 "Like `call-process-region' for Tramp files."
3568 (let ((tmpfile (tramp-make-temp-file "")))
3569 (write-region start end tmpfile)
3570 (when delete (delete-region start end))
3571 (unwind-protect
3572 (apply 'call-process program tmpfile buffer display args)
3573 (delete-file tmpfile))))
3574
3575(defun tramp-handle-shell-command
3576 (command &optional output-buffer error-buffer)
3577 "Like `shell-command' for Tramp files."
3578 (with-parsed-tramp-file-name default-directory nil
3579 (let ((shell-file-name
3580 (tramp-get-connection-property v "remote-shell" "/bin/sh"))
3581 (shell-command-switch "-c"))
3582 (tramp-run-real-handler
3583 'shell-command (list command output-buffer error-buffer)))))
3584
3585;; File Editing.
3586
3587(defvar tramp-handle-file-local-copy-hook nil
3588 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.")
3589
3784(defun tramp-handle-file-local-copy (filename) 3590(defun tramp-handle-file-local-copy (filename)
3785 "Like `file-local-copy' for tramp files." 3591 "Like `file-local-copy' for Tramp files."
3786 (with-parsed-tramp-file-name filename nil 3592 (with-parsed-tramp-file-name filename nil
3787 (let ((tramp-buf (tramp-get-buffer multi-method method user host)) 3593 (let (;; We used to bind the following as late as possible.
3788 ;; We used to bind the following as late as possible. 3594 ;; loc-dec was bound directly before the if statement that
3789 ;; loc-enc and loc-dec were bound directly before the if 3595 ;; checks them. But the functions tramp-get-* might invoke
3790 ;; statement that checks them. But the functions 3596 ;; the "are you awake" check in `tramp-maybe-open-connection',
3791 ;; tramp-get-* might invoke the "are you awake" check in 3597 ;; which is an unfortunate time since we rely on the buffer
3792 ;; tramp-maybe-open-connection, which is an unfortunate time 3598 ;; contents at that spot.
3793 ;; since we rely on the buffer contents at that spot. 3599 (rem-enc (tramp-get-remote-coding v "remote-encoding"))
3794 (rem-enc (tramp-get-remote-encoding multi-method method user host)) 3600 (loc-dec (tramp-get-local-coding v "local-decoding"))
3795 (rem-dec (tramp-get-remote-decoding multi-method method user host))
3796 (loc-enc (tramp-get-local-encoding multi-method method user host))
3797 (loc-dec (tramp-get-local-decoding multi-method method user host))
3798 tmpfil) 3601 tmpfil)
3799 (unless (file-exists-p filename) 3602 (unless (file-exists-p filename)
3800 (error "Cannot make local copy of non-existing file `%s'" 3603 (tramp-error
3801 filename)) 3604 v 'file-error
3605 "Cannot make local copy of non-existing file `%s'" filename))
3802 (setq tmpfil (tramp-make-temp-file filename)) 3606 (setq tmpfil (tramp-make-temp-file filename))
3803 3607
3804 (cond ((tramp-method-out-of-band-p multi-method method user host) 3608 (cond ((and (tramp-method-out-of-band-p v)
3609 (> (nth 7 (file-attributes filename))
3610 tramp-copy-size-limit))
3805 ;; `copy-file' handles out-of-band methods 3611 ;; `copy-file' handles out-of-band methods
3806 (copy-file filename tmpfil t t)) 3612 (copy-file filename tmpfil t t))
3807 3613
3808 ((and rem-enc rem-dec) 3614 (rem-enc
3809 ;; Use inline encoding for file transfer. 3615 ;; Use inline encoding for file transfer.
3810 (save-excursion 3616 (save-excursion
3811 ;; Following line for setting tramp-current-method, 3617 (tramp-message v 5 "Encoding remote file %s..." filename)
3812 ;; tramp-current-user, tramp-current-host.
3813 (set-buffer tramp-buf)
3814 (tramp-message 5 "Encoding remote file %s..." filename)
3815 (tramp-barf-unless-okay 3618 (tramp-barf-unless-okay
3816 multi-method method user host 3619 v
3817 (concat rem-enc " < " (tramp-shell-quote-argument localname)) 3620 (concat rem-enc " < " (tramp-shell-quote-argument localname))
3818 nil 'file-error 3621 "Encoding remote file failed")
3819 "Encoding remote file failed, see buffer `%s' for details"
3820 tramp-buf)
3821 ;; Remove trailing status code
3822 (goto-char (point-max))
3823 (delete-region (point) (progn (forward-line -1) (point)))
3824 3622
3825 (tramp-message 5 "Decoding remote file %s..." filename) 3623 (tramp-message v 5 "Decoding remote file %s..." filename)
3826 3624 ;; Here is where loc-dec used to be let-bound.
3827 ;; Here is where loc-enc and loc-dec used to be let-bound.
3828 (if (and (symbolp loc-dec) (fboundp loc-dec)) 3625 (if (and (symbolp loc-dec) (fboundp loc-dec))
3829 ;; If local decoding is a function, we call it. We 3626 ;; If local decoding is a function, we call it. We
3830 ;; must disable multibyte, because 3627 ;; must disable multibyte, because
3831 ;; `uudecode-decode-region' doesn't handle it 3628 ;; `uudecode-decode-region' doesn't handle it
3832 ;; correctly. 3629 ;; correctly.
3833 (let ((tmpbuf (get-buffer-create " *tramp tmp*"))) 3630 (unwind-protect
3834 (set-buffer tmpbuf) 3631 (with-temp-buffer
3835 (erase-buffer) 3632 (set-buffer-multibyte nil)
3836 (set-buffer-multibyte nil) 3633 (insert-buffer-substring (tramp-get-buffer v))
3837 (insert-buffer-substring tramp-buf) 3634 (tramp-message
3838 (tramp-message-for-buffer 3635 v 5 "Decoding remote file %s with function %s..."
3839 multi-method method user host 3636 filename loc-dec)
3840 6 "Decoding remote file %s with function %s..." 3637 (funcall loc-dec (point-min) (point-max))
3841 filename loc-dec) 3638 (let ((coding-system-for-write 'binary))
3842 (set-buffer tmpbuf) 3639 (write-region (point-min) (point-max) tmpfil))))
3843 ;; Douglas Gray Stephens <DGrayStephens@slb.com>
3844 ;; says that we need to strip tramp_exit_status
3845 ;; line from the output here. Go to point-max,
3846 ;; search backward for tramp_exit_status, delete
3847 ;; between point and point-max if found.
3848 (let ((coding-system-for-write 'binary))
3849 (funcall loc-dec (point-min) (point-max))
3850 (write-region (point-min) (point-max) tmpfil))
3851 (kill-buffer tmpbuf))
3852 ;; If tramp-decoding-function is not defined for this 3640 ;; If tramp-decoding-function is not defined for this
3853 ;; method, we invoke tramp-decoding-command instead. 3641 ;; method, we invoke tramp-decoding-command instead.
3854 (let ((tmpfil2 (tramp-make-temp-file filename))) 3642 (let ((tmpfil2 (tramp-make-temp-file filename)))
3855 (write-region (point-min) (point-max) tmpfil2) 3643 (let ((coding-system-for-write 'binary))
3644 (write-region (point-min) (point-max) tmpfil2))
3856 (tramp-message 3645 (tramp-message
3857 6 "Decoding remote file %s with command %s..." 3646 v 5 "Decoding remote file %s with command %s..."
3858 filename loc-dec) 3647 filename loc-dec)
3859 (tramp-call-local-coding-command 3648 (tramp-call-local-coding-command
3860 loc-dec tmpfil2 tmpfil) 3649 loc-dec tmpfil2 tmpfil)
3861 (delete-file tmpfil2))) 3650 (delete-file tmpfil2)))
3862 (tramp-message-for-buffer 3651 (tramp-message v 5 "Decoding remote file %s...done" filename)
3863 multi-method method user host
3864 5 "Decoding remote file %s...done" filename)
3865 ;; Set proper permissions. 3652 ;; Set proper permissions.
3866 (set-file-modes tmpfil (file-modes filename)))) 3653 (set-file-modes tmpfil (file-modes filename))))
3867 3654
3868 (t (error "Wrong method specification for `%s'" method))) 3655 (t (tramp-error
3656 v 'file-error "Wrong method specification for `%s'" method)))
3657 (run-hooks 'tramp-handle-file-local-copy-hook)
3869 tmpfil))) 3658 tmpfil)))
3870 3659
3871(defun tramp-handle-file-remote-p (filename) 3660(defun tramp-handle-file-remote-p (filename &optional connected)
3872 "Like `file-remote-p' for tramp files." 3661 "Like `file-remote-p' for Tramp files."
3873 (when (tramp-tramp-file-p filename) 3662 (when (tramp-tramp-file-p filename)
3874 (with-parsed-tramp-file-name filename nil 3663 (with-parsed-tramp-file-name filename nil
3875 (vector multi-method method user host "")))) 3664 (and (or (not connected)
3665 (let ((p (tramp-get-connection-process v)))
3666 (and p (processp p) (memq (process-status p) '(run open)))))
3667 (tramp-make-tramp-file-name method user host "")))))
3876 3668
3877(defun tramp-handle-insert-file-contents 3669(defun tramp-handle-insert-file-contents
3878 (filename &optional visit beg end replace) 3670 (filename &optional visit beg end replace)
3879 "Like `insert-file-contents' for tramp files." 3671 "Like `insert-file-contents' for Tramp files."
3880 (barf-if-buffer-read-only) 3672 (barf-if-buffer-read-only)
3881 (setq filename (expand-file-name filename)) 3673 (setq filename (expand-file-name filename))
3882 (with-parsed-tramp-file-name filename nil 3674 (with-parsed-tramp-file-name filename nil
@@ -3886,8 +3678,8 @@ This will break if COMMAND prints a newline, followed by the value of
3886 (setq buffer-file-name filename) 3678 (setq buffer-file-name filename)
3887 (set-visited-file-modtime) 3679 (set-visited-file-modtime)
3888 (set-buffer-modified-p nil)) 3680 (set-buffer-modified-p nil))
3889 (signal 'file-error 3681 (tramp-error
3890 (format "File `%s' not found on remote host" filename)) 3682 v 'file-error "File %s not found on remote host" filename)
3891 (list (expand-file-name filename) 0)) 3683 (list (expand-file-name filename) 0))
3892 ;; `insert-file-contents-literally' takes care to avoid calling 3684 ;; `insert-file-contents-literally' takes care to avoid calling
3893 ;; jka-compr. By let-binding inhibit-file-name-operation, we 3685 ;; jka-compr. By let-binding inhibit-file-name-operation, we
@@ -3899,20 +3691,16 @@ This will break if COMMAND prints a newline, followed by the value of
3899 'file-local-copy))) 3691 'file-local-copy)))
3900 (file-local-copy filename))) 3692 (file-local-copy filename)))
3901 coding-system-used result) 3693 coding-system-used result)
3694 (tramp-message v 4 "Inserting local temp file `%s'..." local-copy)
3695 (setq result (insert-file-contents local-copy nil beg end replace))
3902 (when visit 3696 (when visit
3903 (setq buffer-file-name filename) 3697 (setq buffer-file-name filename)
3904 (set-visited-file-modtime) 3698 (set-visited-file-modtime)
3905 (set-buffer-modified-p nil)) 3699 (set-buffer-modified-p nil))
3906 (tramp-message-for-buffer
3907 multi-method method user host
3908 9 "Inserting local temp file `%s'..." local-copy)
3909 (setq result (insert-file-contents local-copy nil beg end replace))
3910 ;; Now `last-coding-system-used' has right value. Remember it. 3700 ;; Now `last-coding-system-used' has right value. Remember it.
3911 (when (boundp 'last-coding-system-used) 3701 (when (boundp 'last-coding-system-used)
3912 (setq coding-system-used (symbol-value 'last-coding-system-used))) 3702 (setq coding-system-used (symbol-value 'last-coding-system-used)))
3913 (tramp-message-for-buffer 3703 (tramp-message v 4 "Inserting local temp file `%s'...done" local-copy)
3914 multi-method method user host
3915 9 "Inserting local temp file `%s'...done" local-copy)
3916 (delete-file local-copy) 3704 (delete-file local-copy)
3917 (when (boundp 'last-coding-system-used) 3705 (when (boundp 'last-coding-system-used)
3918 (set 'last-coding-system-used coding-system-used)) 3706 (set 'last-coding-system-used coding-system-used))
@@ -3921,7 +3709,7 @@ This will break if COMMAND prints a newline, followed by the value of
3921 3709
3922 3710
3923(defun tramp-handle-find-backup-file-name (filename) 3711(defun tramp-handle-find-backup-file-name (filename)
3924 "Like `find-backup-file-name' for tramp files." 3712 "Like `find-backup-file-name' for Tramp files."
3925 (with-parsed-tramp-file-name filename nil 3713 (with-parsed-tramp-file-name filename nil
3926 ;; We set both variables. It doesn't matter whether it is 3714 ;; We set both variables. It doesn't matter whether it is
3927 ;; Emacs or XEmacs 3715 ;; Emacs or XEmacs
@@ -3936,8 +3724,7 @@ This will break if COMMAND prints a newline, followed by the value of
3936 (if (and (stringp (cdr x)) 3724 (if (and (stringp (cdr x))
3937 (file-name-absolute-p (cdr x)) 3725 (file-name-absolute-p (cdr x))
3938 (not (tramp-file-name-p (cdr x)))) 3726 (not (tramp-file-name-p (cdr x))))
3939 (tramp-make-tramp-file-name 3727 (tramp-make-tramp-file-name method user host (cdr x))
3940 multi-method method user host (cdr x))
3941 (cdr x)))) 3728 (cdr x))))
3942 (symbol-value 'tramp-backup-directory-alist)) 3729 (symbol-value 'tramp-backup-directory-alist))
3943 (symbol-value 'backup-directory-alist)))) 3730 (symbol-value 'backup-directory-alist))))
@@ -3955,7 +3742,7 @@ This will break if COMMAND prints a newline, followed by the value of
3955 (file-name-absolute-p (car (cdr x))) 3742 (file-name-absolute-p (car (cdr x)))
3956 (not (tramp-file-name-p (car (cdr x))))) 3743 (not (tramp-file-name-p (car (cdr x)))))
3957 (tramp-make-tramp-file-name 3744 (tramp-make-tramp-file-name
3958 multi-method method user host (car (cdr x))) 3745 method user host (car (cdr x)))
3959 (car (cdr x)))) 3746 (car (cdr x))))
3960 (cdr (cdr x)))) 3747 (cdr (cdr x))))
3961 (symbol-value 'tramp-bkup-backup-directory-info)) 3748 (symbol-value 'tramp-bkup-backup-directory-info))
@@ -3964,9 +3751,18 @@ This will break if COMMAND prints a newline, followed by the value of
3964 (tramp-run-real-handler 'find-backup-file-name (list filename))))) 3751 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
3965 3752
3966(defun tramp-handle-make-auto-save-file-name () 3753(defun tramp-handle-make-auto-save-file-name ()
3967 "Like `make-auto-save-file-name' for tramp files. 3754 "Like `make-auto-save-file-name' for Tramp files.
3968Returns a file name in `tramp-auto-save-directory' for autosaving this file." 3755Returns a file name in `tramp-auto-save-directory' for autosaving this file."
3969 (let ((tramp-auto-save-directory tramp-auto-save-directory)) 3756 (let ((tramp-auto-save-directory tramp-auto-save-directory)
3757 (buffer-file-name
3758 (tramp-subst-strs-in-string
3759 '(("_" . "|")
3760 ("/" . "_a")
3761 (":" . "_b")
3762 ("|" . "__")
3763 ("[" . "_l")
3764 ("]" . "_r"))
3765 (buffer-file-name))))
3970 ;; File name must be unique. This is ensured with Emacs 22 (see 3766 ;; File name must be unique. This is ensured with Emacs 22 (see
3971 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for 3767 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
3972 ;; all other cases we must do it ourselves. 3768 ;; all other cases we must do it ourselves.
@@ -3981,68 +3777,49 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
3981 (symbol-value 'auto-save-file-name-transforms))) 3777 (symbol-value 'auto-save-file-name-transforms)))
3982 ;; Create directory. 3778 ;; Create directory.
3983 (when tramp-auto-save-directory 3779 (when tramp-auto-save-directory
3780 (setq buffer-file-name
3781 (expand-file-name buffer-file-name tramp-auto-save-directory))
3984 (unless (file-exists-p tramp-auto-save-directory) 3782 (unless (file-exists-p tramp-auto-save-directory)
3985 (make-directory tramp-auto-save-directory t))) 3783 (make-directory tramp-auto-save-directory t)))
3986 ;; jka-compr doesn't like auto-saving, so by appending "~" to the 3784 ;; Run plain `make-auto-save-file-name'. There might be an advice when
3987 ;; file name we make sure that jka-compr isn't used for the 3785 ;; it is not a magic file name operation (since Emacs 22).
3988 ;; auto-save file. 3786 ;; We must deactivate it temporarily.
3989 (let ((buffer-file-name 3787 (if (not (ad-is-active 'make-auto-save-file-name))
3990 (if tramp-auto-save-directory 3788 (tramp-run-real-handler 'make-auto-save-file-name nil)
3991 (expand-file-name 3789 ;; else
3992 (tramp-subst-strs-in-string 3790 (ad-deactivate 'make-auto-save-file-name)
3993 '(("_" . "|") 3791 (prog1
3994 ("/" . "_a") 3792 (tramp-run-real-handler 'make-auto-save-file-name nil)
3995 (":" . "_b") 3793 (ad-activate 'make-auto-save-file-name)))))
3996 ("|" . "__") 3794
3997 ("[" . "_l") 3795(defvar tramp-handle-write-region-hook nil
3998 ("]" . "_r")) 3796 "Normal hook to be run at the end of `tramp-handle-write-region'.")
3999 (buffer-file-name)) 3797
4000 tramp-auto-save-directory) 3798;; CCC grok APPEND, LOCKNAME
4001 (buffer-file-name))))
4002 ;; Run plain `make-auto-save-file-name'. There might be an advice when
4003 ;; it is not a magic file name operation (since Emacs 22).
4004 ;; We must deactivate it temporarily.
4005 (if (not (ad-is-active 'make-auto-save-file-name))
4006 (tramp-run-real-handler
4007 'make-auto-save-file-name nil)
4008 ;; else
4009 (ad-deactivate 'make-auto-save-file-name)
4010 (prog1
4011 (tramp-run-real-handler
4012 'make-auto-save-file-name nil)
4013 (ad-activate 'make-auto-save-file-name))))))
4014
4015
4016;; CCC grok APPEND, LOCKNAME, CONFIRM
4017(defun tramp-handle-write-region 3799(defun tramp-handle-write-region
4018 (start end filename &optional append visit lockname confirm) 3800 (start end filename &optional append visit lockname confirm)
4019 "Like `write-region' for tramp files." 3801 "Like `write-region' for Tramp files."
4020 (unless (eq append nil)
4021 (error "Cannot append to file using tramp (`%s')" filename))
4022 (setq filename (expand-file-name filename)) 3802 (setq filename (expand-file-name filename))
4023 ;; Following part commented out because we don't know what to do about
4024 ;; file locking, and it does not appear to be a problem to ignore it.
4025 ;; Ange-ftp ignores it, too.
4026 ;; (when (and lockname (stringp lockname))
4027 ;; (setq lockname (expand-file-name lockname)))
4028 ;; (unless (or (eq lockname nil)
4029 ;; (string= lockname filename))
4030 ;; (error
4031 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
4032 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
4033 (when (and (not (featurep 'xemacs))
4034 confirm (file-exists-p filename))
4035 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
4036 filename))
4037 (error "File not overwritten")))
4038 (with-parsed-tramp-file-name filename nil 3803 (with-parsed-tramp-file-name filename nil
4039 (let ((curbuf (current-buffer)) 3804 (unless (null append)
4040 (rem-enc (tramp-get-remote-encoding multi-method method user host)) 3805 (tramp-error
4041 (rem-dec (tramp-get-remote-decoding multi-method method user host)) 3806 v 'file-error "Cannot append to file using Tramp (`%s')" filename))
4042 (loc-enc (tramp-get-local-encoding multi-method method user host)) 3807 ;; Following part commented out because we don't know what to do about
4043 (loc-dec (tramp-get-local-decoding multi-method method user host)) 3808 ;; file locking, and it does not appear to be a problem to ignore it.
4044 (trampbuf (get-buffer-create "*tramp output*")) 3809 ;; Ange-ftp ignores it, too.
4045 (modes (file-modes filename)) 3810 ;; (when (and lockname (stringp lockname))
3811 ;; (setq lockname (expand-file-name lockname)))
3812 ;; (unless (or (eq lockname nil)
3813 ;; (string= lockname filename))
3814 ;; (error
3815 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
3816 ;; XEmacs takes a coding system as the seventh argument, not `confirm'
3817 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
3818 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
3819 (tramp-error v 'file-error "File not overwritten")))
3820 (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
3821 (loc-enc (tramp-get-local-coding v "local-encoding"))
3822 (modes (save-excursion (file-modes filename)))
4046 ;; We use this to save the value of `last-coding-system-used' 3823 ;; We use this to save the value of `last-coding-system-used'
4047 ;; after writing the tmp file. At the end of the function, 3824 ;; after writing the tmp file. At the end of the function,
4048 ;; we set `last-coding-system-used' to this saved value. 3825 ;; we set `last-coding-system-used' to this saved value.
@@ -4050,14 +3827,10 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
4050 ;; talking to the remote shell or suchlike won't hose this 3827 ;; talking to the remote shell or suchlike won't hose this
4051 ;; variable. This approach was snarfed from ange-ftp.el. 3828 ;; variable. This approach was snarfed from ange-ftp.el.
4052 coding-system-used 3829 coding-system-used
4053 tmpfil) 3830 ;; Write region into a tmp file. This isn't really needed if we
4054 ;; Write region into a tmp file. This isn't really needed if we 3831 ;; use an encoding function, but currently we use it always
4055 ;; use an encoding function, but currently we use it always 3832 ;; because this makes the logic simpler.
4056 ;; because this makes the logic simpler. 3833 (tmpfil (tramp-make-temp-file filename)))
4057 (setq tmpfil (tramp-make-temp-file filename))
4058 ;; Set current buffer. If connection wasn't open, `file-modes' has
4059 ;; changed it accidently.
4060 (set-buffer curbuf)
4061 ;; We say `no-message' here because we don't want the visited file 3834 ;; We say `no-message' here because we don't want the visited file
4062 ;; modtime data to be clobbered from the temp file. We call 3835 ;; modtime data to be clobbered from the temp file. We call
4063 ;; `set-visited-file-modtime' ourselves later on. 3836 ;; `set-visited-file-modtime' ourselves later on.
@@ -4080,96 +3853,106 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
4080 ;; decoding command must be specified. However, if the method 3853 ;; decoding command must be specified. However, if the method
4081 ;; _also_ specifies an encoding function, then that is used for 3854 ;; _also_ specifies an encoding function, then that is used for
4082 ;; encoding the contents of the tmp file. 3855 ;; encoding the contents of the tmp file.
4083 (cond ((tramp-method-out-of-band-p multi-method method user host) 3856 (cond ((and (tramp-method-out-of-band-p v)
3857 (integerp start)
3858 (> (- end start) tramp-copy-size-limit))
4084 ;; `copy-file' handles out-of-band methods 3859 ;; `copy-file' handles out-of-band methods
4085 (copy-file tmpfil filename t t)) 3860 (copy-file tmpfil filename t t))
4086 3861
4087 ((and rem-enc rem-dec) 3862 (rem-dec
4088 ;; Use inline file transfer 3863 ;; Use inline file transfer
4089 (let ((tmpbuf (get-buffer-create " *tramp file transfer*"))) 3864 ;; Encode tmpfil
4090 (save-excursion 3865 (tramp-message v 5 "Encoding region...")
4091 ;; Encode tmpfil into tmpbuf 3866 (unwind-protect
4092 (tramp-message-for-buffer multi-method method user host 3867 (with-temp-buffer
4093 5 "Encoding region...") 3868 ;; Use encoding function or command.
4094 (set-buffer tmpbuf) 3869 (if (and (symbolp loc-enc) (fboundp loc-enc))
4095 (erase-buffer) 3870 (progn
4096 ;; Use encoding function or command. 3871 (tramp-message
4097 (if (and (symbolp loc-enc) (fboundp loc-enc)) 3872 v 5 "Encoding region using function `%s'..."
4098 (progn 3873 (symbol-name loc-enc))
4099 (tramp-message-for-buffer 3874 (let ((coding-system-for-read 'binary))
4100 multi-method method user host 3875 (insert-file-contents-literally tmpfil))
4101 6 "Encoding region using function `%s'..." 3876 ;; CCC. The following `let' is a workaround for
4102 (symbol-name loc-enc)) 3877 ;; the base64.el that comes with pgnus-0.84. If
4103 (insert-file-contents-literally tmpfil) 3878 ;; both of the following conditions are
4104 ;; CCC. The following `let' is a workaround for 3879 ;; satisfied, it tries to write to a local file
4105 ;; the base64.el that comes with pgnus-0.84. If 3880 ;; in default-directory, but at this point,
4106 ;; both of the following conditions are 3881 ;; default-directory is remote.
4107 ;; satisfied, it tries to write to a local file 3882 ;; (CALL-PROCESS-REGION can't write to remote
4108 ;; in default-directory, but at this point, 3883 ;; files, it seems.) The file in question is a
4109 ;; default-directory is remote. 3884 ;; tmp file anyway.
4110 ;; (CALL-PROCESS-REGION can't write to remote 3885 (let ((default-directory
4111 ;; files, it seems.) The file in question is a 3886 (tramp-temporary-file-directory)))
4112 ;; tmp file anyway. 3887 (funcall loc-enc (point-min) (point-max))))
4113 (let ((default-directory 3888
4114 (tramp-temporary-file-directory))) 3889 (tramp-message
4115 (funcall loc-enc (point-min) (point-max))) 3890 v 5 "Encoding region using command `%s'..." loc-enc)
4116 (goto-char (point-max)) 3891 (unless (equal 0 (tramp-call-local-coding-command
4117 (unless (bolp) 3892 loc-enc tmpfil t))
4118 (newline))) 3893 (tramp-error
4119 (tramp-message-for-buffer 3894 v 'file-error
4120 multi-method method user host 3895 (concat "Cannot write to `%s', local encoding"
4121 6 "Encoding region using command `%s'..." loc-enc) 3896 " command `%s' failed")
4122 (unless (equal 0 (tramp-call-local-coding-command 3897 filename loc-enc)))
4123 loc-enc tmpfil t)) 3898
4124 (pop-to-buffer trampbuf) 3899 ;; Send buffer into remote decoding command which
4125 (error (concat "Cannot write to `%s', local encoding" 3900 ;; writes to remote file. Because this happens on the
4126 " command `%s' failed") 3901 ;; remote host, we cannot use the function.
4127 filename loc-enc))) 3902 (goto-char (point-max))
4128 ;; Send tmpbuf into remote decoding command which 3903 (unless (bolp) (newline))
4129 ;; writes to remote file. Because this happens on the 3904 (tramp-message
4130 ;; remote host, we cannot use the function. 3905 v 5 "Decoding region into remote file %s..." filename)
4131 (tramp-message-for-buffer 3906 (tramp-send-command
4132 multi-method method user host 3907 v
4133 5 "Decoding region into remote file %s..." filename) 3908 (format
4134 (tramp-send-command 3909 "%s >%s <<'EOF'\n%sEOF"
4135 multi-method method user host 3910 rem-dec
4136 (format "%s >%s <<'EOF'" 3911 (tramp-shell-quote-argument localname)
4137 rem-dec 3912 (buffer-string)))
4138 (tramp-shell-quote-argument localname))) 3913 (tramp-barf-unless-okay
4139 (set-buffer tmpbuf) 3914 v nil
4140 (tramp-message-for-buffer 3915 (concat "Couldn't write region to `%s',"
4141 multi-method method user host 3916 " decode using `%s' failed")
4142 6 "Sending data to remote host...") 3917 filename rem-dec)
4143 (tramp-send-string multi-method method user host 3918 ;; When `file-precious-flag' is set, the region is
4144 (buffer-string)) 3919 ;; written to a temporary file. Check that the
4145 ;; wait for remote decoding to complete 3920 ;; checksum is equal to that from the local tmpfil.
4146 (tramp-message-for-buffer 3921 (when file-precious-flag
4147 multi-method method user host 3922 (erase-buffer)
4148 6 "Sending end of data token...") 3923 (and
4149 (tramp-send-command 3924 ;; cksum runs locally
4150 multi-method method user host "EOF" nil t) 3925 (let ((default-directory
4151 (tramp-message-for-buffer 3926 (tramp-temporary-file-directory)))
4152 multi-method method user host 6 3927 (zerop (call-process "cksum" tmpfil t)))
4153 "Waiting for remote host to process data...") 3928 ;; cksum runs remotely
4154 (set-buffer (tramp-get-buffer multi-method method user host)) 3929 (zerop
4155 (tramp-wait-for-output) 3930 (tramp-send-command-and-check
4156 (tramp-barf-unless-okay 3931 v
4157 multi-method method user host nil nil 'file-error 3932 (format
4158 (concat "Couldn't write region to `%s'," 3933 "cksum <%s"
4159 " decode using `%s' failed") 3934 (tramp-shell-quote-argument localname))))
4160 filename rem-dec) 3935 ;; ... they are different
4161 (tramp-message 5 "Decoding region into remote file %s...done" 3936 (not
4162 filename) 3937 (string-equal
4163 (kill-buffer tmpbuf)))) 3938 (buffer-string)
3939 (with-current-buffer (tramp-get-buffer v)
3940 (buffer-string))))
3941 (tramp-error
3942 v 'file-error
3943 (concat "Couldn't write region to `%s',"
3944 " decode using `%s' failed")
3945 filename rem-dec)))
3946 (tramp-message
3947 v 5 "Decoding region into remote file %s...done" filename)
3948 (tramp-flush-file-property v localname))))
4164 (t 3949 (t
4165 (error 3950 (tramp-error
3951 v 'file-error
4166 (concat "Method `%s' should specify both encoding and " 3952 (concat "Method `%s' should specify both encoding and "
4167 "decoding command or an rcp program") 3953 "decoding command or an rcp program")
4168 method))) 3954 method)))
4169 (delete-file tmpfil) 3955 (delete-file tmpfil)
4170 (unless (equal curbuf (current-buffer))
4171 (error "Buffer has changed from `%s' to `%s'"
4172 curbuf (current-buffer)))
4173 (when (or (eq visit t) (stringp visit)) 3956 (when (or (eq visit t) (stringp visit))
4174 (set-visited-file-modtime 3957 (set-visited-file-modtime
4175 ;; We must pass modtime explicitely, because filename can be different 3958 ;; We must pass modtime explicitely, because filename can be different
@@ -4178,41 +3961,9 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
4178 ;; Make `last-coding-system-used' have the right value. 3961 ;; Make `last-coding-system-used' have the right value.
4179 (when (boundp 'last-coding-system-used) 3962 (when (boundp 'last-coding-system-used)
4180 (set 'last-coding-system-used coding-system-used)) 3963 (set 'last-coding-system-used coding-system-used))
4181 (when (or (eq visit t) 3964 (when (or (eq visit t) (null visit) (stringp visit))
4182 (eq visit nil) 3965 (tramp-message v 0 "Wrote %s" filename))
4183 (stringp visit)) 3966 (run-hooks 'tramp-handle-write-region-hook))))
4184 (message "Wrote %s" filename)))))
4185
4186;; Call down to the real handler.
4187;; Because EFS does not play nicely with TRAMP (both systems match a
4188;; TRAMP file name) it is needed to disable efs as well as tramp for the
4189;; operation.
4190;;
4191;; Other than that, this is the canon file-handler code that the doco
4192;; says should be used here. Which is nice.
4193;;
4194;; Under XEmacs current, EFS also hooks in as
4195;; efs-sifn-handler-function to handle any filename with environment
4196;; variables. This has two implications:
4197;; 1) That EFS may not be completely dead (yet) for TRAMP filenames
4198;; 2) That TRAMP might want to do the same thing.
4199;; Details as they come in.
4200;;
4201;; Daniel Pittman <daniel@danann.net>
4202
4203;; (defun tramp-run-real-handler (operation args)
4204;; "Invoke normal file name handler for OPERATION.
4205;; This inhibits EFS and Ange-FTP, too, because they conflict with tramp.
4206;; First arg specifies the OPERATION, remaining ARGS are passed to the
4207;; OPERATION."
4208;; (let ((inhibit-file-name-handlers
4209;; (list 'tramp-file-name-handler
4210;; 'efs-file-handler-function
4211;; 'ange-ftp-hook-function
4212;; (and (eq inhibit-file-name-operation operation)
4213;; inhibit-file-name-handlers)))
4214;; (inhibit-file-name-operation operation))
4215;; (apply operation args)))
4216 3967
4217;;;###autoload 3968;;;###autoload
4218(progn (defun tramp-run-real-handler (operation args) 3969(progn (defun tramp-run-real-handler (operation args)
@@ -4230,10 +3981,6 @@ pass to the OPERATION."
4230 (inhibit-file-name-operation operation)) 3981 (inhibit-file-name-operation operation))
4231 (apply operation args)))) 3982 (apply operation args))))
4232 3983
4233;; This function is used from `tramp-completion-file-name-handler' functions
4234;; only, if `tramp-completion-mode' is true. But this cannot be checked here
4235;; because the check is based on a full filename, not available for all
4236;; basic I/O operations.
4237;;;###autoload 3984;;;###autoload
4238(progn (defun tramp-completion-run-real-handler (operation args) 3985(progn (defun tramp-completion-run-real-handler (operation args)
4239 "Invoke `tramp-file-name-handler' for OPERATION. 3986 "Invoke `tramp-file-name-handler' for OPERATION.
@@ -4306,28 +4053,37 @@ ARGS are the arguments OPERATION has been called with."
4306 (nth 2 args)) 4053 (nth 2 args))
4307 ; BUF 4054 ; BUF
4308 ((member operation 4055 ((member operation
4309 (list 'make-auto-save-file-name 4056 (list 'set-visited-file-modtime 'verify-visited-file-modtime
4310 'set-visited-file-modtime 'verify-visited-file-modtime 4057 ; Emacs 22 only
4311 ; XEmacs only 4058 'make-auto-save-file-name
4059 ; XEmacs only
4312 'backup-buffer)) 4060 'backup-buffer))
4313 (buffer-file-name 4061 (buffer-file-name
4314 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) 4062 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
4315 ; COMMAND 4063 ; COMMAND
4316 ((member operation 4064 ((member operation
4317 (list 'dired-call-process 4065 (list ; not in Emacs 23
4066 'dired-call-process
4318 ; Emacs only 4067 ; Emacs only
4319 'shell-command 4068 'shell-command
4320 ; Emacs 22 only 4069 ; since Emacs 22 only
4321 'process-file 4070 'process-file
4071 ; since Emacs 23 only
4072 'start-file-process
4322 ; XEmacs only 4073 ; XEmacs only
4323 'dired-print-file 'dired-shell-call-process)) 4074 'dired-print-file 'dired-shell-call-process
4075 ; nowhere yet
4076 'executable-find 'start-process 'call-process))
4324 default-directory) 4077 default-directory)
4325 ; unknown file primitive 4078 ; unknown file primitive
4326 (t (error "unknown file I/O primitive: %s" operation)))) 4079 (t (error "unknown file I/O primitive: %s" operation))))
4327 4080
4328(defun tramp-find-foreign-file-name-handler (filename) 4081(defun tramp-find-foreign-file-name-handler (filename)
4329 "Return foreign file name handler if exists." 4082 "Return foreign file name handler if exists."
4330 (when (tramp-tramp-file-p filename) 4083 (when (and (stringp filename) (tramp-tramp-file-p filename)
4084 (or (not (tramp-completion-mode))
4085 (not (string-match
4086 tramp-completion-file-name-regexp filename))))
4331 (let (elt 4087 (let (elt
4332 res 4088 res
4333 (handler-alist tramp-foreign-file-name-handler-alist)) 4089 (handler-alist tramp-foreign-file-name-handler-alist))
@@ -4344,27 +4100,25 @@ ARGS are the arguments OPERATION has been called with."
4344(defun tramp-file-name-handler (operation &rest args) 4100(defun tramp-file-name-handler (operation &rest args)
4345 "Invoke Tramp file name handler. 4101 "Invoke Tramp file name handler.
4346Falls back to normal file name handler if no tramp file name handler exists." 4102Falls back to normal file name handler if no tramp file name handler exists."
4347;; (setq edebug-trace t)
4348;; (edebug-trace "%s" (with-output-to-string (backtrace)))
4349 (save-match-data 4103 (save-match-data
4350 (let* ((filename (apply 'tramp-file-name-for-operation operation args)) 4104 (let* ((filename (apply 'tramp-file-name-for-operation operation args))
4351 (completion (tramp-completion-mode filename)) 4105 (completion (tramp-completion-mode))
4352 (foreign (tramp-find-foreign-file-name-handler filename))) 4106 (foreign (tramp-find-foreign-file-name-handler filename)))
4353 (with-parsed-tramp-file-name filename nil 4107 (with-parsed-tramp-file-name filename nil
4354 (cond 4108 (cond
4355 ;; When we are in completion mode, some operations shouldn' be 4109 ;; When we are in completion mode, some operations shouldn't be
4356 ;; handled by backend. 4110 ;; handled by backend.
4357 ((and completion (memq operation '(expand-file-name)))
4358 (tramp-run-real-handler operation args))
4359 ((and completion (zerop (length localname)) 4111 ((and completion (zerop (length localname))
4360 (memq operation '(file-exists-p file-directory-p))) 4112 (memq operation '(file-exists-p file-directory-p)))
4361 t) 4113 t)
4114 ((and completion (zerop (length localname))
4115 (memq operation '(file-name-as-directory)))
4116 filename)
4362 ;; Call the backend function. 4117 ;; Call the backend function.
4363 (foreign (apply foreign operation args)) 4118 (foreign (apply foreign operation args))
4364 ;; Nothing to do for us. 4119 ;; Nothing to do for us.
4365 (t (tramp-run-real-handler operation args))))))) 4120 (t (tramp-run-real-handler operation args)))))))
4366 4121
4367
4368;; In Emacs, there is some concurrency due to timers. If a timer 4122;; In Emacs, there is some concurrency due to timers. If a timer
4369;; interrupts Tramp and wishes to use the same connection buffer as 4123;; interrupts Tramp and wishes to use the same connection buffer as
4370;; the "main" Emacs, then garbage might occur in the connection 4124;; the "main" Emacs, then garbage might occur in the connection
@@ -4396,7 +4150,7 @@ preventing reentrant calls of Tramp.")
4396 "Invoke remote-shell Tramp file name handler. 4150 "Invoke remote-shell Tramp file name handler.
4397Fall back to normal file name handler if no Tramp handler exists." 4151Fall back to normal file name handler if no Tramp handler exists."
4398 (when (and tramp-locked (not tramp-locker)) 4152 (when (and tramp-locked (not tramp-locker))
4399 (signal 'file-error "Forbidden reentrant call of Tramp")) 4153 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
4400 (let ((tl tramp-locked)) 4154 (let ((tl tramp-locked))
4401 (unwind-protect 4155 (unwind-protect
4402 (progn 4156 (progn
@@ -4415,6 +4169,11 @@ Fall back to normal file name handler if no Tramp handler exists."
4415Falls back to normal file name handler if no tramp file name handler exists." 4169Falls back to normal file name handler if no tramp file name handler exists."
4416;; (setq edebug-trace t) 4170;; (setq edebug-trace t)
4417;; (edebug-trace "%s" (with-output-to-string (backtrace))) 4171;; (edebug-trace "%s" (with-output-to-string (backtrace)))
4172
4173;; (mapcar 'trace-function-background
4174;; (mapcar 'intern
4175;; (all-completions "tramp-" obarray 'functionp)))
4176
4418 (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) 4177 (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
4419 (if fn 4178 (if fn
4420 (save-match-data (apply (cdr fn) args)) 4179 (save-match-data (apply (cdr fn) args))
@@ -4423,6 +4182,11 @@ Falls back to normal file name handler if no tramp file name handler exists."
4423;;;###autoload 4182;;;###autoload
4424(defsubst tramp-register-file-name-handler () 4183(defsubst tramp-register-file-name-handler ()
4425 "Add tramp file name handler to `file-name-handler-alist'." 4184 "Add tramp file name handler to `file-name-handler-alist'."
4185 ;; Remove autoloaded handler from file name handler alist. Useful,
4186 ;; if `tramp-syntax' has been changed.
4187 (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
4188 (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
4189 ;; Add the handler.
4426 (add-to-list 'file-name-handler-alist 4190 (add-to-list 'file-name-handler-alist
4427 (cons tramp-file-name-regexp 'tramp-file-name-handler)) 4191 (cons tramp-file-name-regexp 'tramp-file-name-handler))
4428 ;; If jka-compr is already loaded, move it to the front of 4192 ;; If jka-compr is already loaded, move it to the front of
@@ -4432,9 +4196,20 @@ Falls back to normal file name handler if no tramp file name handler exists."
4432 (setq file-name-handler-alist 4196 (setq file-name-handler-alist
4433 (cons jka (delete jka file-name-handler-alist)))))) 4197 (cons jka (delete jka file-name-handler-alist))))))
4434 4198
4199;; `tramp-file-name-handler' must be registered before evaluation of
4200;; site-start and init files, because there might exist remote files
4201;; already, f.e. files kept via recentf-mode.
4202;;;###autoload(tramp-register-file-name-handler)
4203(tramp-register-file-name-handler)
4204
4435;;;###autoload 4205;;;###autoload
4436(defsubst tramp-register-completion-file-name-handler () 4206(defsubst tramp-register-completion-file-name-handler ()
4437 "Add tramp completion file name handler to `file-name-handler-alist'." 4207 "Add tramp completion file name handler to `file-name-handler-alist'."
4208 ;; Remove autoloaded handler from file name handler alist. Useful,
4209 ;; if `tramp-syntax' has been changed.
4210 (let ((a1 (rassq
4211 'tramp-completion-file-name-handler file-name-handler-alist)))
4212 (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
4438 ;; `partial-completion-mode' is unknown in XEmacs. So we should 4213 ;; `partial-completion-mode' is unknown in XEmacs. So we should
4439 ;; load it unconditionally there. In the GNU Emacs case, method/ 4214 ;; load it unconditionally there. In the GNU Emacs case, method/
4440 ;; user/host name completion shall be bound to `partial-completion-mode'. 4215 ;; user/host name completion shall be bound to `partial-completion-mode'.
@@ -4452,17 +4227,12 @@ Falls back to normal file name handler if no tramp file name handler exists."
4452 (setq file-name-handler-alist 4227 (setq file-name-handler-alist
4453 (cons jka (delete jka file-name-handler-alist)))))) 4228 (cons jka (delete jka file-name-handler-alist))))))
4454 4229
4455;; `tramp-file-name-handler' must be registered before evaluation of
4456;; site-start and init files, because there might exist remote files
4457;; already, f.e. files kept via recentf-mode.
4458;;;###autoload(tramp-register-file-name-handler)
4459;; During autoload, it shall be checked whether 4230;; During autoload, it shall be checked whether
4460;; `partial-completion-mode' is active. Therefore registering of 4231;; `partial-completion-mode' is active. Therefore registering of
4461;; `tramp-completion-file-name-handler' will be delayed. 4232;; `tramp-completion-file-name-handler' will be delayed.
4462;;;###autoload(add-hook 4233;;;###autoload(add-hook
4463;;;###autoload 'after-init-hook 4234;;;###autoload 'after-init-hook
4464;;;###autoload '(lambda () (tramp-register-completion-file-name-handler))) 4235;;;###autoload '(lambda () (tramp-register-completion-file-name-handler)))
4465(tramp-register-file-name-handler)
4466(tramp-register-completion-file-name-handler) 4236(tramp-register-completion-file-name-handler)
4467 4237
4468;;;###autoload 4238;;;###autoload
@@ -4476,20 +4246,19 @@ Falls back to normal file name handler if no tramp file name handler exists."
4476 4246
4477(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers) 4247(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
4478 4248
4479
4480;;; Interactions with other packages: 4249;;; Interactions with other packages:
4481 4250
4482;; -- complete.el -- 4251;; -- complete.el --
4483 4252
4484;; This function contributed by Ed Sabol 4253;; This function contributed by Ed Sabol
4485(defun tramp-handle-expand-many-files (name) 4254(defun tramp-handle-expand-many-files (name)
4486 "Like `PC-expand-many-files' for tramp files." 4255 "Like `PC-expand-many-files' for Tramp files."
4487 (with-parsed-tramp-file-name name nil 4256 (with-parsed-tramp-file-name name nil
4488 (save-match-data 4257 (save-match-data
4489 (if (or (string-match "\\*" name) 4258 (if (or (string-match "\\*" name)
4490 (string-match "\\?" name) 4259 (string-match "\\?" name)
4491 (string-match "\\[.*\\]" name)) 4260 (string-match "\\[.*\\]" name))
4492 (save-excursion 4261 (progn
4493 (let (bufstr) 4262 (let (bufstr)
4494 ;; CCC: To do it right, we should quote certain characters 4263 ;; CCC: To do it right, we should quote certain characters
4495 ;; in the file name, but since the echo command is going to 4264 ;; in the file name, but since the echo command is going to
@@ -4499,37 +4268,34 @@ Falls back to normal file name handler if no tramp file name handler exists."
4499 ;;- (set-difference tramp-file-name-quote-list 4268 ;;- (set-difference tramp-file-name-quote-list
4500 ;;- '(?\* ?\? ?[ ?])))) 4269 ;;- '(?\* ?\? ?[ ?]))))
4501 ;;- (tramp-send-command 4270 ;;- (tramp-send-command
4502 ;;- multi-method method user host 4271 ;;- method user host
4503 ;;- (format "echo %s" (comint-quote-filename localname))) 4272 ;;- (format "echo %s" (comint-quote-filename localname))))
4504 ;;- (tramp-wait-for-output)) 4273 (tramp-send-command v (format "echo %s" localname))
4505 (tramp-send-command multi-method method user host
4506 (format "echo %s" localname))
4507 (tramp-wait-for-output)
4508 (setq bufstr (buffer-substring (point-min) 4274 (setq bufstr (buffer-substring (point-min)
4509 (tramp-line-end-position))) 4275 (tramp-line-end-position)))
4510 (goto-char (point-min)) 4276 (with-current-buffer (tramp-get-buffer v)
4511 (if (string-equal localname bufstr)
4512 nil
4513 (insert "(\"")
4514 (while (search-forward " " nil t)
4515 (delete-backward-char 1)
4516 (insert "\" \""))
4517 (goto-char (point-max))
4518 (delete-backward-char 1)
4519 (insert "\")")
4520 (goto-char (point-min)) 4277 (goto-char (point-min))
4521 (mapcar 4278 (if (string-equal localname bufstr)
4522 (function (lambda (x) 4279 nil
4523 (tramp-make-tramp-file-name multi-method method 4280 (insert "(\"")
4524 user host x))) 4281 (while (search-forward " " nil t)
4525 (read (current-buffer)))))) 4282 (delete-backward-char 1)
4283 (insert "\" \""))
4284 (goto-char (point-max))
4285 (delete-backward-char 1)
4286 (insert "\")")
4287 (goto-char (point-min))
4288 (mapcar
4289 (function (lambda (x)
4290 (tramp-make-tramp-file-name method user host x)))
4291 (read (current-buffer)))))))
4526 (list (expand-file-name name)))))) 4292 (list (expand-file-name name))))))
4527 4293
4528(eval-after-load "complete" 4294(eval-after-load "complete"
4529 '(progn 4295 '(progn
4530 (defadvice PC-expand-many-files 4296 (defadvice PC-expand-many-files
4531 (around tramp-advice-PC-expand-many-files (name) activate) 4297 (around tramp-advice-PC-expand-many-files (name) activate)
4532 "Invoke `tramp-handle-expand-many-files' for tramp files." 4298 "Invoke `tramp-handle-expand-many-files' for Tramp files."
4533 (if (tramp-tramp-file-p name) 4299 (if (tramp-tramp-file-p name)
4534 (setq ad-return-value (tramp-handle-expand-many-files name)) 4300 (setq ad-return-value (tramp-handle-expand-many-files name))
4535 ad-do-it)) 4301 ad-do-it))
@@ -4538,142 +4304,118 @@ Falls back to normal file name handler if no tramp file name handler exists."
4538 4304
4539;;; File name handler functions for completion mode 4305;;; File name handler functions for completion mode
4540 4306
4541(defvar tramp-completion-mode nil
4542 "If non-nil, we are in file name completion mode.")
4543
4544;; Necessary because `tramp-file-name-regexp-unified' and 4307;; Necessary because `tramp-file-name-regexp-unified' and
4545;; `tramp-completion-file-name-regexp-unified' aren't different. 4308;; `tramp-completion-file-name-regexp-unified' aren't different. If
4546;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to 4309;; nil, `tramp-completion-run-real-handler' is called (i.e. forwarding
4547;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'. 4310;; to `tramp-file-name-handler'). Otherwise, it takes
4548;; Using `last-input-event' is a little bit risky, because completing a file 4311;; `tramp-run-real-handler'. Using `last-input-event' is a little bit
4549;; might require loading other files, like "~/.netrc", and for them it 4312;; risky, because completing a file might require loading other files,
4550;; shouldn't be decided based on that variable. On the other hand, those files 4313;; like "~/.netrc", and for them it shouldn't be decided based on that
4551;; shouldn't have partial tramp file name syntax. Maybe another variable should 4314;; variable. On the other hand, those files shouldn't have partial
4552;; be introduced overwriting this check in such cases. Or we change tramp 4315;; tramp file name syntax. Maybe another variable should be introduced
4553;; file name syntax in order to avoid ambiguities, like in XEmacs ... 4316;; overwriting this check in such cases. Or we change tramp file name
4554;; In case of non unified file names it can be always true (and wouldn't be 4317;; syntax in order to avoid ambiguities, like in XEmacs ...
4555;; necessary, because there are different regexp). 4318(defun tramp-completion-mode ()
4556(defun tramp-completion-mode (file)
4557 "Checks whether method / user name / host name completion is active." 4319 "Checks whether method / user name / host name completion is active."
4558 (cond 4320 (or (equal last-input-event 'tab)
4559 (tramp-completion-mode t) 4321 ;; Emacs
4560 ((string-match "^/.*:.*:$" file) nil) 4322 (and (natnump last-input-event)
4561 ((string-match 4323 (or
4562 (concat tramp-prefix-regexp 4324 ;; ?\t has event-modifier 'control
4563 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp "$") 4325 (char-equal last-input-event ?\t)
4564 file) 4326 (and (not (event-modifiers last-input-event))
4565 (member (match-string 1 file) (mapcar 'car tramp-methods))) 4327 (or (char-equal last-input-event ?\?)
4566 ((or (equal last-input-event 'tab) 4328 (char-equal last-input-event ?\ )))))
4567 ;; Emacs 4329 ;; XEmacs
4568 (and (natnump last-input-event) 4330 (and (featurep 'xemacs)
4569 (or 4331 ;; `last-input-event' might be nil.
4570 ;; ?\t has event-modifier 'control 4332 (not (null last-input-event))
4571 (char-equal last-input-event ?\t) 4333 ;; `last-input-event' may have no character approximation.
4572 (and (not (event-modifiers last-input-event)) 4334 (funcall (symbol-function 'event-to-character) last-input-event)
4573 (or (char-equal last-input-event ?\?) 4335 (or
4574 (char-equal last-input-event ?\ ))))) 4336 ;; ?\t has event-modifier 'control
4575 ;; XEmacs 4337 (char-equal
4576 (and (featurep 'xemacs) 4338 (funcall (symbol-function 'event-to-character)
4577 ;; `last-input-event' might be nil. 4339 last-input-event) ?\t)
4578 (not (null last-input-event)) 4340 (and (not (event-modifiers last-input-event))
4579 ;; `last-input-event' may have no character approximation. 4341 (or (char-equal
4580 (funcall (symbol-function 'event-to-character) last-input-event) 4342 (funcall (symbol-function 'event-to-character)
4581 (or 4343 last-input-event) ?\?)
4582 ;; ?\t has event-modifier 'control 4344 (char-equal
4583 (char-equal 4345 (funcall (symbol-function 'event-to-character)
4584 (funcall (symbol-function 'event-to-character) 4346 last-input-event) ?\ )))))))
4585 last-input-event) ?\t)
4586 (and (not (event-modifiers last-input-event))
4587 (or (char-equal
4588 (funcall (symbol-function 'event-to-character)
4589 last-input-event) ?\?)
4590 (char-equal
4591 (funcall (symbol-function 'event-to-character)
4592 last-input-event) ?\ ))))))
4593 t)))
4594 4347
4595;; Method, host name and user name completion. 4348;; Method, host name and user name completion.
4596;; `tramp-completion-dissect-file-name' returns a list of 4349;; `tramp-completion-dissect-file-name' returns a list of
4597;; tramp-file-name structures. For all of them we return possible completions. 4350;; tramp-file-name structures. For all of them we return possible completions.
4598;;;###autoload 4351;;;###autoload
4599(defun tramp-completion-handle-file-name-all-completions (filename directory) 4352(defun tramp-completion-handle-file-name-all-completions (filename directory)
4600 "Like `file-name-all-completions' for partial tramp files." 4353 "Like `file-name-all-completions' for partial Tramp files."
4601 4354
4602 (unwind-protect 4355 (let* ((fullname (tramp-drop-volume-letter
4603 ;; We need to reset `tramp-completion-mode'. 4356 (expand-file-name filename directory)))
4604 (progn 4357 ;; Possible completion structures.
4605 (setq tramp-completion-mode t) 4358 (v (tramp-completion-dissect-file-name fullname))
4606 (let* 4359 result result1)
4607 ((fullname (concat directory filename)) 4360
4608 ;; possible completion structures 4361 (while v
4609 (v (tramp-completion-dissect-file-name fullname)) 4362 (let* ((car (car v))
4610 result result1) 4363 (method (tramp-file-name-method car))
4611 4364 (user (tramp-file-name-user car))
4612 (while v 4365 (host (tramp-file-name-host car))
4613 (let* ((car (car v)) 4366 (localname (tramp-file-name-localname car))
4614 (multi-method (tramp-file-name-multi-method car)) 4367 (m (tramp-find-method method user host))
4615 (method (tramp-file-name-method car)) 4368 (tramp-current-user user) ; see `tramp-parse-passwd'
4616 (user (tramp-file-name-user car)) 4369 all-user-hosts)
4617 (host (tramp-file-name-host car)) 4370
4618 (localname (tramp-file-name-localname car)) 4371 (unless localname ;; Nothing to complete.
4619 (m (tramp-find-method multi-method method user host)) 4372
4620 (tramp-current-user user) ; see `tramp-parse-passwd' 4373 (if (or user host)
4621 all-user-hosts) 4374
4622 4375 ;; Method dependent user / host combinations.
4623 (unless (or multi-method ;; Not handled (yet). 4376 (progn
4624 localname) ;; Nothing to complete 4377 (mapcar
4625 4378 (lambda (x)
4626 (if (or user host) 4379 (setq all-user-hosts
4627 4380 (append all-user-hosts
4628 ;; Method dependent user / host combinations 4381 (funcall (nth 0 x) (nth 1 x)))))
4629 (progn 4382 (tramp-get-completion-function m))
4630 (mapcar 4383
4631 (lambda (x) 4384 (setq result (append result
4632 (setq all-user-hosts 4385 (mapcar
4633 (append all-user-hosts 4386 (lambda (x)
4634 (funcall (nth 0 x) (nth 1 x))))) 4387 (tramp-get-completion-user-host
4635 (tramp-get-completion-function m)) 4388 method user host (nth 0 x) (nth 1 x)))
4636 4389 (delq nil all-user-hosts)))))
4637 (setq result (append result 4390
4638 (mapcar 4391 ;; Possible methods.
4639 (lambda (x) 4392 (setq result
4640 (tramp-get-completion-user-host 4393 (append result (tramp-get-completion-methods m)))))
4641 method user host (nth 0 x) (nth 1 x))) 4394
4642 (delq nil all-user-hosts))))) 4395 (setq v (cdr v))))
4643 4396
4644 ;; Possible methods 4397 ;; Unify list, remove nil elements.
4645 (setq result 4398 (while result
4646 (append result (tramp-get-completion-methods m))))) 4399 (let ((car (car result)))
4647 4400 (when car
4648 (setq v (cdr v)))) 4401 (add-to-list
4649 4402 'result1
4650 ;; unify list, remove nil elements 4403 (substring car (length (tramp-drop-volume-letter directory)))))
4651 (while result 4404 (setq result (cdr result))))
4652 (let ((car (car result))) 4405
4653 (when car (add-to-list 4406 ;; Complete local parts.
4654 'result1 (substring car (length directory)))) 4407 (append
4655 (setq result (cdr result)))) 4408 result1
4656 4409 (condition-case nil
4657 ;; Complete local parts 4410 (tramp-completion-run-real-handler
4658 (append 4411 'file-name-all-completions (list filename directory))
4659 result1 4412 (error nil)))))
4660 (condition-case nil
4661 (if result1
4662 ;; "/ssh:" does not need to be expanded as hostname.
4663 (tramp-run-real-handler
4664 'file-name-all-completions (list filename directory))
4665 ;; No method/user/host found to be expanded.
4666 (tramp-completion-run-real-handler
4667 'file-name-all-completions (list filename directory)))
4668 (error nil)))))
4669 ;; unwindform
4670 (setq tramp-completion-mode nil)))
4671 4413
4672;; Method, host name and user name completion for a file. 4414;; Method, host name and user name completion for a file.
4673;;;###autoload 4415;;;###autoload
4674(defun tramp-completion-handle-file-name-completion 4416(defun tramp-completion-handle-file-name-completion
4675 (filename directory &optional predicate) 4417 (filename directory &optional predicate)
4676 "Like `file-name-completion' for tramp files." 4418 "Like `file-name-completion' for Tramp files."
4677 (try-completion 4419 (try-completion
4678 filename 4420 filename
4679 (mapcar 'list (file-name-all-completions filename directory)) 4421 (mapcar 'list (file-name-all-completions filename directory))
@@ -4683,26 +4425,26 @@ Falls back to normal file name handler if no tramp file name handler exists."
4683;; I misuse a little bit the tramp-file-name structure in order to handle 4425;; I misuse a little bit the tramp-file-name structure in order to handle
4684;; completion possibilities for partial methods / user names / host names. 4426;; completion possibilities for partial methods / user names / host names.
4685;; Return value is a list of tramp-file-name structures according to possible 4427;; Return value is a list of tramp-file-name structures according to possible
4686;; completions. If "multi-method" or "localname" is non-nil it means there 4428;; completions. If "localname" is non-nil it means there
4687;; shouldn't be a completion anymore. 4429;; shouldn't be a completion anymore.
4688 4430
4689;; Expected results: 4431;; Expected results:
4690 4432
4691;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y" 4433;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
4692;; [nil nil nil "x" nil] [nil nil "x" nil nil] [nil nil "x" "y" nil] 4434;; [nil nil "x" nil] [nil "x" nil nil] [nil "x" "y" nil]
4693;; [nil nil "x" nil nil] 4435;; [nil "x" nil nil]
4694;; [nil "x" nil nil nil] 4436;; ["x" nil nil nil]
4695 4437
4696;; "/x:" "/x:y" "/x:y:" 4438;; "/x:" "/x:y" "/x:y:"
4697;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""] 4439;; [nil nil "x" ""] [nil nil "x" "y"] ["x" nil "y" ""]
4698;; "/[x/" "/[x/y" 4440;; "/[x/" "/[x/y"
4699;; [nil "x" nil "" nil] [nil "x" nil "y" nil] 4441;; ["x" nil "" nil] ["x" nil "y" nil]
4700;; [nil "x" "" nil nil] [nil "x" "y" nil nil] 4442;; ["x" "" nil nil] ["x" "y" nil nil]
4701 4443
4702;; "/x:y@" "/x:y@z" "/x:y@z:" 4444;; "/x:y@" "/x:y@z" "/x:y@z:"
4703;; [nil nil nil "x" "y@"] [nil nil nil "x" "y@z"] [nil "x" "y" "z" ""] 4445;; [nil nil "x" "y@"] [nil nil "x" "y@z"] ["x" "y" "z" ""]
4704;; "/[x/y@" "/[x/y@z" 4446;; "/[x/y@" "/[x/y@z"
4705;; [nil "x" nil "y" nil] [nil "x" "y" "z" nil] 4447;; ["x" nil "y" nil] ["x" "y" "z" nil]
4706(defun tramp-completion-dissect-file-name (name) 4448(defun tramp-completion-dissect-file-name (name)
4707 "Returns a list of `tramp-file-name' structures. 4449 "Returns a list of `tramp-file-name' structures.
4708They are collected by `tramp-completion-dissect-file-name1'." 4450They are collected by `tramp-completion-dissect-file-name1'."
@@ -4727,25 +4469,49 @@ They are collected by `tramp-completion-dissect-file-name1'."
4727 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp 4469 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
4728 "\\(" tramp-host-regexp x-nil "\\)$") 4470 "\\(" tramp-host-regexp x-nil "\\)$")
4729 nil 1 2 nil)) 4471 nil 1 2 nil))
4730 ;; "/method:user" "/[method/user" 4472 ;; "/method:user" "/[method/user" "/method://user"
4731 (tramp-completion-file-name-structure5 4473 (tramp-completion-file-name-structure5
4732 (list (concat tramp-prefix-regexp 4474 (list (concat tramp-prefix-regexp
4733 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp 4475 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
4734 "\\(" tramp-user-regexp x-nil "\\)$") 4476 "\\(" tramp-user-regexp x-nil "\\)$")
4735 1 2 nil nil)) 4477 1 2 nil nil))
4736 ;; "/method:host" "/[method/host" 4478 ;; "/method:host" "/[method/host" "/method://host"
4737 (tramp-completion-file-name-structure6 4479 (tramp-completion-file-name-structure6
4738 (list (concat tramp-prefix-regexp 4480 (list (concat tramp-prefix-regexp
4739 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp 4481 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
4740 "\\(" tramp-host-regexp x-nil "\\)$") 4482 "\\(" tramp-host-regexp x-nil "\\)$")
4741 1 nil 2 nil)) 4483 1 nil 2 nil))
4742 ;; "/method:user@host" "/[method/user@host" 4484 ;; "/method:user@host" "/[method/user@host" "/method://user@host"
4743 (tramp-completion-file-name-structure7 4485 (tramp-completion-file-name-structure7
4744 (list (concat tramp-prefix-regexp 4486 (list (concat tramp-prefix-regexp
4745 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp 4487 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
4746 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp 4488 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
4747 "\\(" tramp-host-regexp x-nil "\\)$") 4489 "\\(" tramp-host-regexp x-nil "\\)$")
4748 1 2 3 nil))) 4490 1 2 3 nil))
4491 ;; "/method: "/method:/"
4492 (tramp-completion-file-name-structure8
4493 (list
4494 (if (equal tramp-syntax 'url)
4495 (concat tramp-prefix-regexp
4496 "\\(" tramp-method-regexp "\\)"
4497 "\\(" (substring tramp-postfix-method-regexp 0 1)
4498 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
4499 "\\(" "\\)$")
4500 ;; Should not match if not URL syntax.
4501 (concat tramp-prefix-regexp "/$"))
4502 1 3 nil nil))
4503 ;; "/method: "/method:/"
4504 (tramp-completion-file-name-structure9
4505 (list
4506 (if (equal tramp-syntax 'url)
4507 (concat tramp-prefix-regexp
4508 "\\(" tramp-method-regexp "\\)"
4509 "\\(" (substring tramp-postfix-method-regexp 0 1)
4510 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
4511 "\\(" "\\)$")
4512 ;; Should not match if not URL syntax.
4513 (concat tramp-prefix-regexp "/$"))
4514 1 nil 3 nil)))
4749 4515
4750 (mapcar (lambda (regexp) 4516 (mapcar (lambda (regexp)
4751 (add-to-list 'result 4517 (add-to-list 'result
@@ -4758,30 +4524,28 @@ They are collected by `tramp-completion-dissect-file-name1'."
4758 tramp-completion-file-name-structure5 4524 tramp-completion-file-name-structure5
4759 tramp-completion-file-name-structure6 4525 tramp-completion-file-name-structure6
4760 tramp-completion-file-name-structure7 4526 tramp-completion-file-name-structure7
4527 tramp-completion-file-name-structure8
4528 tramp-completion-file-name-structure9
4761 tramp-file-name-structure)) 4529 tramp-file-name-structure))
4762 4530
4763 (delq nil result))) 4531 (delq nil result)))
4764 4532
4765(defun tramp-completion-dissect-file-name1 (structure name) 4533(defun tramp-completion-dissect-file-name1 (structure name)
4766 "Returns a `tramp-file-name' structure matching STRUCTURE. 4534 "Returns a `tramp-file-name' structure matching STRUCTURE.
4767The structure consists of multi-method, remote method, remote user, 4535The structure consists of remote method, remote user,
4768remote host and localname (filename on remote host)." 4536remote host and localname (filename on remote host)."
4769 4537
4770 (let (method) 4538 (save-match-data
4771 (save-match-data 4539 (when (string-match (nth 0 structure) name)
4772 (when (string-match (nth 0 structure) name) 4540 (let ((method (and (nth 1 structure)
4773 (setq method (and (nth 1 structure) 4541 (match-string (nth 1 structure) name)))
4774 (match-string (nth 1 structure) name))) 4542 (user (and (nth 2 structure)
4775 (if (and method (member method tramp-multi-methods)) 4543 (match-string (nth 2 structure) name)))
4776 ;; Not handled (yet). 4544 (host (and (nth 3 structure)
4777 (vector method nil nil nil nil) 4545 (match-string (nth 3 structure) name)))
4778 (let ((user (and (nth 2 structure) 4546 (localname (and (nth 4 structure)
4779 (match-string (nth 2 structure) name))) 4547 (match-string (nth 4 structure) name))))
4780 (host (and (nth 3 structure) 4548 (vector method user host localname)))))
4781 (match-string (nth 3 structure) name)))
4782 (localname (and (nth 4 structure)
4783 (match-string (nth 4 structure) name))))
4784 (vector nil method user host localname)))))))
4785 4549
4786;; This function returns all possible method completions, adding the 4550;; This function returns all possible method completions, adding the
4787;; trailing method delimeter. 4551;; trailing method delimeter.
@@ -4791,8 +4555,8 @@ remote host and localname (filename on remote host)."
4791 (lambda (method) 4555 (lambda (method)
4792 (and method 4556 (and method
4793 (string-match (concat "^" (regexp-quote partial-method)) method) 4557 (string-match (concat "^" (regexp-quote partial-method)) method)
4794 (tramp-make-tramp-file-name nil method nil nil nil))) 4558 (tramp-completion-make-tramp-file-name method nil nil nil)))
4795 (delete "multi" (mapcar 'car tramp-methods)))) 4559 (mapcar 'car tramp-methods)))
4796 4560
4797;; Compares partial user and host names with possible completions. 4561;; Compares partial user and host names with possible completions.
4798(defun tramp-get-completion-user-host (method partial-user partial-host user host) 4562(defun tramp-get-completion-user-host (method partial-user partial-host user host)
@@ -4824,13 +4588,15 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
4824 host nil))) 4588 host nil)))
4825 4589
4826 (unless (zerop (+ (length user) (length host))) 4590 (unless (zerop (+ (length user) (length host)))
4827 (tramp-make-tramp-file-name nil method user host nil))) 4591 (tramp-completion-make-tramp-file-name method user host nil)))
4828 4592
4829(defun tramp-parse-rhosts (filename) 4593(defun tramp-parse-rhosts (filename)
4830 "Return a list of (user host) tuples allowed to access. 4594 "Return a list of (user host) tuples allowed to access.
4831Either user or host may be nil." 4595Either user or host may be nil."
4832 4596 ;; On Windows, there are problems in completion when
4833 (let (res) 4597 ;; `default-directory' is remote.
4598 (let ((default-directory (tramp-temporary-file-directory))
4599 res)
4834 (when (file-readable-p filename) 4600 (when (file-readable-p filename)
4835 (with-temp-buffer 4601 (with-temp-buffer
4836 (insert-file-contents filename) 4602 (insert-file-contents filename)
@@ -4839,24 +4605,15 @@ Either user or host may be nil."
4839 (push (tramp-parse-rhosts-group) res)))) 4605 (push (tramp-parse-rhosts-group) res))))
4840 res)) 4606 res))
4841 4607
4842;; Taken from gnus/netrc.el
4843(eval-and-compile
4844 (defalias 'tramp-point-at-eol
4845 (if (fboundp 'point-at-eol)
4846 'point-at-eol
4847 'line-end-position)))
4848
4849(defun tramp-parse-rhosts-group () 4608(defun tramp-parse-rhosts-group ()
4850 "Return a (user host) tuple allowed to access. 4609 "Return a (user host) tuple allowed to access.
4851Either user or host may be nil." 4610Either user or host may be nil."
4852
4853 (let ((result) 4611 (let ((result)
4854 (regexp 4612 (regexp
4855 (concat 4613 (concat
4856 "^\\(" tramp-host-regexp "\\)" 4614 "^\\(" tramp-host-regexp "\\)"
4857 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) 4615 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
4858 4616 (narrow-to-region (point) (tramp-line-end-position))
4859 (narrow-to-region (point) (tramp-point-at-eol))
4860 (when (re-search-forward regexp nil t) 4617 (when (re-search-forward regexp nil t)
4861 (setq result (append (list (match-string 3) (match-string 1))))) 4618 (setq result (append (list (match-string 3) (match-string 1)))))
4862 (widen) 4619 (widen)
@@ -4866,8 +4623,10 @@ Either user or host may be nil."
4866(defun tramp-parse-shosts (filename) 4623(defun tramp-parse-shosts (filename)
4867 "Return a list of (user host) tuples allowed to access. 4624 "Return a list of (user host) tuples allowed to access.
4868User is always nil." 4625User is always nil."
4869 4626 ;; On Windows, there are problems in completion when
4870 (let (res) 4627 ;; `default-directory' is remote.
4628 (let ((default-directory (tramp-temporary-file-directory))
4629 res)
4871 (when (file-readable-p filename) 4630 (when (file-readable-p filename)
4872 (with-temp-buffer 4631 (with-temp-buffer
4873 (insert-file-contents filename) 4632 (insert-file-contents filename)
@@ -4879,11 +4638,9 @@ User is always nil."
4879(defun tramp-parse-shosts-group () 4638(defun tramp-parse-shosts-group ()
4880 "Return a (user host) tuple allowed to access. 4639 "Return a (user host) tuple allowed to access.
4881User is always nil." 4640User is always nil."
4882
4883 (let ((result) 4641 (let ((result)
4884 (regexp (concat "^\\(" tramp-host-regexp "\\)"))) 4642 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
4885 4643 (narrow-to-region (point) (tramp-line-end-position))
4886 (narrow-to-region (point) (tramp-point-at-eol))
4887 (when (re-search-forward regexp nil t) 4644 (when (re-search-forward regexp nil t)
4888 (setq result (list nil (match-string 1)))) 4645 (setq result (list nil (match-string 1))))
4889 (widen) 4646 (widen)
@@ -4895,8 +4652,10 @@ User is always nil."
4895(defun tramp-parse-sconfig (filename) 4652(defun tramp-parse-sconfig (filename)
4896 "Return a list of (user host) tuples allowed to access. 4653 "Return a list of (user host) tuples allowed to access.
4897User is always nil." 4654User is always nil."
4898 4655 ;; On Windows, there are problems in completion when
4899 (let (res) 4656 ;; `default-directory' is remote.
4657 (let ((default-directory (tramp-temporary-file-directory))
4658 res)
4900 (when (file-readable-p filename) 4659 (when (file-readable-p filename)
4901 (with-temp-buffer 4660 (with-temp-buffer
4902 (insert-file-contents filename) 4661 (insert-file-contents filename)
@@ -4908,11 +4667,9 @@ User is always nil."
4908(defun tramp-parse-sconfig-group () 4667(defun tramp-parse-sconfig-group ()
4909 "Return a (user host) tuple allowed to access. 4668 "Return a (user host) tuple allowed to access.
4910User is always nil." 4669User is always nil."
4911
4912 (let ((result) 4670 (let ((result)
4913 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)"))) 4671 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
4914 4672 (narrow-to-region (point) (tramp-line-end-position))
4915 (narrow-to-region (point) (tramp-point-at-eol))
4916 (when (re-search-forward regexp nil t) 4673 (when (re-search-forward regexp nil t)
4917 (setq result (list nil (match-string 1)))) 4674 (setq result (list nil (match-string 1))))
4918 (widen) 4675 (widen)
@@ -4924,11 +4681,12 @@ User is always nil."
4924(defun tramp-parse-shostkeys (dirname) 4681(defun tramp-parse-shostkeys (dirname)
4925 "Return a list of (user host) tuples allowed to access. 4682 "Return a list of (user host) tuples allowed to access.
4926User is always nil." 4683User is always nil."
4927 4684 ;; On Windows, there are problems in completion when
4928 (let ((regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")) 4685 ;; `default-directory' is remote.
4929 (files (when (file-directory-p dirname) (directory-files dirname))) 4686 (let* ((default-directory (tramp-temporary-file-directory))
4930 result) 4687 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
4931 4688 (files (when (file-directory-p dirname) (directory-files dirname)))
4689 result)
4932 (while files 4690 (while files
4933 (when (string-match regexp (car files)) 4691 (when (string-match regexp (car files))
4934 (push (list nil (match-string 1 (car files))) result)) 4692 (push (list nil (match-string 1 (car files))) result))
@@ -4938,12 +4696,13 @@ User is always nil."
4938(defun tramp-parse-sknownhosts (dirname) 4696(defun tramp-parse-sknownhosts (dirname)
4939 "Return a list of (user host) tuples allowed to access. 4697 "Return a list of (user host) tuples allowed to access.
4940User is always nil." 4698User is always nil."
4941 4699 ;; On Windows, there are problems in completion when
4942 (let ((regexp (concat "^\\(" tramp-host-regexp 4700 ;; `default-directory' is remote.
4943 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")) 4701 (let* ((default-directory (tramp-temporary-file-directory))
4944 (files (when (file-directory-p dirname) (directory-files dirname))) 4702 (regexp (concat "^\\(" tramp-host-regexp
4945 result) 4703 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
4946 4704 (files (when (file-directory-p dirname) (directory-files dirname)))
4705 result)
4947 (while files 4706 (while files
4948 (when (string-match regexp (car files)) 4707 (when (string-match regexp (car files))
4949 (push (list nil (match-string 1 (car files))) result)) 4708 (push (list nil (match-string 1 (car files))) result))
@@ -4953,8 +4712,10 @@ User is always nil."
4953(defun tramp-parse-hosts (filename) 4712(defun tramp-parse-hosts (filename)
4954 "Return a list of (user host) tuples allowed to access. 4713 "Return a list of (user host) tuples allowed to access.
4955User is always nil." 4714User is always nil."
4956 4715 ;; On Windows, there are problems in completion when
4957 (let (res) 4716 ;; `default-directory' is remote.
4717 (let ((default-directory (tramp-temporary-file-directory))
4718 res)
4958 (when (file-readable-p filename) 4719 (when (file-readable-p filename)
4959 (with-temp-buffer 4720 (with-temp-buffer
4960 (insert-file-contents filename) 4721 (insert-file-contents filename)
@@ -4966,11 +4727,9 @@ User is always nil."
4966(defun tramp-parse-hosts-group () 4727(defun tramp-parse-hosts-group ()
4967 "Return a (user host) tuple allowed to access. 4728 "Return a (user host) tuple allowed to access.
4968User is always nil." 4729User is always nil."
4969
4970 (let ((result) 4730 (let ((result)
4971 (regexp (concat "^\\(" tramp-host-regexp "\\)"))) 4731 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
4972 4732 (narrow-to-region (point) (tramp-line-end-position))
4973 (narrow-to-region (point) (tramp-point-at-eol))
4974 (when (re-search-forward regexp nil t) 4733 (when (re-search-forward regexp nil t)
4975 (unless (char-equal (or (char-after) ?\n) ?:) ; no IPv6 4734 (unless (char-equal (or (char-after) ?\n) ?:) ; no IPv6
4976 (setq result (list nil (match-string 1))))) 4735 (setq result (list nil (match-string 1)))))
@@ -4982,13 +4741,15 @@ User is always nil."
4982 4741
4983;; For su-alike methods it would be desirable to return "root@localhost" 4742;; For su-alike methods it would be desirable to return "root@localhost"
4984;; as default. Unfortunately, we have no information whether any user name 4743;; as default. Unfortunately, we have no information whether any user name
4985;; has been typed already. So we (mis-)use tramp-current-user as indication, 4744;; has been typed already. So we use `tramp-current-user' as indication,
4986;; assuming it is set in `tramp-completion-handle-file-name-all-completions'. 4745;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
4987(defun tramp-parse-passwd (filename) 4746(defun tramp-parse-passwd (filename)
4988 "Return a list of (user host) tuples allowed to access. 4747 "Return a list of (user host) tuples allowed to access.
4989Host is always \"localhost\"." 4748Host is always \"localhost\"."
4990 4749 ;; On Windows, there are problems in completion when
4991 (let (res) 4750 ;; `default-directory' is remote.
4751 (let ((default-directory (tramp-temporary-file-directory))
4752 res)
4992 (if (zerop (length tramp-current-user)) 4753 (if (zerop (length tramp-current-user))
4993 '(("root" nil)) 4754 '(("root" nil))
4994 (when (file-readable-p filename) 4755 (when (file-readable-p filename)
@@ -5002,11 +4763,9 @@ Host is always \"localhost\"."
5002(defun tramp-parse-passwd-group () 4763(defun tramp-parse-passwd-group ()
5003 "Return a (user host) tuple allowed to access. 4764 "Return a (user host) tuple allowed to access.
5004Host is always \"localhost\"." 4765Host is always \"localhost\"."
5005
5006 (let ((result) 4766 (let ((result)
5007 (regexp (concat "^\\(" tramp-user-regexp "\\):"))) 4767 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
5008 4768 (narrow-to-region (point) (tramp-line-end-position))
5009 (narrow-to-region (point) (tramp-point-at-eol))
5010 (when (re-search-forward regexp nil t) 4769 (when (re-search-forward regexp nil t)
5011 (setq result (list (match-string 1) "localhost"))) 4770 (setq result (list (match-string 1) "localhost")))
5012 (widen) 4771 (widen)
@@ -5016,8 +4775,10 @@ Host is always \"localhost\"."
5016(defun tramp-parse-netrc (filename) 4775(defun tramp-parse-netrc (filename)
5017 "Return a list of (user host) tuples allowed to access. 4776 "Return a list of (user host) tuples allowed to access.
5018User may be nil." 4777User may be nil."
5019 4778 ;; On Windows, there are problems in completion when
5020 (let (res) 4779 ;; `default-directory' is remote.
4780 (let ((default-directory (tramp-temporary-file-directory))
4781 res)
5021 (when (file-readable-p filename) 4782 (when (file-readable-p filename)
5022 (with-temp-buffer 4783 (with-temp-buffer
5023 (insert-file-contents filename) 4784 (insert-file-contents filename)
@@ -5029,49 +4790,63 @@ User may be nil."
5029(defun tramp-parse-netrc-group () 4790(defun tramp-parse-netrc-group ()
5030 "Return a (user host) tuple allowed to access. 4791 "Return a (user host) tuple allowed to access.
5031User may be nil." 4792User may be nil."
5032
5033 (let ((result) 4793 (let ((result)
5034 (regexp 4794 (regexp
5035 (concat 4795 (concat
5036 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)" 4796 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
5037 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) 4797 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
5038 4798 (narrow-to-region (point) (tramp-line-end-position))
5039 (narrow-to-region (point) (tramp-point-at-eol))
5040 (when (re-search-forward regexp nil t) 4799 (when (re-search-forward regexp nil t)
5041 (setq result (list (match-string 3) (match-string 1)))) 4800 (setq result (list (match-string 3) (match-string 1))))
5042 (widen) 4801 (widen)
5043 (forward-line 1) 4802 (forward-line 1)
5044 result)) 4803 result))
5045 4804
4805(defun tramp-parse-putty (registry)
4806 "Return a list of (user host) tuples allowed to access.
4807User is always nil."
4808 ;; On Windows, there are problems in completion when
4809 ;; `default-directory' is remote.
4810 (let ((default-directory (tramp-temporary-file-directory))
4811 res)
4812 (with-temp-buffer
4813 (when (zerop (call-process "reg" nil t nil "query" registry))
4814 (goto-char (point-min))
4815 (while (not (eobp))
4816 (push (tramp-parse-putty-group registry) res))))
4817 res))
4818
4819(defun tramp-parse-putty-group (registry)
4820 "Return a (user host) tuple allowed to access.
4821User is always nil."
4822 (let ((result)
4823 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
4824 (narrow-to-region (point) (tramp-line-end-position))
4825 (when (re-search-forward regexp nil t)
4826 (setq result (list nil (match-string 1))))
4827 (widen)
4828 (forward-line 1)
4829 result))
4830
5046;;; Internal Functions: 4831;;; Internal Functions:
5047 4832
5048(defun tramp-maybe-send-perl-script (multi-method method user host script name) 4833(defun tramp-maybe-send-script (vec script name)
5049 "Define in remote shell function NAME implemented as perl SCRIPT. 4834 "Define in remote shell function NAME implemented as SCRIPT.
5050Only send the definition if it has not already been done. 4835Only send the definition if it has not already been done."
5051Function may have 0-3 parameters." 4836 (let* ((p (tramp-get-connection-process vec))
5052 (let ((remote-perl (tramp-get-remote-perl multi-method method user host))) 4837 (scripts (tramp-get-connection-property p "scripts" nil)))
5053 (unless remote-perl (error "No remote perl")) 4838 (unless (memq name scripts)
5054 (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil 4839 (tramp-message vec 5 "Sending script `%s'..." name)
5055 multi-method method user host))) 4840 ;; The script could contain a call of Perl. This is masked with `%s'.
5056 (unless (memq name perl-scripts) 4841 (tramp-send-command-and-check
5057 (with-current-buffer (tramp-get-buffer multi-method method user host) 4842 vec
5058 (tramp-message 5 (concat "Sending the Perl script `" name "'...")) 4843 (format "%s () {\n%s\n}" name
5059 (tramp-send-string multi-method method user host 4844 (format script (tramp-get-remote-perl vec))))
5060 (concat name 4845 (tramp-set-connection-property p "scripts" (cons name scripts))
5061 " () {\n" 4846 (tramp-message vec 5 "Sending script `%s'...done." name))))
5062 remote-perl
5063 " -e '"
5064 script
5065 "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}"))
5066 (tramp-wait-for-output)
5067 (tramp-set-connection-property "perl-scripts" (cons name perl-scripts)
5068 multi-method method user host)
5069 (tramp-message 5 (concat "Sending the Perl script `" name "'...done.")))))))
5070 4847
5071(defun tramp-set-auto-save () 4848(defun tramp-set-auto-save ()
5072 (when (and (buffer-file-name) 4849 (when (and ;; ange-ftp has its own auto-save mechanism
5073 (tramp-tramp-file-p (buffer-file-name))
5074 ;; ange-ftp has its own auto-save mechanism
5075 (eq (tramp-find-foreign-file-name-handler (buffer-file-name)) 4850 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
5076 'tramp-sh-file-name-handler) 4851 'tramp-sh-file-name-handler)
5077 auto-save-default) 4852 auto-save-default)
@@ -5084,46 +4859,32 @@ Function may have 0-3 parameters."
5084(defun tramp-run-test (switch filename) 4859(defun tramp-run-test (switch filename)
5085 "Run `test' on the remote system, given a SWITCH and a FILENAME. 4860 "Run `test' on the remote system, given a SWITCH and a FILENAME.
5086Returns the exit code of the `test' program." 4861Returns the exit code of the `test' program."
5087 (let ((v (tramp-dissect-file-name filename))) 4862 (with-parsed-tramp-file-name filename nil
5088 (save-excursion 4863 (tramp-send-command-and-check
5089 (tramp-send-command-and-check 4864 v
5090 (tramp-file-name-multi-method v) (tramp-file-name-method v) 4865 (format
5091 (tramp-file-name-user v) (tramp-file-name-host v) 4866 "%s %s %s"
5092 (format "test %s %s" switch 4867 (tramp-get-test-command v)
5093 (tramp-shell-quote-argument (tramp-file-name-localname v))))))) 4868 switch
5094 4869 (tramp-shell-quote-argument localname)))))
5095(defun tramp-run-test2 (program file1 file2 &optional switch) 4870
5096 "Run `test'-like PROGRAM on the remote system, given FILE1, FILE2. 4871(defun tramp-run-test2 (format-string file1 file2)
5097The optional SWITCH is inserted between the two files. 4872 "Run `test'-like program on the remote system, given FILE1, FILE2.
5098Returns the exit code of the `test' PROGRAM. Barfs if the methods, 4873FORMAT-STRING contains the program name, switches, and place holders.
4874Returns the exit code of the `test' program. Barfs if the methods,
5099hosts, or files, disagree." 4875hosts, or files, disagree."
5100 (let* ((v1 (tramp-dissect-file-name file1)) 4876 (unless (tramp-equal-remote file1 file2)
5101 (v2 (tramp-dissect-file-name file2)) 4877 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
5102 (mmethod1 (tramp-file-name-multi-method v1)) 4878 (tramp-error
5103 (mmethod2 (tramp-file-name-multi-method v2)) 4879 v 'file-error
5104 (method1 (tramp-file-name-method v1)) 4880 "tramp-run-test2 only implemented for same method, user, host")))
5105 (method2 (tramp-file-name-method v2)) 4881 (with-parsed-tramp-file-name file1 v1
5106 (user1 (tramp-file-name-user v1)) 4882 (with-parsed-tramp-file-name file1 v2
5107 (user2 (tramp-file-name-user v2))
5108 (host1 (tramp-file-name-host v1))
5109 (host2 (tramp-file-name-host v2))
5110 (localname1 (tramp-file-name-localname v1))
5111 (localname2 (tramp-file-name-localname v2)))
5112 (unless (and method1 method2 host1 host2
5113 (equal mmethod1 mmethod2)
5114 (equal method1 method2)
5115 (equal user1 user2)
5116 (equal host1 host2))
5117 (error "tramp-run-test2: %s"
5118 "only implemented for same method, same user, same host"))
5119 (save-excursion
5120 (tramp-send-command-and-check 4883 (tramp-send-command-and-check
5121 mmethod1 method1 user1 host1 4884 v1
5122 (format "%s %s %s %s" 4885 (format format-string
5123 program 4886 (tramp-shell-quote-argument v1-localname)
5124 (tramp-shell-quote-argument localname1) 4887 (tramp-shell-quote-argument v2-localname))))))
5125 (or switch "")
5126 (tramp-shell-quote-argument localname2))))))
5127 4888
5128(defun tramp-touch (file time) 4889(defun tramp-touch (file time)
5129 "Set the last-modified timestamp of the given file. 4890 "Set the last-modified timestamp of the given file.
@@ -5132,291 +4893,313 @@ TIME is an Emacs internal time value as returned by `current-time'."
5132 ;; With GNU Emacs, `format-time-string' has an optional 4893 ;; With GNU Emacs, `format-time-string' has an optional
5133 ;; parameter UNIVERSAL. This is preferred. 4894 ;; parameter UNIVERSAL. This is preferred.
5134 (and (functionp 'subr-arity) 4895 (and (functionp 'subr-arity)
4896 (subrp (symbol-function 'format-time-string))
5135 (= 3 (cdr (funcall (symbol-function 'subr-arity) 4897 (= 3 (cdr (funcall (symbol-function 'subr-arity)
5136 (symbol-function 'format-time-string)))))) 4898 (symbol-function 'format-time-string))))))
5137 (touch-time 4899 (touch-time
5138 (if utc 4900 (if utc
5139 (format-time-string "%Y%m%d%H%M.%S" time t) 4901 (format-time-string "%Y%m%d%H%M.%S" time t)
5140 (format-time-string "%Y%m%d%H%M.%S" time)))) 4902 (format-time-string "%Y%m%d%H%M.%S" time)))
5141 (if (tramp-tramp-file-p file) 4903 (default-directory (file-name-directory file)))
4904
4905 (if (eq (tramp-find-foreign-file-name-handler file)
4906 'tramp-sh-file-name-handler)
5142 (with-parsed-tramp-file-name file nil 4907 (with-parsed-tramp-file-name file nil
5143 (let ((buf (tramp-get-buffer multi-method method user host))) 4908 (tramp-send-command
5144 (unless (zerop (tramp-send-command-and-check 4909 v (format "%s touch -t %s %s"
5145 multi-method method user host 4910 (if utc "TZ=UTC; export TZ;" "")
5146 (format "%s touch -t %s %s" 4911 touch-time
5147 (if utc "TZ=UTC; export TZ;" "") 4912 (tramp-shell-quote-argument localname))))
5148 touch-time
5149 (tramp-shell-quote-argument localname))
5150 t))
5151 (pop-to-buffer buf)
5152 (error "tramp-touch: touch failed, see buffer `%s' for details"
5153 buf))))
5154 ;; It's a local file
5155 (with-temp-buffer 4913 (with-temp-buffer
5156 (unless (zerop (call-process 4914 (shell-command
5157 "touch" nil (current-buffer) nil "-t" touch-time file)) 4915 (format "%s touch -t %s %s"
5158 (pop-to-buffer (current-buffer)) 4916 (if utc "TZ=UTC; export TZ;" "")
5159 (error "tramp-touch: touch failed")))))) 4917 touch-time
5160 4918 (tramp-shell-quote-argument
5161(defun tramp-buffer-name (multi-method method user host) 4919 (if (tramp-tramp-file-p file)
5162 "A name for the connection buffer for USER at HOST using METHOD." 4920 (with-parsed-tramp-file-name file nil localname) file)))
5163 (if multi-method 4921 (current-buffer))))))
5164 (tramp-buffer-name-multi-method "tramp" multi-method method user host) 4922
5165 (let ((method (tramp-find-method multi-method method user host))) 4923(defun tramp-buffer-name (vec)
5166 (if user 4924 "A name for the connection buffer VEC."
5167 (format "*tramp/%s %s@%s*" method user host) 4925 ;; We must use `tramp-file-name-real-host', because for gateway
5168 (format "*tramp/%s %s*" method host))))) 4926 ;; methods the default port will be expanded later on, which would
5169 4927 ;; tamper the name.
5170(defun tramp-buffer-name-multi-method (prefix multi-method method user host) 4928 (let ((method (tramp-file-name-method vec))
5171 "A name for the multi method connection buffer. 4929 (user (tramp-file-name-user vec))
5172MULTI-METHOD gives the multi method, METHOD the array of methods, 4930 (host (tramp-file-name-real-host vec)))
5173USER the array of user names, HOST the array of host names." 4931 (if (not (zerop (length user)))
5174 (unless (and (= (length method) (length user)) 4932 (format "*tramp/%s %s@%s*" method user host)
5175 (= (length method) (length host))) 4933 (format "*tramp/%s %s*" method host))))
5176 (error "Syntax error in multi method (implementation error)")) 4934
5177 (let ((len (length method)) 4935(defun tramp-get-buffer (vec)
5178 (i 0) 4936 "Get the connection buffer to be used for VEC."
5179 string-list) 4937 (or (get-buffer (tramp-buffer-name vec))
5180 (while (< i len) 4938 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
5181 (setq string-list 4939 (setq buffer-undo-list t)
5182 (cons (if (aref user i) 4940 (setq default-directory
5183 (format "%s#%s@%s:" (aref method i) 4941 (tramp-make-tramp-file-name
5184 (aref user i) (aref host i)) 4942 (tramp-file-name-method vec)
5185 (format "%s@%s:" (aref method i) (aref host i))) 4943 (tramp-file-name-user vec)
5186 string-list)) 4944 (tramp-file-name-host vec)
5187 (setq i (1+ i))) 4945 "/"))
5188 (format "*%s/%s %s*" 4946 (current-buffer))))
5189 prefix multi-method 4947
5190 (apply 'concat (reverse string-list))))) 4948(defun tramp-get-connection-buffer (vec)
5191 4949 "Get the connection buffer to be used for VEC.
5192(defun tramp-get-buffer (multi-method method user host) 4950In case a second asynchronous communication has been started, it is different
5193 "Get the connection buffer to be used for USER at HOST using METHOD." 4951from `tramp-get-buffer'."
4952 (or (tramp-get-connection-property vec "process-buffer" nil)
4953 (tramp-get-buffer vec)))
4954
4955(defun tramp-get-connection-process (vec)
4956 "Get the connection process to be used for VEC.
4957In case a second asynchronous communication has been started, it is different
4958from the default one."
4959 (get-process
4960 (or (tramp-get-connection-property vec "process-name" nil)
4961 (tramp-buffer-name vec))))
4962
4963(defun tramp-debug-buffer-name (vec)
4964 "A name for the debug buffer for VEC."
4965 ;; We must use `tramp-file-name-real-host', because for gateway
4966 ;; methods the default port will be expanded later on, which would
4967 ;; tamper the name.
4968 (let ((method (tramp-file-name-method vec))
4969 (user (tramp-file-name-user vec))
4970 (host (tramp-file-name-real-host vec)))
4971 (if (not (zerop (length user)))
4972 (format "*debug tramp/%s %s@%s*" method user host)
4973 (format "*debug tramp/%s %s*" method host))))
4974
4975(defun tramp-get-debug-buffer (vec)
4976 "Get the debug buffer for VEC."
5194 (with-current-buffer 4977 (with-current-buffer
5195 (get-buffer-create (tramp-buffer-name multi-method method user host)) 4978 (get-buffer-create (tramp-debug-buffer-name vec))
5196 (setq buffer-undo-list t) 4979 (when (bobp)
4980 (setq buffer-undo-list t)
4981 ;; Activate outline-mode
4982 (make-local-variable 'outline-regexp)
4983 (make-local-variable 'outline-level)
4984 ;; This runs `text-mode-hook' and `outline-mode-hook'. We must
4985 ;; prevent that local processes die. Yes: I've seen
4986 ;; `flyspell-mode', which starts "ispell" ...
4987 (let ((default-directory (tramp-temporary-file-directory)))
4988 (outline-mode))
4989 (setq outline-regexp "[0-9]+:[0-9]+:[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
4990; (setq outline-regexp "[a-z.-]+:[0-9]+: [a-z0-9-]+ (\\([0-9]+\\)) #")
4991 (setq outline-level 'tramp-outline-level))
5197 (current-buffer))) 4992 (current-buffer)))
5198 4993
5199(defun tramp-debug-buffer-name (multi-method method user host) 4994(defun tramp-outline-level ()
5200 "A name for the debug buffer for USER at HOST using METHOD." 4995 "Return the depth to which a statement is nested in the outline.
5201 (if multi-method 4996Point must be at the beginning of a header line.
5202 (tramp-buffer-name-multi-method "debug tramp" 4997
5203 multi-method method user host) 4998The outline level is equal to the verbosity of the Tramp message."
5204 (let ((method (tramp-find-method multi-method method user host))) 4999 (1+ (string-to-number (match-string 1))))
5205 (if user
5206 (format "*debug tramp/%s %s@%s*" method user host)
5207 (format "*debug tramp/%s %s*" method host)))))
5208
5209(defun tramp-get-debug-buffer (multi-method method user host)
5210 "Get the debug buffer for USER at HOST using METHOD."
5211 (with-current-buffer
5212 (get-buffer-create
5213 (tramp-debug-buffer-name multi-method method user host))
5214 (setq buffer-undo-list t)
5215 (current-buffer)))
5216 5000
5217(defun tramp-find-executable (multi-method method user host 5001(defun tramp-find-executable
5218 progname dirlist ignore-tilde) 5002 (vec progname dirlist &optional ignore-tilde ignore-path)
5219 "Searches for PROGNAME in all directories mentioned in DIRLIST. 5003 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
5220First args METHOD, USER and HOST specify the connection, PROGNAME 5004First arg VEC specifies the connection, PROGNAME is the program
5221is the program to search for, and DIRLIST gives the list of directories 5005to search for, and DIRLIST gives the list of directories to
5222to search. If IGNORE-TILDE is non-nil, directory names starting 5006search. If IGNORE-TILDE is non-nil, directory names starting
5223with `~' will be ignored. 5007with `~' will be ignored. If IGNORE-PATH is non-nil, searches
5008only in DIRLIST.
5224 5009
5225Returns the absolute file name of PROGNAME, if found, and nil otherwise. 5010Returns the absolute file name of PROGNAME, if found, and nil otherwise.
5226 5011
5227This function expects to be in the right *tramp* buffer." 5012This function expects to be in the right *tramp* buffer."
5228 (let (result) 5013 (with-current-buffer (tramp-get-buffer vec)
5229 (when ignore-tilde 5014 (let (result)
5230 ;; Remove all ~/foo directories from dirlist. In Emacs 20, 5015 ;; Check whether the executable is in $PATH. "which(1)" does not
5231 ;; `remove' is in CL, and we want to avoid CL dependencies. 5016 ;; report always a correct error code; therefore we check the
5232 (let (newdl d) 5017 ;; number of words it returns.
5233 (while dirlist 5018 (unless ignore-path
5234 (setq d (car dirlist)) 5019 (tramp-send-command vec (format "which \\%s | wc -w" progname))
5235 (setq dirlist (cdr dirlist)) 5020 (goto-char (point-min))
5236 (unless (char-equal ?~ (aref d 0)) 5021 (if (looking-at "^1$")
5237 (setq newdl (cons d newdl)))) 5022 (setq result (concat "\\" progname))))
5238 (setq dirlist (nreverse newdl)))) 5023 (unless result
5239 (tramp-send-command 5024 (when ignore-tilde
5240 multi-method method user host 5025 ;; Remove all ~/foo directories from dirlist. In Emacs 20,
5241 (format (concat "while read d; " 5026 ;; `remove' is in CL, and we want to avoid CL dependencies.
5242 "do if test -x $d/%s -a -f $d/%s; " 5027 (let (newdl d)
5243 "then echo tramp_executable $d/%s; " 5028 (while dirlist
5244 "break; fi; done <<'EOF'") 5029 (setq d (car dirlist))
5245 progname progname progname)) 5030 (setq dirlist (cdr dirlist))
5246 (mapcar (lambda (d) 5031 (unless (char-equal ?~ (aref d 0))
5247 (tramp-send-command multi-method method user host d)) 5032 (setq newdl (cons d newdl))))
5248 dirlist) 5033 (setq dirlist (nreverse newdl))))
5249 (tramp-send-command multi-method method user host "EOF") 5034 (tramp-send-command
5250 (tramp-wait-for-output) 5035 vec
5251 (goto-char (point-max)) 5036 (format (concat "while read d; "
5252 (when (search-backward "tramp_executable " nil t) 5037 "do if test -x $d/%s -a -f $d/%s; "
5253 (skip-chars-forward "^ ") 5038 "then echo tramp_executable $d/%s; "
5254 (skip-chars-forward " ") 5039 "break; fi; done <<'EOF'\n"
5255 (buffer-substring (point) (tramp-line-end-position))))) 5040 "%s\nEOF")
5256 5041 progname progname progname (mapconcat 'identity dirlist "\n")))
5257(defun tramp-set-remote-path (multi-method method user host var dirlist) 5042 (goto-char (point-max))
5258 "Sets the remote environment VAR to existing directories from DIRLIST. 5043 (when (search-backward "tramp_executable " nil t)
5259I.e., for each directory in DIRLIST, it is tested whether it exists and if 5044 (skip-chars-forward "^ ")
5260so, it is added to the environment variable VAR." 5045 (skip-chars-forward " ")
5261 (let ((existing-dirs 5046 (setq result (buffer-substring (point) (tramp-line-end-position)))))
5262 (mapcar 5047 result)))
5263 (lambda (x) 5048
5264 (when (and 5049(defun tramp-set-remote-path (vec)
5265 (file-exists-p 5050 "Sets the remote environment PATH to existing directories.
5266 (tramp-make-tramp-file-name multi-method method user host x)) 5051I.e., for each directory in `tramp-remote-path', it is tested
5267 (file-directory-p 5052whether it exists and if so, it is added to the environment
5268 (tramp-make-tramp-file-name multi-method method user host x))) 5053variable PATH."
5269 x)) 5054 (tramp-message vec 5 (format "Setting $PATH environment variable"))
5270 dirlist))) 5055
5056 (with-current-buffer (tramp-get-connection-buffer vec)
5057 (set (make-local-variable 'tramp-remote-path)
5058 (copy-tree tramp-remote-path))
5059 (let* ((elt (memq 'tramp-default-remote-path tramp-remote-path))
5060 (tramp-default-remote-path
5061 (with-connection-property vec "default-remote-path"
5062 (when elt
5063 (condition-case nil
5064 (symbol-name
5065 (tramp-send-command-and-read vec "getconf PATH"))
5066 ;; Default if "getconf" is not available.
5067 (error
5068 (tramp-message
5069 vec 3
5070 "`getconf PATH' not successful, using default value \"%s\"."
5071 "/bin:/usr/bin")
5072 "/bin:/usr/bin"))))))
5073 (when elt
5074 ;; Replace place holder `tramp-default-remote-path'.
5075 (setcdr elt
5076 (append
5077 (tramp-split-string tramp-default-remote-path ":")
5078 (cdr elt)))
5079 (setq tramp-remote-path
5080 (delq 'tramp-default-remote-path tramp-remote-path))))
5081
5082 ;; Check for existence of directories.
5083 (setq tramp-remote-path
5084 (delq
5085 nil
5086 (mapcar
5087 (lambda (x)
5088 (and
5089 (with-connection-property vec x
5090 (file-directory-p
5091 (tramp-make-tramp-file-name
5092 (tramp-file-name-method vec)
5093 (tramp-file-name-user vec)
5094 (tramp-file-name-host vec)
5095 x)))
5096 x))
5097 tramp-remote-path)))
5271 (tramp-send-command 5098 (tramp-send-command
5272 multi-method method user host 5099 vec
5273 (concat var "=" 5100 (format "PATH=%s; export PATH"
5274 (mapconcat 'identity (delq nil existing-dirs) ":") 5101 (mapconcat 'identity tramp-remote-path ":")))))
5275 "; export " var))
5276 (tramp-wait-for-output)))
5277 5102
5278;; -- communication with external shell -- 5103;; -- communication with external shell --
5279 5104
5280(defun tramp-find-file-exists-command (multi-method method user host) 5105(defun tramp-find-file-exists-command (vec)
5281 "Find a command on the remote host for checking if a file exists. 5106 "Find a command on the remote host for checking if a file exists.
5282Here, we are looking for a command which has zero exit status if the 5107Here, we are looking for a command which has zero exit status if the
5283file exists and nonzero exit status otherwise." 5108file exists and nonzero exit status otherwise."
5284 (make-local-variable 'tramp-file-exists-command) 5109 (let ((existing "/")
5285 (tramp-message 9 "Finding command to check if file exists")
5286 (let ((existing
5287 (tramp-make-tramp-file-name
5288 multi-method method user host
5289 "/")) ;assume this file always exists
5290 (nonexisting 5110 (nonexisting
5291 (tramp-make-tramp-file-name 5111 (tramp-shell-quote-argument "/ this file does not exist "))
5292 multi-method method user host 5112 result)
5293 "/ this file does not exist "))) ;assume this never exists
5294 ;; The algorithm is as follows: we try a list of several commands. 5113 ;; The algorithm is as follows: we try a list of several commands.
5295 ;; For each command, we first run `$cmd /' -- this should return 5114 ;; For each command, we first run `$cmd /' -- this should return
5296 ;; true, as the root directory always exists. And then we run 5115 ;; true, as the root directory always exists. And then we run
5297 ;; `$cmd /this\ file\ does\ not\ exist', hoping that the file indeed 5116 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
5298 ;; does not exist. This should return false. We use the first 5117 ;; does not exist. This should return false. We use the first
5299 ;; command we find that seems to work. 5118 ;; command we find that seems to work.
5300 ;; The list of commands to try is as follows: 5119 ;; The list of commands to try is as follows:
5301 ;; `ls -d' This works on most systems, but NetBSD 1.4 5120 ;; `ls -d' This works on most systems, but NetBSD 1.4
5302 ;; has a bug: `ls' always returns zero exit 5121 ;; has a bug: `ls' always returns zero exit
5303 ;; status, even for files which don't exist. 5122 ;; status, even for files which don't exist.
5304 ;; `test -e' Some Bourne shells have a `test' builtin 5123 ;; `test -e' Some Bourne shells have a `test' builtin
5305 ;; which does not know the `-e' option. 5124 ;; which does not know the `-e' option.
5306 ;; `/bin/test -e' For those, the `test' binary on disk normally 5125 ;; `/bin/test -e' For those, the `test' binary on disk normally
5307 ;; provides the option. Alas, the binary 5126 ;; provides the option. Alas, the binary
5308 ;; is sometimes `/bin/test' and sometimes it's 5127 ;; is sometimes `/bin/test' and sometimes it's
5309 ;; `/usr/bin/test'. 5128 ;; `/usr/bin/test'.
5310 ;; `/usr/bin/test -e' In case `/bin/test' does not exist. 5129 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
5311 (unless (or 5130 (unless (or
5312 (and (setq tramp-file-exists-command "test -e %s") 5131 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
5313 (file-exists-p existing) 5132 (zerop (tramp-send-command-and-check
5314 (not (file-exists-p nonexisting))) 5133 vec (format "%s %s" result existing)))
5315 (and (setq tramp-file-exists-command "/bin/test -e %s") 5134 (not (zerop (tramp-send-command-and-check
5316 (file-exists-p existing) 5135 vec (format "%s %s" result nonexisting)))))
5317 (not (file-exists-p nonexisting))) 5136 (and (setq result "/bin/test -e")
5318 (and (setq tramp-file-exists-command "/usr/bin/test -e %s") 5137 (zerop (tramp-send-command-and-check
5319 (file-exists-p existing) 5138 vec (format "%s %s" result existing)))
5320 (not (file-exists-p nonexisting))) 5139 (not (zerop (tramp-send-command-and-check
5321 (and (setq tramp-file-exists-command "ls -d %s") 5140 vec (format "%s %s" result nonexisting)))))
5322 (file-exists-p existing) 5141 (and (setq result "/usr/bin/test -e")
5323 (not (file-exists-p nonexisting)))) 5142 (zerop (tramp-send-command-and-check
5324 (error "Couldn't find command to check if file exists")))) 5143 vec (format "%s %s" result existing)))
5144 (not (zerop (tramp-send-command-and-check
5145 vec (format "%s %s" result nonexisting)))))
5146 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
5147 (zerop (tramp-send-command-and-check
5148 vec (format "%s %s" result existing)))
5149 (not (zerop (tramp-send-command-and-check
5150 vec (format "%s %s" result nonexisting))))))
5151 (tramp-error
5152 vec 'file-error "Couldn't find command to check if file exists"))
5153 result))
5325 5154
5326 5155
5327;; CCC test ksh or bash found for tilde expansion? 5156;; CCC test ksh or bash found for tilde expansion?
5328(defun tramp-find-shell (multi-method method user host) 5157(defun tramp-find-shell (vec)
5329 "Find a shell on the remote host which groks tilde expansion." 5158 "Opens a shell on the remote host which groks tilde expansion."
5330 (let ((shell nil)) 5159 (unless (tramp-get-connection-property vec "remote-shell" nil)
5331 (tramp-send-command multi-method method user host "echo ~root") 5160 (let (shell)
5332 (tramp-wait-for-output) 5161 (with-current-buffer (tramp-get-buffer vec)
5333 (cond 5162 (tramp-send-command vec "echo ~root")
5334 ((string-match "^~root$" (buffer-string)) 5163 (cond
5335 (setq shell 5164 ((string-match "^~root$" (buffer-string))
5336 (or (tramp-find-executable multi-method method user host 5165 (setq shell
5337 "bash" tramp-remote-path t) 5166 (or (tramp-find-executable vec "bash" tramp-remote-path t)
5338 (tramp-find-executable multi-method method user host 5167 (tramp-find-executable vec "ksh" tramp-remote-path t)))
5339 "ksh" tramp-remote-path t))) 5168 (unless shell
5340 (unless shell 5169 (tramp-error
5341 (error "Couldn't find a shell which groks tilde expansion")) 5170 vec 'file-error
5342 ;; Find arguments for this shell. 5171 "Couldn't find a shell which groks tilde expansion"))
5343 (let ((alist tramp-sh-extra-args) 5172 ;; Find arguments for this shell.
5344 item extra-args) 5173 (let ((alist tramp-sh-extra-args)
5345 (while (and alist (null extra-args)) 5174 item extra-args)
5346 (setq item (pop alist)) 5175 (while (and alist (null extra-args))
5347 (when (string-match (car item) shell) 5176 (setq item (pop alist))
5348 (setq extra-args (cdr item)))) 5177 (when (string-match (car item) shell)
5349 (when extra-args (setq shell (concat shell " " extra-args)))) 5178 (setq extra-args (cdr item))))
5350 (tramp-message 5179 (when extra-args (setq shell (concat shell " " extra-args))))
5351 5 "Starting remote shell `%s' for tilde expansion..." shell) 5180 (tramp-message
5352 (tramp-send-command 5181 vec 5 "Starting remote shell `%s' for tilde expansion..." shell)
5353 multi-method method user host 5182 (tramp-send-command-internal vec (concat "PS1='$ ' exec " shell))
5354 (concat "PS1='$ ' exec " shell)) ; 5183 (tramp-message vec 5 "Setting remote shell prompt...")
5355 (tramp-barf-if-no-shell-prompt 5184 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
5356 (get-buffer-process (current-buffer)) 5185 ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the
5357 60 "Couldn't find remote `%s' prompt" shell) 5186 ;; last tramp-rsh-end-of-line, Douglas wanted to replace that,
5358 (tramp-message 5187 ;; as well.
5359 9 "Setting remote shell prompt...") 5188 (tramp-send-command
5360 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we 5189 vec
5361 ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the 5190 (format "PS1='%s%s%s'; PS2=''; PS3=''"
5362 ;; last tramp-rsh-end-of-line, Douglas wanted to replace that, 5191 tramp-rsh-end-of-line
5363 ;; as well. 5192 tramp-end-of-output
5364 (process-send-string nil (format "PS1='%s%s%s'; PS2=''; PS3=''%s" 5193 tramp-rsh-end-of-line))
5365 tramp-rsh-end-of-line 5194 (tramp-message vec 5 "Setting remote shell prompt...done"))
5366 tramp-end-of-output 5195 (t (tramp-message
5367 tramp-rsh-end-of-line 5196 vec 5 "Remote `%s' groks tilde expansion, good"
5368 tramp-rsh-end-of-line)) 5197 (tramp-get-method-parameter
5369 (tramp-wait-for-output) 5198 (tramp-file-name-method vec) 'tramp-remote-sh))
5370 (tramp-message 5199 (tramp-set-connection-property
5371 9 "Setting remote shell prompt...done") 5200 vec "remote-shell"
5372 ) 5201 (tramp-get-method-parameter
5373 (t (tramp-message 5 "Remote `%s' groks tilde expansion, good" 5202 (tramp-file-name-method vec) 'tramp-remote-sh))))))))
5374 (tramp-get-method-parameter
5375 multi-method method user host 'tramp-remote-sh))))))
5376
5377(defun tramp-check-ls-command (multi-method method user host cmd)
5378 "Checks whether the given `ls' executable groks `-n'.
5379METHOD, USER and HOST specify the connection, CMD (the absolute file name of)
5380the `ls' executable. Returns t if CMD supports the `-n' option, nil
5381otherwise."
5382 (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd)
5383 (when (file-executable-p
5384 (tramp-make-tramp-file-name multi-method method user host cmd))
5385 (let ((result nil))
5386 (tramp-message 7 "Testing remote command `%s' for -n..." cmd)
5387 (setq result
5388 (tramp-send-command-and-check
5389 multi-method method user host
5390 (format "%s -lnd / >/dev/null"
5391 cmd)))
5392 (tramp-message 7 "Testing remote command `%s' for -n...%s"
5393 cmd
5394 (if (zerop result) "okay" "failed"))
5395 (zerop result))))
5396
5397(defun tramp-check-ls-commands (multi-method method user host cmd dirlist)
5398 "Checks whether the given `ls' executable in one of the dirs groks `-n'.
5399Returns nil if none was found, else the command is returned."
5400 (let ((dl dirlist)
5401 (result nil))
5402 (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
5403 ;; It would be better to use the CL function `find', but
5404 ;; we don't want run-time dependencies on CL.
5405 (while (and dl (not result))
5406 (let ((x (concat (file-name-as-directory (car dl)) cmd)))
5407 (when (tramp-check-ls-command multi-method method user host x)
5408 (setq result x)))
5409 (setq dl (cdr dl)))
5410 result)))
5411
5412(defun tramp-find-ls-command (multi-method method user host)
5413 "Finds an `ls' command which groks the `-n' option, returning nil if failed.
5414\(This option prints numeric user and group ids in a long listing.)"
5415 (tramp-message 9 "Finding a suitable `ls' command")
5416 (or
5417 (tramp-check-ls-commands multi-method method user host "ls" tramp-remote-path)
5418 (tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path)
5419 (tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path)))
5420 5203
5421;; ------------------------------------------------------------ 5204;; ------------------------------------------------------------
5422;; -- Functions for establishing connection -- 5205;; -- Functions for establishing connection --
@@ -5426,635 +5209,208 @@ Returns nil if none was found, else the command is returned."
5426;; prompts from the remote host. See the variable 5209;; prompts from the remote host. See the variable
5427;; `tramp-actions-before-shell' for usage of these functions. 5210;; `tramp-actions-before-shell' for usage of these functions.
5428 5211
5429(defun tramp-action-login (p multi-method method user host) 5212(defun tramp-action-login (proc vec)
5430 "Send the login name." 5213 "Send the login name."
5431 (tramp-message 9 "Sending login name `%s'" 5214 (when (not (stringp tramp-current-user))
5432 (or user (user-login-name))) 5215 (save-window-excursion
5433 (erase-buffer) 5216 (let ((enable-recursive-minibuffers t))
5434 (process-send-string nil (concat (or user (user-login-name)) 5217 (pop-to-buffer (tramp-get-connection-buffer vec))
5435 tramp-rsh-end-of-line))) 5218 (setq tramp-current-user (read-string (match-string 0))))))
5436 5219 (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
5437(defun tramp-action-password (p multi-method method user host) 5220 (with-current-buffer (tramp-get-connection-buffer vec)
5221 (tramp-message vec 6 "\n%s" (buffer-string)))
5222 (tramp-send-string vec tramp-current-user))
5223
5224(defun tramp-action-password (proc vec)
5438 "Query the user for a password." 5225 "Query the user for a password."
5439 (let ((pw-prompt 5226 (tramp-message vec 3 "Sending password")
5440 (format "Password for %s " 5227 (tramp-enter-password proc))
5441 (tramp-make-tramp-file-name 5228
5442 nil method user host "")))) 5229(defun tramp-action-succeed (proc vec)
5443 (tramp-message 9 "Sending password")
5444 (tramp-enter-password p pw-prompt user host)))
5445
5446(defun tramp-action-succeed (p multi-method method user host)
5447 "Signal success in finding shell prompt." 5230 "Signal success in finding shell prompt."
5448 (tramp-message 9 "Found remote shell prompt.")
5449 (erase-buffer)
5450 (throw 'tramp-action 'ok)) 5231 (throw 'tramp-action 'ok))
5451 5232
5452(defun tramp-action-permission-denied (p multi-method method user host) 5233(defun tramp-action-permission-denied (proc vec)
5453 "Signal permission denied." 5234 "Signal permission denied."
5454 (pop-to-buffer (tramp-get-buffer multi-method method user host)) 5235 (kill-process proc)
5455 (tramp-message 9 "Permission denied by remote host.")
5456 (kill-process p)
5457 (throw 'tramp-action 'permission-denied)) 5236 (throw 'tramp-action 'permission-denied))
5458 5237
5459(defun tramp-action-copy-failed (p multi-method method user host) 5238(defun tramp-action-yesno (proc vec)
5460 "Signal copy failed."
5461 (kill-process p)
5462 (error "%s" (match-string 1)))
5463
5464(defun tramp-action-yesno (p multi-method method user host)
5465 "Ask the user for confirmation using `yes-or-no-p'. 5239 "Ask the user for confirmation using `yes-or-no-p'.
5466Send \"yes\" to remote process on confirmation, abort otherwise. 5240Send \"yes\" to remote process on confirmation, abort otherwise.
5467See also `tramp-action-yn'." 5241See also `tramp-action-yn'."
5468 (save-window-excursion 5242 (save-window-excursion
5469 (pop-to-buffer (tramp-get-buffer multi-method method user host)) 5243 (let ((enable-recursive-minibuffers t))
5470 (unless (yes-or-no-p (match-string 0)) 5244 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
5471 (kill-process p) 5245 (unless (yes-or-no-p (match-string 0))
5472 (erase-buffer) 5246 (kill-process proc)
5473 (throw 'tramp-action 'permission-denied)) 5247 (throw 'tramp-action 'permission-denied))
5474 (process-send-string p (concat "yes" tramp-rsh-end-of-line)) 5248 (with-current-buffer (tramp-get-connection-buffer vec)
5475 (erase-buffer))) 5249 (tramp-message vec 6 "\n%s" (buffer-string)))
5476 5250 (tramp-send-string vec "yes"))))
5477(defun tramp-action-yn (p multi-method method user host) 5251
5252(defun tramp-action-yn (proc vec)
5478 "Ask the user for confirmation using `y-or-n-p'. 5253 "Ask the user for confirmation using `y-or-n-p'.
5479Send \"y\" to remote process on confirmation, abort otherwise. 5254Send \"y\" to remote process on confirmation, abort otherwise.
5480See also `tramp-action-yesno'." 5255See also `tramp-action-yesno'."
5481 (save-window-excursion 5256 (save-window-excursion
5482 (pop-to-buffer (tramp-get-buffer multi-method method user host)) 5257 (let ((enable-recursive-minibuffers t))
5483 (unless (y-or-n-p (match-string 0)) 5258 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
5484 (kill-process p) 5259 (unless (y-or-n-p (match-string 0))
5485 (throw 'tramp-action 'permission-denied)) 5260 (kill-process proc)
5486 (erase-buffer) 5261 (throw 'tramp-action 'permission-denied))
5487 (process-send-string p (concat "y" tramp-rsh-end-of-line)))) 5262 (with-current-buffer (tramp-get-connection-buffer vec)
5488 5263 (tramp-message vec 6 "\n%s" (buffer-string)))
5489(defun tramp-action-terminal (p multi-method method user host) 5264 (tramp-send-string vec "y"))))
5265
5266(defun tramp-action-terminal (proc vec)
5490 "Tell the remote host which terminal type to use. 5267 "Tell the remote host which terminal type to use.
5491The terminal type can be configured with `tramp-terminal-type'." 5268The terminal type can be configured with `tramp-terminal-type'."
5492 (tramp-message 9 "Setting `%s' as terminal type." 5269 (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
5493 tramp-terminal-type) 5270 (tramp-send-string vec tramp-terminal-type))
5494 (erase-buffer)
5495 (process-send-string nil (concat tramp-terminal-type
5496 tramp-rsh-end-of-line)))
5497 5271
5498(defun tramp-action-process-alive (p multi-method method user host) 5272(defun tramp-action-process-alive (proc vec)
5499 "Check whether a process has finished." 5273 "Check whether a process has finished."
5500 (unless (memq (process-status p) '(run open)) 5274 (unless (memq (process-status proc) '(run open))
5501 (throw 'tramp-action 'process-died))) 5275 (throw 'tramp-action 'process-died)))
5502 5276
5503(defun tramp-action-out-of-band (p multi-method method user host) 5277(defun tramp-action-out-of-band (proc vec)
5504 "Check whether an out-of-band copy has finished." 5278 "Check whether an out-of-band copy has finished."
5505 (cond ((and (memq (process-status p) '(stop exit)) 5279 (cond ((and (memq (process-status proc) '(stop exit))
5506 (zerop (process-exit-status p))) 5280 (zerop (process-exit-status proc)))
5507 (tramp-message 9 "Process has finished.") 5281 (tramp-message vec 3 "Process has finished.")
5508 (throw 'tramp-action 'ok)) 5282 (throw 'tramp-action 'ok))
5509 ((or (and (memq (process-status p) '(stop exit)) 5283 ((or (and (memq (process-status proc) '(stop exit))
5510 (not (zerop (process-exit-status p)))) 5284 (not (zerop (process-exit-status proc))))
5511 (memq (process-status p) '(signal))) 5285 (memq (process-status proc) '(signal)))
5512 ;; `scp' could have copied correctly, but set modes could have failed. 5286 ;; `scp' could have copied correctly, but set modes could have failed.
5513 ;; This can be ignored. 5287 ;; This can be ignored.
5514 (goto-char (point-min)) 5288 (with-current-buffer (process-buffer proc)
5515 (if (re-search-forward tramp-operation-not-permitted-regexp nil t) 5289 (goto-char (point-min))
5516 (progn 5290 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
5517 (tramp-message 10 "'set mode' error ignored.") 5291 (progn
5518 (tramp-message 9 "Process has finished.") 5292 (tramp-message vec 5 "'set mode' error ignored.")
5519 (throw 'tramp-action 'ok)) 5293 (tramp-message vec 3 "Process has finished.")
5520 (tramp-message 9 "Process has died.") 5294 (throw 'tramp-action 'ok))
5521 (throw 'tramp-action 'process-died))) 5295 (tramp-message vec 3 "Process has died.")
5296 (throw 'tramp-action 'process-died))))
5522 (t nil))) 5297 (t nil)))
5523 5298
5524;; The following functions are specifically for multi connections.
5525
5526(defun tramp-multi-action-login (p method user host)
5527 "Send the login name."
5528 (tramp-message 9 "Sending login name `%s'" user)
5529 (erase-buffer)
5530 (process-send-string p (concat user tramp-rsh-end-of-line)))
5531
5532(defun tramp-multi-action-password (p method user host)
5533 "Query the user for a password."
5534 (let ((pw-prompt
5535 (format "Password for %s "
5536 (tramp-make-tramp-file-name
5537 nil method user host ""))))
5538 (tramp-message 9 "Sending password")
5539 (tramp-enter-password p pw-prompt user host)))
5540
5541(defun tramp-multi-action-succeed (p method user host)
5542 "Signal success in finding shell prompt."
5543 (tramp-message 9 "Found shell prompt on `%s'" host)
5544 (erase-buffer)
5545 (throw 'tramp-action 'ok))
5546
5547(defun tramp-multi-action-permission-denied (p method user host)
5548 "Signal permission denied."
5549 (tramp-message 9 "Permission denied by remote host `%s'" host)
5550 (kill-process p)
5551 (erase-buffer)
5552 (throw 'tramp-action 'permission-denied))
5553
5554(defun tramp-multi-action-process-alive (p method user host)
5555 "Check whether a process has finished."
5556 (unless (memq (process-status p) '(run open))
5557 (throw 'tramp-action 'process-died)))
5558
5559;; Functions for processing the actions. 5299;; Functions for processing the actions.
5560 5300
5561(defun tramp-process-one-action (p multi-method method user host actions) 5301(defun tramp-process-one-action (proc vec actions)
5562 "Wait for output from the shell and perform one action." 5302 "Wait for output from the shell and perform one action."
5563 (let (found item pattern action todo) 5303 (let (found todo item pattern action)
5564 (erase-buffer)
5565 (tramp-message 9 "Waiting 60s for prompt from remote shell")
5566 (while (not found) 5304 (while (not found)
5567 (tramp-accept-process-output p 1) 5305 ;; Reread output once all actions have been performed.
5568 (goto-char (point-min)) 5306 ;; Obviously, the output was not complete.
5307 (tramp-accept-process-output proc 1)
5569 (setq todo actions) 5308 (setq todo actions)
5570 (while todo 5309 (while todo
5571 (goto-char (point-min))
5572 (setq item (pop todo)) 5310 (setq item (pop todo))
5573 (setq pattern (symbol-value (nth 0 item))) 5311 (setq pattern (concat (symbol-value (nth 0 item)) "\\'"))
5574 (setq action (nth 1 item)) 5312 (setq action (nth 1 item))
5575 (tramp-message 10 "Looking for regexp \"%s\" from remote shell" 5313 (tramp-message
5576 pattern) 5314 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
5577 (when (re-search-forward (concat pattern "\\'") nil t) 5315 (when (tramp-check-for-regexp proc pattern)
5578 (setq found (funcall action p multi-method method user host))))) 5316 (tramp-message vec 5 "Call `%s'" (symbol-name action))
5317 (setq found (funcall action proc vec)))))
5579 found)) 5318 found))
5580 5319
5581(defun tramp-process-actions 5320(defun tramp-process-actions (proc vec actions &optional timeout)
5582 (p multi-method method user host actions &optional timeout)
5583 "Perform actions until success or TIMEOUT." 5321 "Perform actions until success or TIMEOUT."
5584 (tramp-message 10 "%s" (mapconcat 'identity (process-command p) " "))
5585 (let (exit) 5322 (let (exit)
5586 (while (not exit) 5323 (while (not exit)
5587 (tramp-message 9 "Waiting for prompts from remote shell") 5324 (tramp-message proc 3 "Waiting for prompts from remote shell")
5588 (setq exit 5325 (setq exit
5589 (catch 'tramp-action 5326 (catch 'tramp-action
5590 (if timeout 5327 (if timeout
5591 (with-timeout (timeout) 5328 (with-timeout (timeout)
5592 (tramp-process-one-action 5329 (tramp-process-one-action proc vec actions))
5593 p multi-method method user host actions)) 5330 (tramp-process-one-action proc vec actions)))))
5594 (tramp-process-one-action 5331 (with-current-buffer (tramp-get-connection-buffer vec)
5595 p multi-method method user host actions)) 5332 (tramp-message vec 6 "\n%s" (buffer-string)))
5596 nil)))
5597 (unless (eq exit 'ok)
5598 (tramp-clear-passwd user host)
5599 (error "Login failed"))))
5600
5601;; For multi-actions.
5602
5603(defun tramp-process-one-multi-action (p method user host actions)
5604 "Wait for output from the shell and perform one action."
5605 (let (found item pattern action todo)
5606 (erase-buffer)
5607 (tramp-message 9 "Waiting 60s for prompt from remote shell")
5608 (with-timeout (60 (throw 'tramp-action 'timeout))
5609 (while (not found)
5610 (tramp-accept-process-output p 1)
5611 (setq todo actions)
5612 (goto-char (point-min))
5613 (while todo
5614 (goto-char (point-min))
5615 (setq item (pop todo))
5616 (setq pattern (symbol-value (nth 0 item)))
5617 (setq action (nth 1 item))
5618 (tramp-message 10 "Looking for regexp \"%s\" from remote shell"
5619 pattern)
5620 (when (re-search-forward (concat pattern "\\'") nil t)
5621 (setq found (funcall action p method user host)))))
5622 found)))
5623
5624(defun tramp-process-multi-actions (p method user host actions)
5625 "Perform actions until success."
5626 (let (exit)
5627 (while (not exit)
5628 (tramp-message 9 "Waiting for prompts from remote shell")
5629 (setq exit
5630 (catch 'tramp-action
5631 (tramp-process-one-multi-action p method user host actions)
5632 nil)))
5633 (unless (eq exit 'ok) 5333 (unless (eq exit 'ok)
5634 (tramp-clear-passwd user host) 5334 (tramp-clear-passwd)
5635 (error "Login failed")))) 5335 (tramp-error-with-buffer
5636 5336 nil vec 'file-error
5637;; Functions to execute when we have seen the remote shell prompt but 5337 (cond
5638;; before we exec the Bourne-ish shell. Note that these commands 5338 ((eq exit 'permission-denied) "Permission denied")
5639;; might be sent to any shell, not just a Bourne-ish shell. This 5339 ((eq exit 'process-died) "Process died")
5640;; means that the commands need to work in all shells. (It is also 5340 (t "Login failed"))))))
5641;; okay for some commands to just fail with an error message, but
5642;; please make sure that they at least don't crash the odd shell people
5643;; might be running...)
5644(defun tramp-process-initial-commands (p
5645 multi-method method user host
5646 commands)
5647 "Send list of commands to remote host, in order."
5648 (let (cmd)
5649 (while commands
5650 (setq cmd (pop commands))
5651 (erase-buffer)
5652 (tramp-message 10 "Sending command to remote shell: %s"
5653 cmd)
5654 (tramp-send-command multi-method method user host cmd nil t)
5655 (tramp-barf-if-no-shell-prompt
5656 p 60 "Remote shell command failed: %s" cmd))
5657 (erase-buffer)))
5658
5659;; The actual functions for opening connections.
5660
5661(defun tramp-open-connection-telnet (multi-method method user host)
5662 "Open a connection using a telnet METHOD.
5663This starts the command `telnet HOST ARGS'[*], then waits for a remote
5664login prompt, then sends the user name USER, then waits for a remote
5665password prompt. It queries the user for the password, then sends the
5666password to the remote host.
5667
5668If USER is nil, uses value returned by `(user-login-name)' instead.
5669
5670Recognition of the remote shell prompt is based on the variables
5671`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
5672set up correctly.
5673
5674Please note that it is NOT possible to use this connection method
5675together with an out-of-band transfer method! You must use an inline
5676transfer method.
5677
5678Maybe the different regular expressions need to be tuned.
5679
5680* Actually, the telnet program as well as the args to be used can be
5681 specified in the method parameters, see the variable `tramp-methods'."
5682 (save-match-data
5683 (when (tramp-method-out-of-band-p multi-method method user host)
5684 (error "Cannot use out-of-band method `%s' with telnet connection method"
5685 method))
5686 (when multi-method
5687 (error "Cannot multi-connect using telnet connection method"))
5688 (tramp-pre-connection multi-method method user host tramp-chunksize)
5689 (tramp-message 7 "Opening connection for %s@%s using %s..."
5690 (or user (user-login-name)) host method)
5691 (let ((process-environment (copy-sequence process-environment)))
5692 (setenv "TERM" tramp-terminal-type)
5693 (setenv "PS1" "$ ")
5694 (let* ((default-directory (tramp-temporary-file-directory))
5695 ;; If we omit the conditional here, then we would use
5696 ;; `undecided-dos' in some cases. With the conditional,
5697 ;; we use nil in these cases. Which one is right?
5698 (coding-system-for-read (unless (and (not (featurep 'xemacs))
5699 (> emacs-major-version 20))
5700 tramp-dos-coding-system))
5701 (p (apply 'start-process
5702 (tramp-buffer-name multi-method method user host)
5703 (tramp-get-buffer multi-method method user host)
5704 (tramp-get-method-parameter
5705 multi-method
5706 (tramp-find-method multi-method method user host)
5707 user host 'tramp-login-program)
5708 host
5709 (tramp-get-method-parameter
5710 multi-method
5711 (tramp-find-method multi-method method user host)
5712 user host 'tramp-login-args)))
5713 (found nil)
5714 (pw nil))
5715 (tramp-set-process-query-on-exit-flag p nil)
5716 (set-buffer (tramp-get-buffer multi-method method user host))
5717 (erase-buffer)
5718 (tramp-process-actions p multi-method method user host
5719 tramp-actions-before-shell 60)
5720 (tramp-open-connection-setup-interactive-shell
5721 p multi-method method user host)
5722 (tramp-post-connection multi-method method user host)))))
5723
5724
5725(defun tramp-open-connection-rsh (multi-method method user host)
5726 "Open a connection using an rsh METHOD.
5727This starts the command `rsh HOST -l USER'[*], then waits for a remote
5728password or shell prompt. If a password prompt is seen, the user is
5729queried for a password, this function sends the password to the remote
5730host and waits for a shell prompt.
5731
5732If USER is nil, start the command `rsh HOST'[*] instead
5733
5734Recognition of the remote shell prompt is based on the variables
5735`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
5736set up correctly.
5737
5738Kludgy feature: if HOST has the form \"xx#yy\", then yy is assumed to
5739be a port number for ssh, and \"-p yy\" will be added to the list of
5740arguments, and xx will be used as the host name to connect to.
5741
5742* Actually, the rsh program to be used can be specified in the
5743 method parameters, see the variable `tramp-methods'."
5744 (save-match-data
5745 (when multi-method
5746 (error "Cannot multi-connect using rsh connection method"))
5747 (tramp-pre-connection multi-method method user host tramp-chunksize)
5748 (if (and user (not (string= user "")))
5749 (tramp-message 7 "Opening connection for %s@%s using %s..."
5750 user host method)
5751 (tramp-message 7 "Opening connection at %s using %s..." host method))
5752 (let ((process-environment (copy-sequence process-environment))
5753 (bufnam (tramp-buffer-name multi-method method user host))
5754 (buf (tramp-get-buffer multi-method method user host))
5755 (login-program (tramp-get-method-parameter
5756 multi-method
5757 (tramp-find-method multi-method method user host)
5758 user host 'tramp-login-program))
5759 (login-args (mapcar
5760 (lambda (x)
5761 (format-spec
5762 x `((?t . ,(format "/tmp/%s" tramp-temp-name-prefix)))))
5763 (tramp-get-method-parameter
5764 multi-method
5765 (tramp-find-method multi-method method user host)
5766 user host 'tramp-login-args)))
5767 (real-host host))
5768 ;; The following should be changed. We need a more general
5769 ;; mechanism to parse extra host args.
5770 (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
5771 (setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
5772 (setq real-host (match-string 1 host)))
5773 (setenv "TERM" tramp-terminal-type)
5774 (setenv "PS1" "$ ")
5775 (let* ((default-directory (tramp-temporary-file-directory))
5776 ;; If we omit the conditional, we would use
5777 ;; `undecided-dos' in some cases. With the conditional,
5778 ;; we use nil in these cases. Which one is right?
5779 (coding-system-for-read (unless (and (not (featurep 'xemacs))
5780 (> emacs-major-version 20))
5781 tramp-dos-coding-system))
5782 (p (if (and user (not (string= user "")))
5783 (apply #'start-process bufnam buf login-program
5784 real-host "-l" user login-args)
5785 (apply #'start-process bufnam buf login-program
5786 real-host login-args)))
5787 (found nil))
5788 (tramp-set-process-query-on-exit-flag p nil)
5789
5790 (set-buffer buf)
5791 (tramp-process-actions p multi-method method user host
5792 tramp-actions-before-shell 60)
5793 (tramp-message 7 "Initializing remote shell")
5794 (tramp-open-connection-setup-interactive-shell
5795 p multi-method method user host)
5796 (tramp-post-connection multi-method method user host)))))
5797
5798(defun tramp-open-connection-su (multi-method method user host)
5799 "Open a connection using the `su' program with METHOD.
5800This starts `su - USER', then waits for a password prompt. The HOST
5801name must be equal to the local host name or to `localhost'.
5802
5803If USER is nil, uses value returned by user-login-name instead.
5804
5805Recognition of the remote shell prompt is based on the variables
5806`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
5807set up correctly. Note that the other user may have a different shell
5808prompt than you do, so it is not at all unlikely that the variable
5809`shell-prompt-pattern' is set up wrongly!"
5810 (save-match-data
5811 (when (tramp-method-out-of-band-p multi-method method user host)
5812 (error "Cannot use out-of-band method `%s' with `su' connection method"
5813 method))
5814 (unless (or (string-match (concat "^" (regexp-quote host))
5815 (system-name))
5816 (string= "localhost" host)
5817 (string= "" host))
5818 (error
5819 "Cannot connect to different host `%s' with `su' connection method"
5820 host))
5821 (tramp-pre-connection multi-method method user host tramp-chunksize)
5822 (tramp-message 7 "Opening connection for `%s' using `%s'..."
5823 (or user "<root>") method)
5824 (let ((process-environment (copy-sequence process-environment)))
5825 (setenv "TERM" tramp-terminal-type)
5826 (setenv "PS1" "$ ")
5827 (let* ((default-directory (tramp-temporary-file-directory))
5828 ;; If we omit the conditional, we use `undecided-dos' in
5829 ;; some cases. With the conditional, we use nil in these
5830 ;; cases. What's the difference? Which one is right?
5831 (coding-system-for-read (unless (and (not (featurep 'xemacs))
5832 (> emacs-major-version 20))
5833 tramp-dos-coding-system))
5834 (p (apply 'start-process
5835 (tramp-buffer-name multi-method method user host)
5836 (tramp-get-buffer multi-method method user host)
5837 (tramp-get-method-parameter
5838 multi-method
5839 (tramp-find-method multi-method method user host)
5840 user host 'tramp-login-program)
5841 (mapcar
5842 (lambda (x)
5843 (format-spec x `((?u . ,(or user "root")))))
5844 (tramp-get-method-parameter
5845 multi-method
5846 (tramp-find-method multi-method method user host)
5847 user host 'tramp-login-args))))
5848 (found nil)
5849 (pw nil))
5850 (tramp-set-process-query-on-exit-flag p nil)
5851 (set-buffer (tramp-get-buffer multi-method method user host))
5852 (tramp-process-actions p multi-method method user host
5853 tramp-actions-before-shell 60)
5854 (tramp-open-connection-setup-interactive-shell
5855 p multi-method method user host)
5856 (tramp-post-connection multi-method method
5857 user host)))))
5858
5859;; HHH: Not Changed. Multi method. It is not clear to me how this can
5860;; handle not giving a user name in the "file name".
5861;;
5862;; This is more difficult than for the single-hop method. In the
5863;; multi-hop-method, the desired behaviour should be that the
5864;; user must specify names for the telnet hops of which the user
5865;; name is different than the "original" name (or different from
5866;; the previous hop.
5867(defun tramp-open-connection-multi (multi-method method user host)
5868 "Open a multi-hop connection using METHOD.
5869This uses a slightly changed file name syntax. The idea is to say
5870 [multi/telnet:u1@h1/rsh:u2@h2]/path/to/file
5871This will use telnet to log in as u1 to h1, then use rsh from there to
5872log in as u2 to h2."
5873 (save-match-data
5874 (unless multi-method
5875 (error "Multi-hop open connection function called on non-multi method"))
5876 (when (tramp-method-out-of-band-p multi-method method user host)
5877 (error "No out of band multi-hop connections"))
5878 (unless (and (arrayp method) (not (stringp method)))
5879 (error "METHOD must be an array of strings for multi methods"))
5880 (unless (and (arrayp user) (not (stringp user)))
5881 (error "USER must be an array of strings for multi methods"))
5882 (unless (and (arrayp host) (not (stringp host)))
5883 (error "HOST must be an array of strings for multi methods"))
5884 (unless (and (= (length method) (length user))
5885 (= (length method) (length host)))
5886 (error "Arrays METHOD, USER, HOST must have equal length"))
5887 (tramp-pre-connection multi-method method user host tramp-chunksize)
5888 (tramp-message 7 "Opening `%s' connection..." multi-method)
5889 (let ((process-environment (copy-sequence process-environment)))
5890 (setenv "TERM" tramp-terminal-type)
5891 (setenv "PS1" "$ ")
5892 (let* ((default-directory (tramp-temporary-file-directory))
5893 ;; If we omit the conditional, we use `undecided-dos' in
5894 ;; some cases. With the conditional, we use nil in these
5895 ;; cases. What's the difference? Which one is right?
5896 (coding-system-for-read (unless (and (not (featurep 'xemacs))
5897 (> emacs-major-version 20))
5898 tramp-dos-coding-system))
5899 (p (start-process (tramp-buffer-name multi-method method user host)
5900 (tramp-get-buffer multi-method method user host)
5901 tramp-multi-sh-program))
5902 (num-hops (length method))
5903 (i 0))
5904 (tramp-set-process-query-on-exit-flag p nil)
5905 (tramp-message 9 "Waiting 60s for local shell to come up...")
5906 (unless (tramp-wait-for-regexp
5907 p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'"
5908 shell-prompt-pattern tramp-shell-prompt-pattern))
5909 (pop-to-buffer (buffer-name))
5910 (kill-process p)
5911 (error "Couldn't find local shell prompt"))
5912 ;; Now do all the connections as specified.
5913 (while (< i num-hops)
5914 (let* ((m (aref method i))
5915 (u (aref user i))
5916 (h (aref host i))
5917 (entry (assoc m tramp-multi-connection-function-alist))
5918 (multi-func (nth 1 entry))
5919 (command (nth 2 entry)))
5920 ;; The multi-funcs don't need to do save-match-data, as that
5921 ;; is done here.
5922 (funcall multi-func p m u h command)
5923 (erase-buffer)
5924 (setq i (1+ i))))
5925 (tramp-open-connection-setup-interactive-shell
5926 p multi-method method user host)
5927 (tramp-post-connection multi-method method user host)))))
5928
5929;; HHH: Changed. Multi method. Don't know how to handle this in the case
5930;; of no user name provided. Hack to make it work as it did before:
5931;; changed `user' to `(or user (user-login-name))' in the places where
5932;; the value is actually used.
5933(defun tramp-multi-connect-telnet (p method user host command)
5934 "Issue `telnet' command.
5935Uses shell COMMAND to issue a `telnet' command to log in as USER to
5936HOST. You can use percent escapes in COMMAND: `%h' is replaced with
5937the host name, and `%n' is replaced with an end of line character, as
5938set in `tramp-rsh-end-of-line'. Use `%%' if you want a literal percent
5939character.
5940
5941If USER is nil, uses the return value of (user-login-name) instead."
5942 (let ((cmd (format-spec command
5943 `((?h . ,host) (?n . ,tramp-rsh-end-of-line))))
5944 (cmd1 (format-spec command `((?h . ,host) (?n . ""))))
5945 found pw)
5946 (erase-buffer)
5947 (tramp-message 9 "Sending telnet command `%s'" cmd1)
5948 (process-send-string p cmd)
5949 (tramp-process-multi-actions p method user host
5950 tramp-multi-actions)))
5951
5952;; HHH: Changed. Multi method. Don't know how to handle this in the case
5953;; of no user name provided. Hack to make it work as it did before:
5954;; changed `user' to `(or user (user-login-name))' in the places where
5955;; the value is actually used.
5956(defun tramp-multi-connect-rlogin (p method user host command)
5957 "Issue `rlogin' command.
5958Uses shell COMMAND to issue an `rlogin' command to log in as USER to
5959HOST. You can use percent escapes in COMMAND. `%u' will be replaced
5960with the user name, `%h' will be replaced with the host name, and `%n'
5961will be replaced with the value of `tramp-rsh-end-of-line'. You can use
5962`%%' if you want to use a literal percent character.
5963
5964If USER is nil, uses the return value of (user-login-name) instead."
5965 (let ((cmd (format-spec command `((?h . ,host)
5966 (?u . ,(or user (user-login-name)))
5967 (?n . ,tramp-rsh-end-of-line))))
5968 (cmd1 (format-spec command `((?h . ,host)
5969 (?u . ,(or user (user-login-name)))
5970 (?n . ""))))
5971 found)
5972 (erase-buffer)
5973 (tramp-message 9 "Sending rlogin command `%s'" cmd1)
5974 (process-send-string p cmd)
5975 (tramp-process-multi-actions p method user host
5976 tramp-multi-actions)))
5977
5978;; HHH: Changed. Multi method. Don't know how to handle this in the case
5979;; of no user name provided. Hack to make it work as it did before:
5980;; changed `user' to `(or user (user-login-name))' in the places where
5981;; the value is actually used.
5982(defun tramp-multi-connect-su (p method user host command)
5983 "Issue `su' command.
5984Uses shell COMMAND to issue a `su' command to log in as USER on
5985HOST. The HOST name is ignored, this just changes the user id on the
5986host currently logged in to.
5987
5988If USER is nil, uses the return value of (user-login-name) instead.
5989
5990You can use percent escapes in the COMMAND. `%u' is replaced with the
5991user name, and `%n' is replaced with the value of
5992`tramp-rsh-end-of-line'. Use `%%' if you want a literal percent
5993character."
5994 (let ((cmd (format-spec command `((?u . ,(or user (user-login-name)))
5995 (?n . ,tramp-rsh-end-of-line))))
5996 (cmd1 (format-spec command `((?u . ,(or user (user-login-name)))
5997 (?n . ""))))
5998 found)
5999 (erase-buffer)
6000 (tramp-message 9 "Sending su command `%s'" cmd1)
6001 (process-send-string p cmd)
6002 (tramp-process-multi-actions p method user host
6003 tramp-multi-actions)))
6004 5341
6005;; Utility functions. 5342;; Utility functions.
6006 5343
6007(defun tramp-accept-process-output 5344(defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
6008 (&optional process timeout timeout-msecs)
6009 "Like `accept-process-output' for Tramp processes. 5345 "Like `accept-process-output' for Tramp processes.
6010This is needed in order to hide `last-coding-system-used', which is set 5346This is needed in order to hide `last-coding-system-used', which is set
6011for process communication also." 5347for process communication also."
6012 (let (last-coding-system-used) 5348 (with-current-buffer (process-buffer proc)
6013 (accept-process-output process timeout timeout-msecs))) 5349 (tramp-message proc 10 "%s %s" proc (process-status proc))
5350 (let (buffer-read-only last-coding-system-used)
5351 ;; Under Windows XP, accept-process-output doesn't return
5352 ;; sometimes. So we add an additional timeout.
5353 (with-timeout ((or timeout 1))
5354 (accept-process-output proc timeout timeout-msecs)))
5355 (tramp-message proc 10 "\n%s" (buffer-string))))
5356
5357(defun tramp-check-for-regexp (proc regexp)
5358 "Check whether REGEXP is contained in process buffer of PROC.
5359Erase echoed commands if exists."
5360 (with-current-buffer (process-buffer proc)
5361 (goto-char (point-min))
5362 ;; Check whether we need to remove echo output.
5363 (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
5364 (re-search-forward tramp-echoed-echo-mark-regexp nil t))
5365 (let ((begin (match-beginning 0)))
5366 (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
5367 ;; Discard echo from remote output.
5368 (tramp-set-connection-property proc "check-remote-echo" nil)
5369 (tramp-message proc 5 "echo-mark found")
5370 (forward-line)
5371 (delete-region begin (point))
5372 (goto-char (point-min)))))
5373 ;; No echo to be handled, now we can look for the regexp.
5374 (when (not (tramp-get-connection-property proc "check-remote-echo" nil))
5375 (re-search-forward regexp nil t))))
6014 5376
6015(defun tramp-wait-for-regexp (proc timeout regexp) 5377(defun tramp-wait-for-regexp (proc timeout regexp)
6016 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds. 5378 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
6017Expects the output of PROC to be sent to the current buffer. Returns 5379Expects the output of PROC to be sent to the current buffer. Returns
6018the string that matched, or nil. Waits indefinitely if TIMEOUT is 5380the string that matched, or nil. Waits indefinitely if TIMEOUT is
6019nil." 5381nil."
6020 (let ((found nil) 5382 (with-current-buffer (process-buffer proc)
6021 (start-time (current-time))) 5383 (let ((found (tramp-check-for-regexp proc regexp))
6022 (cond (timeout 5384 (start-time (current-time)))
6023 ;; Work around a bug in XEmacs 21, where the timeout 5385 (cond (timeout
6024 ;; expires faster than it should. This degenerates 5386 ;; Work around a bug in XEmacs 21, where the timeout
6025 ;; to polling for buggy XEmacsen, but oh, well. 5387 ;; expires faster than it should. This degenerates
6026 (while (and (not found) 5388 ;; to polling for buggy XEmacsen, but oh, well.
6027 (< (tramp-time-diff (current-time) start-time) 5389 (while (and (not found)
6028 timeout)) 5390 (< (tramp-time-diff (current-time) start-time)
6029 (with-timeout (timeout) 5391 timeout))
6030 (while (not found) 5392 (with-timeout (timeout)
6031 (tramp-accept-process-output proc 1) 5393 (while (not found)
6032 (unless (memq (process-status proc) '(run open)) 5394 (tramp-accept-process-output proc 1)
6033 (error "Process has died")) 5395 (unless (memq (process-status proc) '(run open))
6034 (goto-char (point-min)) 5396 (tramp-error-with-buffer
6035 (setq found (re-search-forward regexp nil t)))))) 5397 nil proc 'file-error "Process has died"))
6036 (t 5398 (setq found (tramp-check-for-regexp proc regexp))))))
6037 (while (not found) 5399 (t
6038 (tramp-accept-process-output proc 1) 5400 (while (not found)
6039 (unless (memq (process-status proc) '(run open)) 5401 (tramp-accept-process-output proc 1)
6040 (error "Process has died")) 5402 (unless (memq (process-status proc) '(run open))
6041 (goto-char (point-min)) 5403 (tramp-error-with-buffer
6042 (setq found (re-search-forward regexp nil t))))) 5404 nil proc 'file-error "Process has died"))
6043 (when tramp-debug-buffer 5405 (setq found (tramp-check-for-regexp proc regexp)))))
6044 (append-to-buffer 5406 (tramp-message proc 6 "\n%s" (buffer-string))
6045 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
6046 tramp-current-user tramp-current-host)
6047 (point-min) (point-max))
6048 (when (not found) 5407 (when (not found)
6049 (save-excursion 5408 (if timeout
6050 (set-buffer 5409 (tramp-error
6051 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method 5410 proc 'file-error "[[Regexp `%s' not found in %d secs]]"
6052 tramp-current-user tramp-current-host)) 5411 regexp timeout)
6053 (goto-char (point-max)) 5412 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
6054 (insert "[[Regexp `" regexp "' not found" 5413 found)))
6055 (if timeout (format " in %d secs" timeout) "")
6056 "]]"))))
6057 found))
6058 5414
6059(defun tramp-wait-for-shell-prompt (proc timeout) 5415(defun tramp-wait-for-shell-prompt (proc timeout)
6060 "Wait for the shell prompt to appear from process PROC within TIMEOUT seconds. 5416 "Wait for the shell prompt to appear from process PROC within TIMEOUT seconds.
@@ -6071,51 +5427,23 @@ and `tramp-shell-prompt-pattern'."
6071Looks at process PROC to see if a shell prompt appears in TIMEOUT 5427Looks at process PROC to see if a shell prompt appears in TIMEOUT
6072seconds. If not, it produces an error message with the given ERROR-ARGS." 5428seconds. If not, it produces an error message with the given ERROR-ARGS."
6073 (unless (tramp-wait-for-shell-prompt proc timeout) 5429 (unless (tramp-wait-for-shell-prompt proc timeout)
6074 (pop-to-buffer (buffer-name)) 5430 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
6075 (apply 'error error-args))) 5431
6076 5432;; We don't call `tramp-send-string' in order to hide the password from the
6077(defun tramp-enter-password (p prompt user host) 5433;; debug buffer, and because end-of-line handling of the string.
6078 "Prompt for a password and send it to the remote end. 5434(defun tramp-enter-password (p)
6079Uses PROMPT as a prompt and sends the password to process P." 5435 "Prompt for a password and send it to the remote end."
6080 (let ((pw (tramp-read-passwd user host prompt))) 5436 (process-send-string
6081 (erase-buffer) 5437 p (concat (tramp-read-passwd p)
6082 (process-send-string 5438 (or (tramp-get-method-parameter
6083 p (concat pw 5439 tramp-current-method
6084 (or (tramp-get-method-parameter 5440 'tramp-password-end-of-line)
6085 tramp-current-multi-method 5441 tramp-default-password-end-of-line))))
6086 tramp-current-method 5442
6087 tramp-current-user 5443(defun tramp-open-connection-setup-interactive-shell (proc vec)
6088 tramp-current-host
6089 'tramp-password-end-of-line)
6090 tramp-default-password-end-of-line)))))
6091
6092;; HHH: Not Changed. This might handle the case where USER is not
6093;; given in the "File name" very poorly. Then, the local
6094;; variable tramp-current-user will be set to nil.
6095(defun tramp-pre-connection (multi-method method user host chunksize)
6096 "Do some setup before actually logging in.
6097METHOD, USER and HOST specify the connection."
6098 (set-buffer (tramp-get-buffer multi-method method user host))
6099 (set (make-local-variable 'tramp-current-multi-method) multi-method)
6100 (set (make-local-variable 'tramp-current-method) method)
6101 (set (make-local-variable 'tramp-current-user) user)
6102 (set (make-local-variable 'tramp-current-host) host)
6103 (set (make-local-variable 'tramp-chunksize) chunksize)
6104 (set (make-local-variable 'inhibit-eol-conversion) nil)
6105 (erase-buffer))
6106
6107(defun tramp-open-connection-setup-interactive-shell
6108 (p multi-method method user host)
6109 "Set up an interactive shell. 5444 "Set up an interactive shell.
6110Mainly sets the prompt and the echo correctly. P is the shell process 5445Mainly sets the prompt and the echo correctly. PROC is the shell
6111to set up. METHOD, USER and HOST specify the connection." 5446process to set up. VEC specifies the connection."
6112 ;; Wait a bit in case the remote end feels like sending a little
6113 ;; junk first. It seems that fencepost.gnu.org does this when doing
6114 ;; a Kerberos login.
6115 (sit-for 1)
6116 (tramp-discard-garbage-erase-buffer p multi-method method user host)
6117 (tramp-process-initial-commands p multi-method method user host
6118 tramp-initial-commands)
6119 ;; It is useful to set the prompt in the following command because 5447 ;; It is useful to set the prompt in the following command because
6120 ;; some people have a setting for $PS1 which /bin/sh doesn't know 5448 ;; some people have a setting for $PS1 which /bin/sh doesn't know
6121 ;; about and thus /bin/sh will display a strange prompt. For 5449 ;; about and thus /bin/sh will display a strange prompt. For
@@ -6129,116 +5457,84 @@ to set up. METHOD, USER and HOST specify the connection."
6129 ;; called as sh) on startup; this way, we avoid the startup file 5457 ;; called as sh) on startup; this way, we avoid the startup file
6130 ;; clobbering $PS1. 5458 ;; clobbering $PS1.
6131 (tramp-send-command-internal 5459 (tramp-send-command-internal
6132 multi-method method user host 5460 vec
6133 (format "exec env 'ENV=' 'PS1=$ ' %s" 5461 (format "exec env 'ENV=' 'PS1=$ ' %s"
6134 (tramp-get-method-parameter 5462 (tramp-get-method-parameter
6135 multi-method method user host 'tramp-remote-sh)) 5463 (tramp-file-name-method vec) 'tramp-remote-sh)))
6136 (format "remote `%s' to come up" 5464 (tramp-message vec 5 "Setting up remote shell environment")
6137 (tramp-get-method-parameter 5465 (tramp-send-command-internal vec "stty -inlcr -echo kill '^U' erase '^H'")
6138 multi-method method user host 'tramp-remote-sh))) 5466 ;; Check whether the echo has really been disabled. Some
6139 (tramp-barf-if-no-shell-prompt 5467 ;; implementations, like busybox of embedded GNU/Linux, don't
6140 p 30 5468 ;; support disabling.
6141 "Remote `%s' didn't come up. See buffer `%s' for details" 5469 (tramp-send-command-internal vec "echo foo")
6142 (tramp-get-method-parameter multi-method method user host 'tramp-remote-sh) 5470 (with-current-buffer (process-buffer proc)
6143 (buffer-name))
6144 (tramp-message 8 "Setting up remote shell environment")
6145 (tramp-discard-garbage-erase-buffer p multi-method method user host)
6146 (tramp-send-command-internal multi-method method user host
6147 "stty -inlcr -echo kill '^U'")
6148 (erase-buffer)
6149 ;; Ignore garbage after stty command.
6150 (tramp-send-command-internal multi-method method user host
6151 "echo foo")
6152 (erase-buffer)
6153 (tramp-send-command-internal multi-method method user host
6154 "TERM=dumb; export TERM")
6155 (erase-buffer)
6156 ;; Check whether the remote host suffers from buggy `send-process-string'.
6157 ;; This is known for FreeBSD (see comment in `send_process', file process.c).
6158 ;; I've tested sending 624 bytes successfully, sending 625 bytes failed.
6159 ;; Emacs makes a hack when this host type is detected locally. It cannot
6160 ;; handle remote hosts, though.
6161 (when (or (not tramp-chunksize) (zerop tramp-chunksize))
6162 (tramp-message 9 "Checking remote host type for `send-process-string' bug")
6163 (tramp-send-command-internal multi-method method user host
6164 "(uname -sr) 2>/dev/null")
6165 (goto-char (point-min)) 5471 (goto-char (point-min))
6166 (when (looking-at "FreeBSD") 5472 (when (looking-at "echo foo")
6167 (setq tramp-chunksize 500))) 5473 (tramp-set-connection-property vec "remote-echo" t)
6168 5474 (tramp-message vec 5 "Remote echo still on. Ok.")
5475 ;; Make sure backspaces and their echo are enabled and no line
5476 ;; width magic interferes with them.
5477 (tramp-send-command-internal vec "stty icanon erase ^H cols 32767")))
6169 ;; Try to set up the coding system correctly. 5478 ;; Try to set up the coding system correctly.
6170 ;; CCC this can't be the right way to do it. Hm. 5479 ;; CCC this can't be the right way to do it. Hm.
6171 (save-excursion 5480 (tramp-message vec 5 "Determining coding system")
6172 (erase-buffer) 5481 (tramp-send-command-internal vec "echo foo ; echo bar")
6173 (tramp-message 9 "Determining coding system") 5482 (with-current-buffer (process-buffer proc)
6174 (tramp-send-command-internal multi-method method user host
6175 "echo foo ; echo bar")
6176 (goto-char (point-min)) 5483 (goto-char (point-min))
6177 (if (featurep 'mule) 5484 (if (featurep 'mule)
6178 ;; Use MULE to select the right EOL convention for communicating 5485 ;; Use MULE to select the right EOL convention for communicating
6179 ;; with the process. 5486 ;; with the process.
6180 (let* ((cs (or (process-coding-system p) (cons 'undecided 'undecided))) 5487 (let* ((cs (or (process-coding-system proc)
6181 cs-decode cs-encode) 5488 (cons 'undecided 'undecided)))
6182 (when (symbolp cs) (setq cs (cons cs cs))) 5489 cs-decode cs-encode)
6183 (setq cs-decode (car cs)) 5490 (when (symbolp cs) (setq cs (cons cs cs)))
6184 (setq cs-encode (cdr cs)) 5491 (setq cs-decode (car cs))
6185 (unless cs-decode (setq cs-decode 'undecided)) 5492 (setq cs-encode (cdr cs))
6186 (unless cs-encode (setq cs-encode 'undecided)) 5493 (unless cs-decode (setq cs-decode 'undecided))
6187 (setq cs-encode (tramp-coding-system-change-eol-conversion 5494 (unless cs-encode (setq cs-encode 'undecided))
6188 cs-encode 'unix)) 5495 (setq cs-encode (tramp-coding-system-change-eol-conversion
6189 (when (search-forward "\r" nil t) 5496 cs-encode 'unix))
6190 (setq cs-decode (tramp-coding-system-change-eol-conversion 5497 (when (search-forward "\r" nil t)
6191 cs-decode 'dos))) 5498 (setq cs-decode (tramp-coding-system-change-eol-conversion
6192 (set-buffer-process-coding-system cs-decode cs-encode)) 5499 cs-decode 'dos)))
5500 (set-buffer-process-coding-system cs-decode cs-encode))
6193 ;; Look for ^M and do something useful if found. 5501 ;; Look for ^M and do something useful if found.
6194 (when (search-forward "\r" nil t) 5502 (when (search-forward "\r" nil t)
6195 ;; We have found a ^M but cannot frob the process coding system 5503 ;; We have found a ^M but cannot frob the process coding system
6196 ;; because we're running on a non-MULE Emacs. Let's try 5504 ;; because we're running on a non-MULE Emacs. Let's try
6197 ;; stty, instead. 5505 ;; stty, instead.
6198 (erase-buffer) 5506 (tramp-send-command-internal vec "stty -onlcr"))))
6199 (tramp-message 9 "Trying `stty -onlcr'") 5507 (tramp-send-command-internal vec "set +o vi +o emacs")
6200 (tramp-send-command-internal multi-method method user host 5508 (tramp-message vec 5 "Setting shell prompt")
6201 "stty -onlcr"))))
6202 (erase-buffer)
6203 (tramp-message
6204 9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE'")
6205 (tramp-send-command-internal
6206 multi-method method user host
6207 "HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE")
6208 (erase-buffer)
6209 (tramp-message 9 "Waiting 30s for `set +o vi +o emacs'")
6210 (tramp-send-command-internal multi-method method user host
6211 "set +o vi +o emacs")
6212 (erase-buffer)
6213 (tramp-message 9 "Waiting 30s for `unset MAIL MAILCHECK MAILPATH'")
6214 (tramp-send-command-internal
6215 multi-method method user host
6216 "unset MAIL MAILCHECK MAILPATH 1>/dev/null 2>/dev/null")
6217 (erase-buffer)
6218 (tramp-message 9 "Waiting 30s for `unset CDPATH'")
6219 (tramp-send-command-internal multi-method method user host
6220 "unset CDPATH")
6221 (erase-buffer)
6222 (tramp-message 9 "Setting shell prompt")
6223 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must 5509 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must
6224 ;; use "\n" here, not tramp-rsh-end-of-line. We also manually frob 5510 ;; use "\n" here, not tramp-rsh-end-of-line. We also manually frob
6225 ;; the last time we sent a command, to avoid tramp-send-command to send 5511 ;; the last time we sent a command, to avoid `tramp-send-command' to
6226 ;; "echo are you awake". 5512 ;; send "echo are you awake".
6227 (setq tramp-last-cmd-time (current-time))
6228 (tramp-send-command 5513 (tramp-send-command
6229 multi-method method user host 5514 vec
6230 (format "PS1='%s%s%s'; PS2=''; PS3=''" 5515 (format "PS1='%s%s%s'; PS2=''; PS3=''"
6231 tramp-rsh-end-of-line 5516 tramp-rsh-end-of-line
6232 tramp-end-of-output 5517 tramp-end-of-output
6233 tramp-rsh-end-of-line)) 5518 tramp-rsh-end-of-line))
6234 (tramp-wait-for-output)) 5519 ;; Check whether the remote host suffers from buggy `send-process-string'.
6235 5520 ;; This is known for FreeBSD (see comment in `send_process', file process.c).
6236(defun tramp-post-connection (multi-method method user host) 5521 ;; I've tested sending 624 bytes successfully, sending 625 bytes failed.
6237 "Prepare a remote shell before being able to work on it. 5522 ;; Emacs makes a hack when this host type is detected locally. It cannot
6238METHOD, USER and HOST specify the connection. 5523 ;; handle remote hosts, though.
6239Among other things, this finds a shell which groks tilde expansion, 5524 (with-connection-property proc "chunksize"
6240tries to find an `ls' command which groks the `-n' option, sets the 5525 (cond
6241locale to C and sets up the remote shell search path." 5526 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
5527 tramp-chunksize)
5528 (t
5529 (tramp-message
5530 vec 5 "Checking remote host type for `send-process-string' bug")
5531 (if (string-match
5532 "^FreeBSD"
5533 (with-connection-property vec "uname"
5534 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))
5535 500 0))))
5536 ;; Set remote PATH variable.
5537 (tramp-set-remote-path vec)
6242 ;; Search for a good shell before searching for a command which 5538 ;; Search for a good shell before searching for a command which
6243 ;; checks if a file exists. This is done because Tramp wants to use 5539 ;; checks if a file exists. This is done because Tramp wants to use
6244 ;; "test foo; echo $?" to check if various conditions hold, and 5540 ;; "test foo; echo $?" to check if various conditions hold, and
@@ -6247,168 +5543,23 @@ locale to C and sets up the remote shell search path."
6247 ;; the Solaris /bin/sh is a problem. I'm betting that all systems 5543 ;; the Solaris /bin/sh is a problem. I'm betting that all systems
6248 ;; with buggy /bin/sh implementations will have a working bash or 5544 ;; with buggy /bin/sh implementations will have a working bash or
6249 ;; ksh. Whee... 5545 ;; ksh. Whee...
6250 (tramp-find-shell multi-method method user host) 5546 (tramp-find-shell vec)
6251 ;; Without (sit-for 0.1) at least, my machine will almost always blow 5547 ;; Disable unexpected output.
6252 ;; up on 'not numberp /root' - a race that causes the 'echo ~root' 5548 (tramp-send-command vec "mesg n; biff n")
6253 ;; output of (tramp-find-shell) to show up along with the output of 5549 ;; Set the environment.
6254 ;; (tramp-find-ls-command) testing. 5550 (tramp-message vec 5 "Setting default environment")
6255 ;; 5551 (let ((env (copy-sequence tramp-remote-process-environment))
6256 ;; I can't work out why this is a problem though. The (tramp-wait-for-output) 5552 unset item)
6257 ;; call in (tramp-find-shell) *should* make this not happen, I thought. 5553 (while env
6258 ;; 5554 (setq item (split-string (car env) "="))
6259 ;; After much debugging I couldn't find any problem with the implementation 5555 (if (and (stringp (cadr item)) (not (string-equal (cadr item) "")))
6260 ;; of that function though. The workaround stays for me at least. :/ 5556 (tramp-send-command
6261 ;; 5557 vec (format "%s=%s; export %s" (car item) (cadr item) (car item)))
6262 ;; Daniel Pittman <daniel@danann.net> 5558 (push (car item) unset))
6263 (sleep-for 1) 5559 (setq env (cdr env)))
6264 (erase-buffer) 5560 (when unset
6265 (tramp-find-file-exists-command multi-method method user host)
6266 (make-local-variable 'tramp-ls-command)
6267 (setq tramp-ls-command (tramp-find-ls-command multi-method method user host))
6268 (unless tramp-ls-command
6269 (tramp-message
6270 1
6271 "Danger! Couldn't find ls which groks -n. Muddling through anyway")
6272 (setq tramp-ls-command
6273 (tramp-find-executable multi-method method user host
6274 "ls" tramp-remote-path nil)))
6275 (unless tramp-ls-command
6276 (error "Fatal error: Couldn't find remote executable `ls'"))
6277 (tramp-message 5 "Using remote command `%s' for getting directory listings"
6278 tramp-ls-command)
6279 (tramp-send-command multi-method method user host
6280 (concat "tramp_set_exit_status () {" tramp-rsh-end-of-line
6281 "return $1" tramp-rsh-end-of-line
6282 "}"))
6283 (tramp-wait-for-output)
6284 ;; Set remote PATH variable.
6285 (tramp-set-remote-path multi-method method user host "PATH" tramp-remote-path)
6286 ;; Tell remote shell to use standard time format, needed for
6287 ;; parsing `ls -l' output.
6288 (tramp-send-command multi-method method user host
6289 "LC_TIME=C; export LC_TIME; echo huhu")
6290 (tramp-wait-for-output)
6291 (tramp-send-command multi-method method user host
6292 "mesg n; echo huhu")
6293 (tramp-wait-for-output)
6294 (tramp-send-command multi-method method user host
6295 "biff n ; echo huhu")
6296 (tramp-wait-for-output)
6297 ;; Unalias ls(1) to work around issues with those silly people who make it
6298 ;; spit out ANSI escapes or whatever.
6299 (tramp-send-command multi-method method user host
6300 "unalias ls; echo huhu")
6301 (tramp-wait-for-output)
6302 ;; Does `test A -nt B' work? Use abominable `find' construct if it
6303 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
6304 ;; for otherwise the shell crashes.
6305 (erase-buffer)
6306 (make-local-variable 'tramp-test-groks-nt)
6307 (tramp-send-command multi-method method user host
6308 "( test / -nt / )")
6309 (tramp-wait-for-output)
6310 (goto-char (point-min))
6311 (setq tramp-test-groks-nt
6312 (looking-at (format "\n%s\r?\n" (regexp-quote tramp-end-of-output))))
6313 (unless tramp-test-groks-nt
6314 (tramp-send-command
6315 multi-method method user host
6316 (concat "tramp_test_nt () {" tramp-rsh-end-of-line
6317 "test -n \"`find $1 -prune -newer $2 -print`\"" tramp-rsh-end-of-line
6318 "}")))
6319 (tramp-wait-for-output)
6320 ;; Send the fallback `uudecode' script.
6321 (erase-buffer)
6322 (tramp-send-string multi-method method user host tramp-uudecode)
6323 (tramp-wait-for-output)
6324 ;; Find a `perl'.
6325 (erase-buffer)
6326 (tramp-set-connection-property "perl-scripts" nil multi-method method user host)
6327 (let ((tramp-remote-perl
6328 (or (tramp-find-executable multi-method method user host
6329 "perl5" tramp-remote-path nil)
6330 (tramp-find-executable multi-method method user host
6331 "perl" tramp-remote-path nil))))
6332 (when tramp-remote-perl
6333 (tramp-set-connection-property "perl" tramp-remote-perl
6334 multi-method method user host)
6335 (unless (tramp-method-out-of-band-p multi-method method user host)
6336 (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
6337 (tramp-send-string
6338 multi-method method user host
6339 (concat "tramp_encode () {\n"
6340 (format tramp-perl-encode tramp-remote-perl)
6341 " 2>/dev/null"
6342 "\n}"))
6343 (tramp-wait-for-output)
6344 (tramp-send-string
6345 multi-method method user host
6346 (concat "tramp_encode_with_module () {\n"
6347 (format tramp-perl-encode-with-module tramp-remote-perl)
6348 " 2>/dev/null"
6349 "\n}"))
6350 (tramp-wait-for-output)
6351 (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
6352 (tramp-send-string
6353 multi-method method user host
6354 (concat "tramp_decode () {\n"
6355 (format tramp-perl-decode tramp-remote-perl)
6356 " 2>/dev/null"
6357 "\n}"))
6358 (tramp-wait-for-output)
6359 (tramp-send-string
6360 multi-method method user host
6361 (concat "tramp_decode_with_module () {\n"
6362 (format tramp-perl-decode-with-module tramp-remote-perl)
6363 " 2>/dev/null"
6364 "\n}"))
6365 (tramp-wait-for-output))))
6366 ;; Find ln(1)
6367 (erase-buffer)
6368 (let ((ln (tramp-find-executable multi-method method user host
6369 "ln" tramp-remote-path nil)))
6370 (when ln
6371 (tramp-set-connection-property "ln" ln multi-method method user host)))
6372 ;; Set uid and gid.
6373 (erase-buffer)
6374 (tramp-send-command multi-method method user host "id -u; id -g")
6375 (tramp-wait-for-output)
6376 (goto-char (point-min))
6377 (tramp-set-connection-property
6378 "uid" (read (current-buffer)) multi-method method user host)
6379 (tramp-set-connection-property
6380 "gid" (read (current-buffer)) multi-method method user host)
6381 ;; Find the right encoding/decoding commands to use.
6382 (erase-buffer)
6383 (unless (tramp-method-out-of-band-p multi-method method user host)
6384 (tramp-find-inline-encoding multi-method method user host))
6385 ;; If encoding/decoding command are given, test to see if they work.
6386 ;; CCC: Maybe it would be useful to run the encoder both locally and
6387 ;; remotely to see if they produce the same result.
6388 (let ((rem-enc (tramp-get-remote-encoding multi-method method user host))
6389 (rem-dec (tramp-get-remote-decoding multi-method method user host))
6390 (magic-string "xyzzy"))
6391 (when (and (or rem-dec rem-enc) (not (and rem-dec rem-enc)))
6392 (tramp-kill-process multi-method method user host)
6393 ;; Improve error message and/or error check.
6394 (error
6395 "Must give both decoding and encoding command in method definition"))
6396 (when (and rem-enc rem-dec)
6397 (tramp-message
6398 5
6399 "Checking to see if encoding/decoding commands work on remote host...")
6400 (tramp-send-command 5561 (tramp-send-command
6401 multi-method method user host 5562 vec (format "unset %s" (mapconcat 'identity unset " "))))))
6402 (format "echo %s | %s | %s"
6403 (tramp-shell-quote-argument magic-string) rem-enc rem-dec))
6404 (tramp-wait-for-output)
6405 (unless (looking-at (regexp-quote magic-string))
6406 (tramp-kill-process multi-method method user host)
6407 (error "Remote host cannot execute de/encoding commands. See buffer `%s' for details"
6408 (buffer-name)))
6409 (erase-buffer)
6410 (tramp-message
6411 5 "Checking to see if encoding/decoding commands work on remote host...done"))))
6412 5563
6413;; CCC: We should either implement a Perl version of base64 encoding 5564;; CCC: We should either implement a Perl version of base64 encoding
6414;; and decoding. Then we just use that in the last item. The other 5565;; and decoding. Then we just use that in the last item. The other
@@ -6428,38 +5579,22 @@ locale to C and sets up the remote shell search path."
6428;; 5579;;
6429;; For Irix, no solution is known yet. 5580;; For Irix, no solution is known yet.
6430 5581
6431(defvar tramp-coding-commands 5582(defconst tramp-local-coding-commands
6432 '(("mimencode -b" "mimencode -u -b" 5583 '((b64 base64-encode-region base64-decode-region)
6433 base64-encode-region base64-decode-region) 5584 (uu tramp-uuencode-region uudecode-decode-region)
6434 ("mmencode -b" "mmencode -u -b" 5585 (pack
6435 base64-encode-region base64-decode-region) 5586 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
6436 ("recode data..base64" "recode base64..data" 5587 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
6437 base64-encode-region base64-decode-region) 5588 "List of local coding commands for inline transfer.
6438 ("uuencode xxx" "uudecode -o /dev/stdout"
6439 tramp-uuencode-region uudecode-decode-region)
6440 ("uuencode xxx" "uudecode -o -"
6441 tramp-uuencode-region uudecode-decode-region)
6442 ("uuencode xxx" "uudecode -p"
6443 tramp-uuencode-region uudecode-decode-region)
6444 ("uuencode xxx" "tramp_uudecode"
6445 tramp-uuencode-region uudecode-decode-region)
6446 ("tramp_encode_with_module" "tramp_decode_with_module"
6447 base64-encode-region base64-decode-region)
6448 ("tramp_encode" "tramp_decode"
6449 base64-encode-region base64-decode-region))
6450 "List of coding commands for inline transfer.
6451Each item is a list that looks like this: 5589Each item is a list that looks like this:
6452 5590
6453\(REMOTE-ENCODING REMOTE-DECODING LOCAL-ENCODING LOCAL-DECODING) 5591\(FORMAT ENCODING DECODING)
6454 5592
6455The REMOTE-ENCODING should be a string, giving a command accepting a 5593FORMAT is symbol describing the encoding/decoding format. It can be
6456plain file on standard input and writing the encoded file to standard 5594`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
6457output. The REMOTE-DECODING should also be a string, giving a command
6458accepting an encoded file on standard input and writing the decoded
6459file to standard output.
6460 5595
6461LOCAL-ENCODING and LOCAL-DECODING can be strings, giving commands, or 5596ENCODING and DECODING can be strings, giving commands, or symbols,
6462symbols, giving functions. If they are strings, then they can contain 5597giving functions. If they are strings, then they can contain
6463the \"%s\" format specifier. If that specifier is present, the input 5598the \"%s\" format specifier. If that specifier is present, the input
6464filename will be put into the command line at that spot. If the 5599filename will be put into the command line at that spot. If the
6465specifier is not present, the input should be read from standard 5600specifier is not present, the input should be read from standard
@@ -6469,83 +5604,139 @@ If they are functions, they will be called with two arguments, start
6469and end of region, and are expected to replace the region contents 5604and end of region, and are expected to replace the region contents
6470with the encoded or decoded results, respectively.") 5605with the encoded or decoded results, respectively.")
6471 5606
6472(defun tramp-find-inline-encoding (multi-method method user host) 5607(defconst tramp-remote-coding-commands
5608 '((b64 "mimencode -b" "mimencode -u -b")
5609 (b64 "mmencode -b" "mmencode -u -b")
5610 (b64 "recode data..base64" "recode base64..data")
5611 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
5612 (b64 tramp-perl-encode tramp-perl-decode)
5613 (uu "uuencode xxx" "uudecode -o /dev/stdout")
5614 (uu "uuencode xxx" "uudecode -o -")
5615 (uu "uuencode xxx" "uudecode -p")
5616 (uu "uuencode xxx" tramp-uudecode)
5617 (pack
5618 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
5619 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
5620 "List of remote coding commands for inline transfer.
5621Each item is a list that looks like this:
5622
5623\(FORMAT ENCODING DECODING)
5624
5625FORMAT is symbol describing the encoding/decoding format. It can be
5626`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
5627
5628ENCODING and DECODING can be strings, giving commands, or symbols,
5629giving variables. If they are strings, then they can contain
5630the \"%s\" format specifier. If that specifier is present, the input
5631filename will be put into the command line at that spot. If the
5632specifier is not present, the input should be read from standard
5633input.
5634
5635If they are variables, this variable is a string containing a Perl
5636implementation for this functionality. This Perl program will be transferred
5637to the remote host, and it is avalible as shell function with the same name.")
5638
5639(defun tramp-find-inline-encoding (vec)
6473 "Find an inline transfer encoding that works. 5640 "Find an inline transfer encoding that works.
6474Goes through the list `tramp-coding-commands'." 5641Goes through the list `tramp-local-coding-commands' and
6475 (let ((commands tramp-coding-commands) 5642`tramp-remote-coding-commands'."
6476 (magic "xyzzy") 5643 (save-excursion
6477 item found) 5644 (let ((local-commands tramp-local-coding-commands)
6478 (while (and commands (null found)) 5645 (magic "xyzzy")
6479 (setq item (pop commands)) 5646 loc-enc loc-dec rem-enc rem-dec litem ritem found)
6480 (catch 'wont-work 5647 (while (and local-commands (not found))
6481 (let ((rem-enc (nth 0 item)) 5648 (setq litem (pop local-commands))
6482 (rem-dec (nth 1 item)) 5649 (catch 'wont-work-local
6483 (loc-enc (nth 2 item)) 5650 (let ((format (nth 0 litem))
6484 (loc-dec (nth 3 item))) 5651 (remote-commands tramp-remote-coding-commands))
6485 ;; Check if remote encoding and decoding commands can be 5652 (setq loc-enc (nth 1 litem))
6486 ;; called remotely with null input and output. This makes 5653 (setq loc-dec (nth 2 litem))
6487 ;; sure there are no syntax errors and the command is really 5654 ;; If the local encoder or decoder is a string, the
6488 ;; found. Note that we do not redirect stdout to /dev/null, 5655 ;; corresponding command has to work locally.
6489 ;; for two reaons: when checking the decoding command, we 5656 (if (not (stringp loc-enc))
6490 ;; actually check the output it gives. And also, when 5657 (tramp-message
6491 ;; redirecting "mimencode" output to /dev/null, then as root 5658 vec 5 "Checking local encoding function `%s'" loc-enc)
6492 ;; it might change the permissions of /dev/null! 5659 (tramp-message
6493 (tramp-message-for-buffer 5660 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
6494 multi-method method user host 9 5661 (unless (zerop (tramp-call-local-coding-command
6495 "Checking remote encoding command `%s' for sanity" rem-enc) 5662 loc-enc nil nil))
6496 (unless (zerop (tramp-send-command-and-check 5663 (throw 'wont-work-local nil)))
6497 multi-method method user host 5664 (if (not (stringp loc-dec))
6498 (format "%s </dev/null" rem-enc) t)) 5665 (tramp-message
6499 (throw 'wont-work nil)) 5666 vec 5 "Checking local decoding function `%s'" loc-dec)
6500 (tramp-message-for-buffer 5667 (tramp-message
6501 multi-method method user host 9 5668 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
6502 "Checking remote decoding command `%s' for sanity" rem-dec) 5669 (unless (zerop (tramp-call-local-coding-command
6503 (unless (zerop (tramp-send-command-and-check 5670 loc-dec nil nil))
6504 multi-method method user host 5671 (throw 'wont-work-local nil)))
6505 (format "echo %s | %s | %s" 5672 ;; Search for remote coding commands with the same format
6506 magic rem-enc rem-dec) t)) 5673 (while (and remote-commands (not found))
6507 (throw 'wont-work nil)) 5674 (setq ritem (pop remote-commands))
6508 (save-excursion 5675 (catch 'wont-work-remote
6509 (goto-char (point-min)) 5676 (when (equal format (nth 0 ritem))
6510 (unless (looking-at (regexp-quote magic)) 5677 (setq rem-enc (nth 1 ritem))
6511 (throw 'wont-work nil))) 5678 (setq rem-dec (nth 2 ritem))
6512 ;; If the local encoder or decoder is a string, the 5679 ;; Check if remote encoding and decoding commands can be
6513 ;; corresponding command has to work locally. 5680 ;; called remotely with null input and output. This makes
6514 (when (stringp loc-enc) 5681 ;; sure there are no syntax errors and the command is really
6515 (tramp-message-for-buffer 5682 ;; found. Note that we do not redirect stdout to /dev/null,
6516 multi-method method user host 9 5683 ;; for two reasons: when checking the decoding command, we
6517 "Checking local encoding command `%s' for sanity" loc-enc) 5684 ;; actually check the output it gives. And also, when
6518 (unless (zerop (tramp-call-local-coding-command 5685 ;; redirecting "mimencode" output to /dev/null, then as root
6519 loc-enc nil nil)) 5686 ;; it might change the permissions of /dev/null!
6520 (throw 'wont-work nil))) 5687 (when (not (stringp rem-enc))
6521 (when (stringp loc-dec) 5688 (let ((name (symbol-name rem-enc)))
6522 (tramp-message-for-buffer 5689 (while (string-match (regexp-quote "-") name)
6523 multi-method method user host 9 5690 (setq name (replace-match "_" nil t name)))
6524 "Checking local decoding command `%s' for sanity" loc-dec) 5691 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
6525 (unless (zerop (tramp-call-local-coding-command 5692 (setq rem-enc name)))
6526 loc-dec nil nil)) 5693 (tramp-message
6527 (throw 'wont-work nil))) 5694 vec 5
6528 ;; CCC: At this point, maybe we should check that the output 5695 "Checking remote encoding command `%s' for sanity" rem-enc)
6529 ;; of the commands is correct. But for the moment we will 5696 (unless (zerop (tramp-send-command-and-check
6530 ;; assume that commands working on empty input will also 5697 vec (format "%s </dev/null" rem-enc) t))
6531 ;; work in practice. 5698 (throw 'wont-work-remote nil))
6532 (setq found item)))) 5699
6533 ;; Did we find something? If not, issue error. If so, 5700 (when (not (stringp rem-dec))
6534 ;; set connection properties. 5701 (let ((name (symbol-name rem-dec)))
6535 (unless found 5702 (while (string-match (regexp-quote "-") name)
6536 (error "Couldn't find an inline transfer encoding")) 5703 (setq name (replace-match "_" nil t name)))
6537 (let ((rem-enc (nth 0 found)) 5704 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
6538 (rem-dec (nth 1 found)) 5705 (setq rem-dec name)))
6539 (loc-enc (nth 2 found)) 5706 (tramp-message
6540 (loc-dec (nth 3 found))) 5707 vec 5
6541 (tramp-message 10 "Using remote encoding %s" rem-enc) 5708 "Checking remote decoding command `%s' for sanity" rem-dec)
6542 (tramp-set-remote-encoding multi-method method user host rem-enc) 5709 (unless (zerop (tramp-send-command-and-check
6543 (tramp-message 10 "Using remote decoding %s" rem-dec) 5710 vec
6544 (tramp-set-remote-decoding multi-method method user host rem-dec) 5711 (format "echo %s | %s | %s"
6545 (tramp-message 10 "Using local encoding %s" loc-enc) 5712 magic rem-enc rem-dec) t))
6546 (tramp-set-local-encoding multi-method method user host loc-enc) 5713 (throw 'wont-work-remote nil))
6547 (tramp-message 10 "Using local decoding %s" loc-dec) 5714
6548 (tramp-set-local-decoding multi-method method user host loc-dec)))) 5715 (with-current-buffer (tramp-get-buffer vec)
5716 (goto-char (point-min))
5717 (unless (looking-at (regexp-quote magic))
5718 (throw 'wont-work-remote nil)))
5719
5720 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
5721 (setq rem-enc (nth 1 ritem))
5722 (setq rem-dec (nth 2 ritem))
5723 (setq found t)))))))
5724
5725 ;; Did we find something? If not, issue an error.
5726 (unless found
5727 (kill-process (tramp-get-connection-process vec))
5728 (tramp-error
5729 vec 'file-error "Couldn't find an inline transfer encoding"))
5730
5731 ;; Set connection properties.
5732 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
5733 (tramp-set-connection-property vec "local-encoding" loc-enc)
5734 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
5735 (tramp-set-connection-property vec "local-decoding" loc-dec)
5736 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
5737 (tramp-set-connection-property vec "remote-encoding" rem-enc)
5738 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
5739 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
6549 5740
6550(defun tramp-call-local-coding-command (cmd input output) 5741(defun tramp-call-local-coding-command (cmd input output)
6551 "Call the local encoding or decoding command. 5742 "Call the local encoding or decoding command.
@@ -6555,25 +5746,114 @@ INPUT can also be nil which means `/dev/null'.
6555OUTPUT can be a string (which specifies a filename), or t (which 5746OUTPUT can be a string (which specifies a filename), or t (which
6556means standard output and thus the current buffer), or nil (which 5747means standard output and thus the current buffer), or nil (which
6557means discard it)." 5748means discard it)."
6558 (call-process 5749 (let ((default-directory (tramp-temporary-file-directory)))
6559 tramp-encoding-shell ;program 5750 (call-process
6560 (when (and input (not (string-match "%s" cmd))) 5751 tramp-encoding-shell ;program
6561 input) ;input 5752 (when (and input (not (string-match "%s" cmd)))
6562 (if (eq output t) t nil) ;output 5753 input) ;input
6563 nil ;redisplay 5754 (if (eq output t) t nil) ;output
6564 tramp-encoding-command-switch 5755 nil ;redisplay
6565 ;; actual shell command 5756 tramp-encoding-command-switch
6566 (concat 5757 ;; actual shell command
6567 (if (string-match "%s" cmd) (format cmd input) cmd) 5758 (concat
6568 (if (stringp output) (concat "> " output) "")))) 5759 (if (string-match "%s" cmd) (format cmd input) cmd)
6569 5760 (if (stringp output) (concat "> " output) "")))))
6570(defun tramp-maybe-open-connection (multi-method method user host) 5761
6571 "Maybe open a connection to HOST, logging in as USER, using METHOD. 5762(defun tramp-compute-multi-hops (vec)
5763 "Expands VEC according to `tramp-default-proxies-alist'.
5764Gateway hops are already opened."
5765 (let ((target-alist `(,vec))
5766 (choices tramp-default-proxies-alist)
5767 item proxy)
5768
5769 ;; Look for proxy hosts to be passed.
5770 (while choices
5771 (setq item (pop choices)
5772 proxy (nth 2 item))
5773 (when (and
5774 ;; host
5775 (string-match (or (nth 0 item) "")
5776 (or (tramp-file-name-host (car target-alist)) ""))
5777 ;; user
5778 (string-match (or (nth 1 item) "")
5779 (or (tramp-file-name-user (car target-alist)) "")))
5780 (if (null proxy)
5781 ;; No more hops needed.
5782 (setq choices nil)
5783 ;; Replace placeholders.
5784 (setq proxy
5785 (format-spec
5786 proxy
5787 `((?u . ,(or (tramp-file-name-user (car target-alist)) ""))
5788 (?h . ,(or (tramp-file-name-host (car target-alist)) "")))))
5789 (with-parsed-tramp-file-name proxy l
5790 ;; Add the hop.
5791 (add-to-list 'target-alist l)
5792 ;; Start next search.
5793 (setq choices tramp-default-proxies-alist)))))
5794
5795 ;; Handle gateways.
5796 (when (string-match (format
5797 "^\\(%s\\|%s\\)$"
5798 tramp-gw-tunnel-method tramp-gw-socks-method)
5799 (tramp-file-name-method (car target-alist)))
5800 (let ((gw (pop target-alist))
5801 (hop (pop target-alist)))
5802 ;; Is the method prepared for gateways?
5803 (unless (tramp-get-method-parameter
5804 (tramp-file-name-method hop) 'tramp-default-port)
5805 (tramp-error
5806 vec 'file-error
5807 "Method `%s' is not supported for gateway access."
5808 (tramp-file-name-method hop)))
5809 ;; Add default port if needed.
5810 (unless
5811 (string-match
5812 tramp-host-with-port-regexp (tramp-file-name-host hop))
5813 (aset hop 2
5814 (concat
5815 (tramp-file-name-host hop) tramp-prefix-port-format
5816 (number-to-string
5817 (tramp-get-method-parameter
5818 (tramp-file-name-method hop) 'tramp-default-port)))))
5819 ;; Open the gateway connection.
5820 (add-to-list
5821 'target-alist
5822 (vector
5823 (tramp-file-name-method hop) (tramp-file-name-user hop)
5824 (tramp-gw-open-connection vec gw hop) nil))
5825 ;; For the password prompt, we need the correct values.
5826 ;; Therefore, we must remember the gateway vector. But we
5827 ;; cannot do it as connection property, because it shouldn't
5828 ;; be persistent. And we have no started process yet either.
5829 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
5830
5831 ;; Foreign and out-of-band methods are not supported for multi-hops.
5832 (when (cdr target-alist)
5833 (setq choices target-alist)
5834 (while choices
5835 (setq item (pop choices))
5836 (when
5837 (or
5838 (not
5839 (tramp-get-method-parameter
5840 (tramp-file-name-method item) 'tramp-login-program))
5841 (tramp-get-method-parameter
5842 (tramp-file-name-method item) 'tramp-copy-program))
5843 (tramp-error
5844 vec 'file-error
5845 "Method `%s' is not supported for multi-hops."
5846 (tramp-file-name-method item)))))
5847
5848 ;; Result.
5849 target-alist))
5850
5851(defun tramp-maybe-open-connection (vec)
5852 "Maybe open a connection VEC.
6572Does not do anything if a connection is already open, but re-opens the 5853Does not do anything if a connection is already open, but re-opens the
6573connection if a previous connection has died for some reason." 5854connection if a previous connection has died for some reason."
6574 (let ((p (get-buffer-process 5855 (let ((p (tramp-get-connection-process vec)))
6575 (tramp-get-buffer multi-method method user host))) 5856
6576 last-cmd-time)
6577 ;; If too much time has passed since last command was sent, look 5857 ;; If too much time has passed since last command was sent, look
6578 ;; whether process is still alive. If it isn't, kill it. When 5858 ;; whether process is still alive. If it isn't, kill it. When
6579 ;; using ssh, it can sometimes happen that the remote end has hung 5859 ;; using ssh, it can sometimes happen that the remote end has hung
@@ -6581,239 +5861,276 @@ connection if a previous connection has died for some reason."
6581 ;; tries to send some data to the remote end. So that's why we 5861 ;; tries to send some data to the remote end. So that's why we
6582 ;; try to send a command from time to time, then look again 5862 ;; try to send a command from time to time, then look again
6583 ;; whether the process is really alive. 5863 ;; whether the process is really alive.
6584 (save-excursion 5864 (when (and (> (tramp-time-diff
6585 (set-buffer (tramp-get-buffer multi-method method user host)) 5865 (current-time)
6586 (when (and tramp-last-cmd-time 5866 (tramp-get-connection-property p "last-cmd-time" '(0 0 0)))
6587 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60) 5867 60)
6588 p (processp p) (memq (process-status p) '(run open))) 5868 p (processp p) (memq (process-status p) '(run open)))
6589 (tramp-send-command 5869 (tramp-send-command vec "echo are you awake" t t)
6590 multi-method method user host "echo are you awake" nil t) 5870 (unless (and (memq (process-status p) '(run open))
6591 (unless (and (memq (process-status p) '(run open)) 5871 (tramp-wait-for-output p 10))
6592 (tramp-wait-for-output 10)) 5872 (delete-process p)
6593 (delete-process p) 5873 (setq p nil)))
6594 (setq p nil)) 5874
6595 (erase-buffer))) 5875 ;; New connection must be opened.
6596 (unless (and p (processp p) (memq (process-status p) '(run open))) 5876 (unless (and p (processp p) (memq (process-status p) '(run open)))
5877
5878 ;; We call `tramp-get-buffer' in order to get a debug buffer for
5879 ;; messages from the beginning.
5880 (tramp-get-buffer vec)
5881 (if (zerop (length (tramp-file-name-user vec)))
5882 (tramp-message
5883 vec 3 "Opening connection for %s using %s..."
5884 (tramp-file-name-host vec)
5885 (tramp-file-name-method vec))
5886 (tramp-message
5887 vec 3 "Opening connection for %s@%s using %s..."
5888 (tramp-file-name-user vec)
5889 (tramp-file-name-host vec)
5890 (tramp-file-name-method vec)))
5891
5892 ;; Start new process.
6597 (when (and p (processp p)) 5893 (when (and p (processp p))
6598 (delete-process p)) 5894 (delete-process p))
6599 (let ((process-connection-type tramp-process-connection-type)) 5895 (setenv "TERM" tramp-terminal-type)
6600 (funcall (tramp-get-method-parameter 5896 (setenv "PS1" "$ ")
6601 multi-method 5897 (let* ((target-alist (tramp-compute-multi-hops vec))
6602 (tramp-find-method multi-method method user host) 5898 (process-environment (copy-sequence process-environment))
6603 user host 'tramp-connection-function) 5899 (process-connection-type tramp-process-connection-type)
6604 multi-method method user host))))) 5900 (coding-system-for-read nil)
6605 5901 ;; This must be done in order to avoid our file name handler.
6606(defun tramp-send-command 5902 (p (let ((default-directory (tramp-temporary-file-directory)))
6607 (multi-method method user host command &optional noerase neveropen) 5903 (start-process
6608 "Send the COMMAND to USER at HOST (logged in using METHOD). 5904 (or (tramp-get-connection-property vec "process-name" nil)
6609Erases temporary buffer before sending the command (unless NOERASE 5905 (tramp-buffer-name vec))
6610is true). 5906 (tramp-get-connection-buffer vec)
6611If optional seventh arg NEVEROPEN is non-nil, never try to open the 5907 tramp-encoding-shell)))
6612connection. This is meant to be used from 5908 (first-hop t))
6613`tramp-maybe-open-connection' only." 5909
6614 (or neveropen 5910 (tramp-message
6615 (tramp-maybe-open-connection multi-method method user host)) 5911 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
6616 (setq tramp-last-cmd-time (current-time)) 5912
6617 (setq tramp-last-cmd command) 5913 ;; Check whether process is alive.
6618 (when tramp-debug-buffer 5914 (set-process-sentinel p 'tramp-flush-connection-property)
6619 (save-excursion 5915 (tramp-set-process-query-on-exit-flag p nil)
6620 (set-buffer (tramp-get-debug-buffer multi-method method user host)) 5916 (tramp-message vec 3 "Waiting 60s for local shell to come up...")
6621 (goto-char (point-max)) 5917 (tramp-barf-if-no-shell-prompt
6622 (tramp-insert-with-face 'bold (format "$ %s\n" command)))) 5918 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
6623 (let ((proc nil)) 5919
6624 (set-buffer (tramp-get-buffer multi-method method user host)) 5920 ;; Now do all the connections as specified.
6625 (unless noerase (erase-buffer)) 5921 (while target-alist
6626 (setq proc (get-buffer-process (current-buffer))) 5922 (let* ((hop (car target-alist))
6627 (process-send-string proc 5923 (l-method (tramp-file-name-method hop))
6628 (concat command tramp-rsh-end-of-line)))) 5924 (l-user (tramp-file-name-user hop))
6629 5925 (l-host (tramp-file-name-host hop))
6630(defun tramp-send-command-internal 5926 (l-port nil)
6631 (multi-method method user host command &optional msg) 5927 (login-program
5928 (tramp-get-method-parameter l-method 'tramp-login-program))
5929 (login-args
5930 (tramp-get-method-parameter l-method 'tramp-login-args))
5931 (gw-args
5932 (tramp-get-method-parameter l-method 'tramp-gw-args))
5933 (gw (tramp-get-file-property hop "" "gateway" nil))
5934 (g-method (and gw (tramp-file-name-method gw)))
5935 (g-user (and gw (tramp-file-name-user gw)))
5936 (g-host (and gw (tramp-file-name-host gw)))
5937 (command login-program)
5938 spec)
5939
5940 ;; Add gateway arguments if necessary.
5941 (when (and gw gw-args)
5942 (setq login-args (append login-args gw-args)))
5943
5944 ;; Check for port number. Until now, there's no need for handling
5945 ;; like method, user, host.
5946 (when (string-match tramp-host-with-port-regexp l-host)
5947 (setq l-port (match-string 2 l-host)
5948 l-host (match-string 1 l-host)))
5949
5950 ;; Set variables for computing the prompt for reading password.
5951 ;; They can also be derived from a gatewy.
5952 (setq tramp-current-method (or g-method l-method)
5953 tramp-current-user (or g-user l-user)
5954 tramp-current-host (or g-host l-host))
5955
5956 ;; Replace login-args place holders.
5957 (setq
5958 l-host (or l-host "")
5959 l-user (or l-user "")
5960 l-port (or l-port "")
5961 spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port)
5962 (?t . ,(tramp-make-tramp-temp-file vec)))
5963 command
5964 (concat
5965 command " "
5966 (mapconcat
5967 '(lambda (x)
5968 (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
5969 (unless (member "" x) (mapconcat 'identity x " ")))
5970 login-args " ")
5971 ;; String to detect failed connection. Every single word must
5972 ;; be enclosed with '\"'; otherwise it is detected
5973 ;; during connection setup.
5974 ;; Local shell could be a Windows COMSPEC. It doesn't know
5975 ;; the ";" syntax, but we must exit always for `start-process'.
5976 ;; "exec" does not work either.
5977 (if first-hop
5978 " && exit || exit"
5979 "; echo \"Tramp\" \"connection\" \"closed\"; sleep 1"))
5980 ;; We don't reach a Windows shell. Could be initial only.
5981 first-hop nil)
5982
5983 ;; Send the command.
5984 (tramp-message vec 3 "Sending command `%s'" command)
5985 (tramp-send-command vec command t t)
5986 (tramp-process-actions p vec tramp-actions-before-shell 60)
5987 (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
5988 ;; Next hop.
5989 (setq target-alist (cdr target-alist)))
5990
5991 ;; Make initial shell settings.
5992 (tramp-open-connection-setup-interactive-shell p vec)))))
5993
5994(defun tramp-send-command (vec command &optional neveropen nooutput)
5995 "Send the COMMAND to connection VEC.
5996Erases temporary buffer before sending the command. If optional
5997arg NEVEROPEN is non-nil, never try to open the connection. This
5998is meant to be used from `tramp-maybe-open-connection' only. The
5999function waits for output unless NOOUTPUT is set."
6000 (unless neveropen (tramp-maybe-open-connection vec))
6001 (let ((p (tramp-get-connection-process vec)))
6002 (when (tramp-get-connection-property vec "remote-echo" nil)
6003 ;; We mark the command string that it can be erased in the output buffer.
6004 (tramp-set-connection-property p "check-remote-echo" t)
6005 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
6006 (tramp-message vec 6 "%s" command)
6007 (tramp-send-string vec command)
6008 (unless nooutput (tramp-wait-for-output p))))
6009
6010(defun tramp-send-command-internal (vec command)
6632 "Send command to remote host and wait for success. 6011 "Send command to remote host and wait for success.
6633Sends COMMAND, then waits 30 seconds for shell prompt." 6012Sends COMMAND, then waits 30 seconds for shell prompt."
6634 (tramp-send-command multi-method method user host command t t) 6013 (let ((p (tramp-get-connection-process vec)))
6635 (when msg 6014 (when (tramp-get-connection-property vec "remote-echo" nil)
6636 (tramp-message 9 "Waiting 30s for %s..." msg)) 6015 ;; We mark the command string that it can be erased in the output buffer.
6637 (tramp-barf-if-no-shell-prompt 6016 (tramp-set-connection-property p "check-remote-echo" t)
6638 nil 30 6017 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
6639 "Couldn't `%s', see buffer `%s'" command (buffer-name))) 6018 (tramp-message vec 6 "%s" command)
6640 6019 (tramp-send-string vec command)
6641(defun tramp-wait-for-output (&optional timeout) 6020 (tramp-barf-if-no-shell-prompt
6021 p 30 "Couldn't `%s', see buffer `%s'" command (buffer-name))))
6022
6023(defun tramp-wait-for-output (proc &optional timeout)
6642 "Wait for output from remote rsh command." 6024 "Wait for output from remote rsh command."
6643 (let ((proc (get-buffer-process (current-buffer))) 6025 (with-current-buffer (process-buffer proc)
6644 (found nil) 6026 (let ((found
6645 (start-time (current-time)) 6027 (tramp-wait-for-regexp
6646 (start-point (point)) 6028 proc timeout
6647 (end-of-output (concat "^" 6029 (format "^%s\r?$" (regexp-quote tramp-end-of-output)))))
6648 (regexp-quote tramp-end-of-output) 6030 (if found
6649 "\r?$"))) 6031 (let (buffer-read-only)
6650 ;; Algorithm: get waiting output. See if last line contains 6032 (goto-char (point-max))
6651 ;; end-of-output sentinel. If not, wait a bit and again get 6033 (forward-line -2)
6652 ;; waiting output. Repeat until timeout expires or end-of-output 6034 (delete-region (point) (point-max)))
6653 ;; sentinel is seen. Will hang if timeout is nil and 6035 (if timeout
6654 ;; end-of-output sentinel never appears. 6036 (tramp-error
6655 (save-match-data 6037 proc 'file-error
6656 (cond (timeout 6038 "[[Remote prompt `%s' not found in %d secs]]"
6657 ;; Work around an XEmacs bug, where the timeout expires 6039 tramp-end-of-output timeout)
6658 ;; faster than it should. This degenerates into polling 6040 (tramp-error
6659 ;; for buggy XEmacsen, but oh, well. 6041 proc 'file-error
6660 (while (and (not found) 6042 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
6661 (< (tramp-time-diff (current-time) start-time) 6043 ;; Return value is whether end-of-output sentinel was found.
6662 timeout)) 6044 found)))
6663 (with-timeout (timeout)
6664 (while (not found)
6665 (tramp-accept-process-output proc 1)
6666 (unless (memq (process-status proc) '(run open))
6667 (error "Process has died"))
6668 (goto-char (point-max))
6669 (forward-line -1)
6670 (setq found (looking-at end-of-output))))))
6671 (t
6672 (while (not found)
6673 (tramp-accept-process-output proc 1)
6674 (unless (memq (process-status proc) '(run open))
6675 (error "Process has died"))
6676 (goto-char (point-max))
6677 (forward-line -1)
6678 (setq found (looking-at end-of-output))))))
6679 ;; At this point, either the timeout has expired or we have found
6680 ;; the end-of-output sentinel.
6681 (when found
6682 (goto-char (point-max))
6683 (forward-line -2)
6684 (delete-region (point) (point-max)))
6685 ;; If processing echoes, look for it in the first line and delete.
6686 (when tramp-process-echoes
6687 (save-excursion
6688 (goto-char start-point)
6689 (when (looking-at (regexp-quote tramp-last-cmd))
6690 (delete-region (point) (progn (forward-line 1) (point))))))
6691 ;; Add output to debug buffer if appropriate.
6692 (when tramp-debug-buffer
6693 (append-to-buffer
6694 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
6695 tramp-current-user tramp-current-host)
6696 (point-min) (point-max))
6697 (when (not found)
6698 (save-excursion
6699 (set-buffer
6700 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
6701 tramp-current-user tramp-current-host))
6702 (goto-char (point-max))
6703 (insert "[[Remote prompt `" end-of-output "' not found"
6704 (if timeout (format " in %d secs" timeout) "")
6705 "]]"))))
6706 (goto-char (point-min))
6707 ;; Return value is whether end-of-output sentinel was found.
6708 found))
6709 6045
6710(defun tramp-send-command-and-check (multi-method method user host command 6046(defun tramp-send-command-and-check (vec command &optional subshell)
6711 &optional subshell)
6712 "Run COMMAND and check its exit status. 6047 "Run COMMAND and check its exit status.
6713MULTI-METHOD and METHOD specify how to log in (as USER) to the remote HOST.
6714Sends `echo $?' along with the COMMAND for checking the exit status. If 6048Sends `echo $?' along with the COMMAND for checking the exit status. If
6715COMMAND is nil, just sends `echo $?'. Returns the exit status found. 6049COMMAND is nil, just sends `echo $?'. Returns the exit status found.
6716 6050
6717If the optional argument SUBSHELL is non-nil, the command is executed in 6051If the optional argument SUBSHELL is non-nil, the command is executed in
6718a subshell, ie surrounded by parentheses." 6052a subshell, ie surrounded by parentheses."
6719 (tramp-send-command multi-method method user host 6053 (tramp-send-command
6720 (concat (if subshell "( " "") 6054 vec
6721 command 6055 (concat (if subshell "( " "")
6722 (if command " 2>/dev/null; " "") 6056 command
6723 "echo tramp_exit_status $?" 6057 (if command " 2>/dev/null; " "")
6724 (if subshell " )" " "))) 6058 "echo tramp_exit_status $?"
6725 (tramp-wait-for-output) 6059 (if subshell " )" " ")))
6726 (goto-char (point-max)) 6060 (with-current-buffer (tramp-get-connection-buffer vec)
6727 (unless (search-backward "tramp_exit_status " nil t) 6061 (goto-char (point-max))
6728 (error "Couldn't find exit status of `%s'" command)) 6062 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
6729 (skip-chars-forward "^ ") 6063 (tramp-error
6730 (read (current-buffer))) 6064 vec 'file-error "Couldn't find exit status of `%s'" command))
6731 6065 (skip-chars-forward "^ ")
6732(defun tramp-barf-unless-okay (multi-method method user host command subshell 6066 (prog1
6733 signal fmt &rest args) 6067 (read (current-buffer))
6068 (let (buffer-read-only) (delete-region (match-beginning 0) (point-max))))))
6069
6070(defun tramp-barf-unless-okay (vec command fmt &rest args)
6734 "Run COMMAND, check exit status, throw error if exit status not okay. 6071 "Run COMMAND, check exit status, throw error if exit status not okay.
6735Similar to `tramp-send-command-and-check' but accepts two more arguments 6072Similar to `tramp-send-command-and-check' but accepts two more arguments
6736FMT and ARGS which are passed to `error'." 6073FMT and ARGS which are passed to `error'."
6737 (unless (zerop (tramp-send-command-and-check 6074 (unless (zerop (tramp-send-command-and-check vec command))
6738 multi-method method user host command subshell)) 6075 (apply 'tramp-error vec 'file-error fmt args)))
6739 ;; CCC: really pop-to-buffer? Maybe it's appropriate to be more 6076
6740 ;; silent. 6077(defun tramp-send-command-and-read (vec command)
6741 (pop-to-buffer (current-buffer)) 6078 "Run COMMAND and return the output, which must be a Lisp expression.
6742 (funcall 'signal signal (apply 'format fmt args)))) 6079In case there is no valid Lisp expression, it raises an error"
6080 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
6081 (with-current-buffer (tramp-get-connection-buffer vec)
6082 ;; Read the expression.
6083 (goto-char (point-min))
6084 (condition-case nil
6085 (prog1 (read (current-buffer))
6086 ;; Error handling.
6087 (when (re-search-forward "\\S-" nil t) (error)))
6088 (error (tramp-error
6089 vec 'file-error
6090 "`%s' does not return a valid Lisp expression: `%s'"
6091 command (buffer-string))))))
6743 6092
6744;; It seems that Tru64 Unix does not like it if long strings are sent 6093;; It seems that Tru64 Unix does not like it if long strings are sent
6745;; to it in one go. (This happens when sending the Perl 6094;; to it in one go. (This happens when sending the Perl
6746;; `file-attributes' implementation, for instance.) Therefore, we 6095;; `file-attributes' implementation, for instance.) Therefore, we
6747;; have this function which waits a bit at each line. 6096;; have this function which waits a bit at each line.
6748(defun tramp-send-string 6097(defun tramp-send-string (vec string)
6749 (multi-method method user host string) 6098 "Send the STRING via connection VEC.
6750 "Send the STRING to USER at HOST using METHOD.
6751 6099
6752The STRING is expected to use Unix line-endings, but the lines sent to 6100The STRING is expected to use Unix line-endings, but the lines sent to
6753the remote host use line-endings as defined in the variable 6101the remote host use line-endings as defined in the variable
6754`tramp-rsh-end-of-line'." 6102`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
6755 (let ((proc (get-buffer-process 6103 (let* ((p (tramp-get-connection-process vec))
6756 (tramp-get-buffer multi-method method user host)))) 6104 (chunksize (tramp-get-connection-property p "chunksize" nil)))
6757 (unless proc 6105 (unless p
6758 (error "Can't send string to remote host -- not logged in")) 6106 (tramp-error
6759 ;; debug message 6107 vec 'file-error "Can't send string to remote host -- not logged in"))
6760 (when tramp-debug-buffer 6108 (tramp-set-connection-property p "last-cmd-time" (current-time))
6761 (save-excursion 6109 (tramp-message vec 10 "%s" string)
6762 (set-buffer (tramp-get-debug-buffer multi-method method user host)) 6110 (with-current-buffer (tramp-get-connection-buffer vec)
6763 (goto-char (point-max)) 6111 ;; Clean up the buffer. We cannot call `erase-buffer' because
6764 (tramp-insert-with-face 'bold (format "$ %s\n" string)))) 6112 ;; narrowing might be in effect.
6765 ;; replace "\n" by `tramp-rsh-end-of-line' 6113 (let (buffer-read-only) (delete-region (point-min) (point-max)))
6766 (setq string 6114 ;; replace "\n" by `tramp-rsh-end-of-line'
6767 (mapconcat 'identity 6115 (setq string
6768 (split-string string "\n") 6116 (mapconcat 'identity
6769 tramp-rsh-end-of-line)) 6117 (split-string string "\n")
6770 (unless (or (string= string "") 6118 tramp-rsh-end-of-line))
6771 (string-equal (substring string -1) tramp-rsh-end-of-line)) 6119 (unless (or (string= string "")
6772 (setq string (concat string tramp-rsh-end-of-line))) 6120 (string-equal (substring string -1) tramp-rsh-end-of-line))
6773 ;; send the string 6121 (setq string (concat string tramp-rsh-end-of-line)))
6774 (if (and tramp-chunksize (not (zerop tramp-chunksize))) 6122 ;; send the string
6775 (let ((pos 0) 6123 (if (and chunksize (not (zerop chunksize)))
6776 (end (length string))) 6124 (let ((pos 0)
6777 (while (< pos end) 6125 (end (length string)))
6778 (tramp-message-for-buffer 6126 (while (< pos end)
6779 multi-method method user host 10 6127 (tramp-message
6780 "Sending chunk from %s to %s" 6128 vec 10 "Sending chunk from %s to %s"
6781 pos (min (+ pos tramp-chunksize) end)) 6129 pos (min (+ pos chunksize) end))
6782 (process-send-string 6130 (process-send-string
6783 proc (substring string pos (min (+ pos tramp-chunksize) end))) 6131 p (substring string pos (min (+ pos chunksize) end)))
6784 (setq pos (+ pos tramp-chunksize)) 6132 (setq pos (+ pos chunksize))))
6785 (sleep-for 0.1))) 6133 (process-send-string p string)))))
6786 (process-send-string proc string))))
6787
6788(defun tramp-send-eof (multi-method method user host)
6789 "Send EOF to the remote end.
6790METHOD, HOST and USER specify the connection."
6791 (let ((proc (get-buffer-process
6792 (tramp-get-buffer multi-method method user host))))
6793 (unless proc
6794 (error "Can't send EOF to remote host -- not logged in"))
6795 (process-send-eof proc)))
6796; (process-send-string proc "\^D")))
6797
6798(defun tramp-kill-process (multi-method method user host)
6799 "Kill the connection process used by Tramp.
6800MULTI-METHOD, METHOD, USER, and HOST specify the connection."
6801 (let ((proc (get-buffer-process
6802 (tramp-get-buffer multi-method method user host))))
6803 (kill-process proc)))
6804
6805(defun tramp-discard-garbage-erase-buffer (p multi-method method user host)
6806 "Erase buffer, then discard subsequent garbage.
6807If `tramp-discard-garbage' is nil, just erase buffer."
6808 (if (not tramp-discard-garbage)
6809 (erase-buffer)
6810 (while (prog1 (erase-buffer) (tramp-accept-process-output p 0.25))
6811 (when tramp-debug-buffer
6812 (save-excursion
6813 (set-buffer (tramp-get-debug-buffer multi-method method user host))
6814 (goto-char (point-max))
6815 (tramp-insert-with-face
6816 'bold (format "Additional characters detected\n")))))))
6817 6134
6818(defun tramp-mode-string-to-int (mode-string) 6135(defun tramp-mode-string-to-int (mode-string)
6819 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits." 6136 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
@@ -6886,27 +6203,70 @@ If `tramp-discard-garbage' is nil, just erase buffer."
6886 (t (error "Tenth char `%c' must be one of `xtT-'" 6203 (t (error "Tenth char `%c' must be one of `xtT-'"
6887 other-execute-or-sticky))))))) 6204 other-execute-or-sticky)))))))
6888 6205
6889(defun tramp-convert-file-attributes (multi-method method user host attr) 6206(defun tramp-convert-file-attributes (vec attr)
6890 "Convert file-attributes ATTR generated by perl script or ls. 6207 "Convert file-attributes ATTR generated by perl script, stat or ls.
6891Convert file mode bits to string and set virtual device number. 6208Convert file mode bits to string and set virtual device number.
6892Return ATTR." 6209Return ATTR."
6210 ;; Convert last access time.
6211 (unless (listp (nth 4 attr))
6212 (setcar (nthcdr 4 attr)
6213 (list (floor (nth 4 attr) 65536)
6214 (floor (mod (nth 4 attr) 65536)))))
6215 ;; Convert last modification time.
6216 (unless (listp (nth 5 attr))
6217 (setcar (nthcdr 5 attr)
6218 (list (floor (nth 5 attr) 65536)
6219 (floor (mod (nth 5 attr) 65536)))))
6220 ;; Convert last status change time.
6221 (unless (listp (nth 6 attr))
6222 (setcar (nthcdr 6 attr)
6223 (list (floor (nth 6 attr) 65536)
6224 (floor (mod (nth 6 attr) 65536)))))
6893 ;; Convert file mode bits to string. 6225 ;; Convert file mode bits to string.
6894 (unless (stringp (nth 8 attr)) 6226 (unless (stringp (nth 8 attr))
6895 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) 6227 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
6896 ;; Set file's gid change bit. Possible only when id-format is 'integer. 6228 ;; Convert directory indication bit.
6897 (when (numberp (nth 3 attr)) 6229 (if (string-match "^d" (nth 8 attr))
6898 (setcar (nthcdr 9 attr) 6230 (setcar attr t)
6899 (not (eql (nth 3 attr) 6231 (if (and (listp (car attr)) (stringp (caar attr))
6900 (tramp-get-remote-gid multi-method method user host))))) 6232 (string-match ".+ -> .\\(.+\\)." (caar attr)))
6233 (setcar attr (match-string 1 (caar attr)))
6234 (setcar attr nil)))
6235 ;; Set file's gid change bit.
6236 (setcar (nthcdr 9 attr)
6237 (if (numberp (nth 3 attr))
6238 (not (= (nth 3 attr)
6239 (tramp-get-remote-gid vec 'integer)))
6240 (not (string-equal
6241 (nth 3 attr)
6242 (tramp-get-remote-gid vec 'string)))))
6243 ;; Convert inode.
6244 (unless (listp (nth 10 attr))
6245 (setcar (nthcdr 10 attr)
6246 (list (floor (nth 10 attr) 65536)
6247 (floor (mod (nth 10 attr) 65536)))))
6901 ;; Set virtual device number. 6248 ;; Set virtual device number.
6902 (setcar (nthcdr 11 attr) 6249 (setcar (nthcdr 11 attr)
6903 (tramp-get-device multi-method method user host)) 6250 (tramp-get-device vec))
6904 attr) 6251 attr)
6905 6252
6906(defun tramp-get-device (multi-method method user host) 6253(defun tramp-get-inode (file)
6254 "Returns the virtual inode number.
6255If it doesn't exist, generate a new one."
6256 (let ((string (directory-file-name file)))
6257 (unless (assoc string tramp-inodes)
6258 (add-to-list 'tramp-inodes
6259 (list string (length tramp-inodes))))
6260 (nth 1 (assoc string tramp-inodes))))
6261
6262(defun tramp-get-device (vec)
6907 "Returns the virtual device number. 6263 "Returns the virtual device number.
6908If it doesn't exist, generate a new one." 6264If it doesn't exist, generate a new one."
6909 (let ((string (tramp-make-tramp-file-name multi-method method user host ""))) 6265 (let ((string (tramp-make-tramp-file-name
6266 (tramp-file-name-method vec)
6267 (tramp-file-name-user vec)
6268 (tramp-file-name-host vec)
6269 "")))
6910 (unless (assoc string tramp-devices) 6270 (unless (assoc string tramp-devices)
6911 (add-to-list 'tramp-devices 6271 (add-to-list 'tramp-devices
6912 (list string (length tramp-devices)))) 6272 (list string (length tramp-devices))))
@@ -6926,7 +6286,6 @@ If it doesn't exist, generate a new one."
6926 (setq other (tramp-file-mode-permissions other sticky "t")) 6286 (setq other (tramp-file-mode-permissions other sticky "t"))
6927 (concat type user group other))) 6287 (concat type user group other)))
6928 6288
6929
6930(defun tramp-file-mode-permissions (perm suid suid-text) 6289(defun tramp-file-mode-permissions (perm suid suid-text)
6931 "Convert a permission bitset into a string. 6290 "Convert a permission bitset into a string.
6932This is used internally by `tramp-file-mode-from-int'." 6291This is used internally by `tramp-file-mode-from-int'."
@@ -6939,7 +6298,6 @@ This is used internally by `tramp-file-mode-from-int'."
6939 (and suid (upcase suid-text)) ; suid, !execute 6298 (and suid (upcase suid-text)) ; suid, !execute
6940 (and x "x") "-")))) ; !suid 6299 (and x "x") "-")))) ; !suid
6941 6300
6942
6943(defun tramp-decimal-to-octal (i) 6301(defun tramp-decimal-to-octal (i)
6944 "Return a string consisting of the octal digits of I. 6302 "Return a string consisting of the octal digits of I.
6945Not actually used. Use `(format \"%o\" i)' instead?" 6303Not actually used. Use `(format \"%o\" i)' instead?"
@@ -6950,16 +6308,6 @@ Not actually used. Use `(format \"%o\" i)' instead?"
6950 (number-to-string (% i 8)))))) 6308 (number-to-string (% i 8))))))
6951 6309
6952 6310
6953;;(defun tramp-octal-to-decimal (ostr)
6954;; "Given a string of octal digits, return a decimal number."
6955;; (cond ((null ostr) 0)
6956;; ((string= "" ostr) 0)
6957;; (t (let ((last (aref ostr (1- (length ostr))))
6958;; (rest (substring ostr 0 (1- (length ostr)))))
6959;; (unless (and (>= last ?0)
6960;; (<= last ?7))
6961;; (error "Not an octal digit: %c" last))
6962;; (+ (- last ?0) (* 8 (tramp-octal-to-decimal rest)))))))
6963;; Kudos to Gerd Moellmann for this suggestion. 6311;; Kudos to Gerd Moellmann for this suggestion.
6964(defun tramp-octal-to-decimal (ostr) 6312(defun tramp-octal-to-decimal (ostr)
6965 "Given a string of octal digits, return a decimal number." 6313 "Given a string of octal digits, return a decimal number."
@@ -6987,289 +6335,368 @@ Not actually used. Use `(format \"%o\" i)' instead?"
6987;; internal data structure. Convenience functions for internal 6335;; internal data structure. Convenience functions for internal
6988;; data structure. 6336;; data structure.
6989 6337
6990(defun tramp-file-name-p (obj) 6338(defun tramp-file-name-p (vec)
6991 "Check whether TRAMP-FILE-NAME is a Tramp object." 6339 "Check whether VEC is a Tramp object."
6992 (and (vectorp obj) (= 5 (length obj)))) 6340 (and (vectorp vec) (= 4 (length vec))))
6993 6341
6994(defun tramp-file-name-multi-method (obj) 6342(defun tramp-file-name-method (vec)
6995 "Return MULTI-METHOD component of TRAMP-FILE-NAME." 6343 "Return method component of VEC."
6996 (and (tramp-file-name-p obj) (aref obj 0))) 6344 (and (tramp-file-name-p vec) (aref vec 0)))
6997 6345
6998(defun tramp-file-name-method (obj) 6346(defun tramp-file-name-user (vec)
6999 "Return METHOD component of TRAMP-FILE-NAME." 6347 "Return user component of VEC."
7000 (and (tramp-file-name-p obj) (aref obj 1))) 6348 (and (tramp-file-name-p vec) (aref vec 1)))
7001 6349
7002(defun tramp-file-name-user (obj) 6350(defun tramp-file-name-host (vec)
7003 "Return USER component of TRAMP-FILE-NAME." 6351 "Return host component of VEC."
7004 (and (tramp-file-name-p obj) (aref obj 2))) 6352 (and (tramp-file-name-p vec) (aref vec 2)))
7005 6353
7006(defun tramp-file-name-host (obj) 6354(defun tramp-file-name-localname (vec)
7007 "Return HOST component of TRAMP-FILE-NAME." 6355 "Return localname component of VEC."
7008 (and (tramp-file-name-p obj) (aref obj 3))) 6356 (and (tramp-file-name-p vec) (aref vec 3)))
7009 6357
7010(defun tramp-file-name-localname (obj) 6358;; The host part of a Tramp file name vector can be of kind
7011 "Return LOCALNAME component of TRAMP-FILE-NAME." 6359;; "host#port". Sometimes, we must extract these parts.
7012 (and (tramp-file-name-p obj) (aref obj 4))) 6360(defsubst tramp-file-name-real-host (vec)
6361 "Return the host name of VEC without port."
6362 (let ((host (tramp-file-name-host vec)))
6363 (if (and (stringp host)
6364 (string-match tramp-host-with-port-regexp host))
6365 (match-string 1 host)
6366 host)))
6367
6368(defsubst tramp-file-name-port (vec)
6369 "Return the port number of VEC."
6370 (let ((host (tramp-file-name-host vec)))
6371 (and (stringp host)
6372 (string-match tramp-host-with-port-regexp host)
6373 (string-to-number (match-string 2 host)))))
7013 6374
7014(defun tramp-tramp-file-p (name) 6375(defun tramp-tramp-file-p (name)
7015 "Return t iff NAME is a tramp file." 6376 "Return t iff NAME is a tramp file."
7016 (save-match-data 6377 (save-match-data
7017 (string-match tramp-file-name-regexp name))) 6378 (string-match tramp-file-name-regexp name)))
7018 6379
7019;; HHH: Changed. Used to assign the return value of (user-login-name) 6380(defsubst tramp-find-method (method user host)
7020;; to the `user' part of the structure if a user name was not 6381 "Return the right method string to use.
7021;; provided, now it assigns nil. 6382This is METHOD, if non-nil. Otherwise, do a lookup in
6383`tramp-default-method-alist'."
6384 (or method
6385 (let ((choices tramp-default-method-alist)
6386 lmethod item)
6387 (while choices
6388 (setq item (pop choices))
6389 (when (and (string-match (or (nth 0 item) "") (or host ""))
6390 (string-match (or (nth 1 item) "") (or user "")))
6391 (setq lmethod (nth 2 item))
6392 (setq choices nil)))
6393 lmethod)
6394 tramp-default-method))
6395
6396(defsubst tramp-find-user (method user host)
6397 "Return the right user string to use.
6398This is USER, if non-nil. Otherwise, do a lookup in
6399`tramp-default-user-alist'."
6400 (or user
6401 (let ((choices tramp-default-user-alist)
6402 luser item)
6403 (while choices
6404 (setq item (pop choices))
6405 (when (and (string-match (or (nth 0 item) "") (or method ""))
6406 (string-match (or (nth 1 item) "") (or host "")))
6407 (setq luser (nth 2 item))
6408 (setq choices nil)))
6409 luser)
6410 tramp-default-user))
6411
6412(defsubst tramp-find-host (method user host)
6413 "Return the right host string to use.
6414This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
6415 (or (and (> (length host) 0) host)
6416 tramp-default-host))
6417
7022(defun tramp-dissect-file-name (name) 6418(defun tramp-dissect-file-name (name)
7023 "Return an `tramp-file-name' structure. 6419 "Return a `tramp-file-name' structure.
7024The structure consists of remote method, remote user, remote host and 6420The structure consists of remote method, remote user, remote host and
7025localname (file name on remote host)." 6421localname (file name on remote host)."
7026 (save-match-data 6422 (save-match-data
7027 (let* ((match (string-match (nth 0 tramp-file-name-structure) name)) 6423 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
7028 (method 6424 (unless match (error "Not a tramp file name: %s" name))
7029 ; single-hop 6425 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
7030 (if match (match-string (nth 1 tramp-file-name-structure) name) 6426 (user (match-string (nth 2 tramp-file-name-structure) name))
7031 ; maybe multi-hop 6427 (host (match-string (nth 3 tramp-file-name-structure) name))
7032 (string-match 6428 (localname (match-string (nth 4 tramp-file-name-structure) name)))
7033 (format (nth 0 tramp-multi-file-name-structure) 6429 (vector
7034 (nth 0 tramp-multi-file-name-hop-structure)) name) 6430 (tramp-find-method method user host)
7035 (match-string (nth 1 tramp-multi-file-name-structure) name)))) 6431 (tramp-find-user method user host)
7036 (if (and method (member method tramp-multi-methods)) 6432 (tramp-find-host method user host)
7037 ;; If it's a multi method, the file name structure contains 6433 localname)))))
7038 ;; arrays of method, user and host. 6434
7039 (tramp-dissect-multi-file-name name) 6435(defun tramp-equal-remote (file1 file2)
7040 ;; Normal method. First, find out default method. 6436 "Checks, whether the remote parts of FILE1 and FILE2 are identical.
7041 (unless match (error "Not a tramp file name: %s" name)) 6437The check depends on method, user and host name of the files. If
7042 (let ((user (match-string (nth 2 tramp-file-name-structure) name)) 6438one of the components is missing, the default values are used.
7043 (host (match-string (nth 3 tramp-file-name-structure) name)) 6439The local file name parts of FILE1 and FILE2 are not taken into
7044 (localname (match-string (nth 4 tramp-file-name-structure) name))) 6440account.
7045 (vector nil method (or user nil) host localname))))))
7046
7047(defun tramp-find-default-method (user host)
7048 "Look up the right method to use in `tramp-default-method-alist'."
7049 (let ((choices tramp-default-method-alist)
7050 (method tramp-default-method)
7051 item)
7052 (while choices
7053 (setq item (pop choices))
7054 (when (and (string-match (or (nth 0 item) "") (or host ""))
7055 (string-match (or (nth 1 item) "") (or user "")))
7056 (setq method (nth 2 item))
7057 (setq choices nil)))
7058 method))
7059
7060(defun tramp-find-method (multi-method method user host)
7061 "Return the right method string to use.
7062This is MULTI-METHOD, if non-nil. Otherwise, it is METHOD, if non-nil.
7063If both MULTI-METHOD and METHOD are nil, do a lookup in
7064`tramp-default-method-alist'."
7065 (or multi-method method (tramp-find-default-method user host)))
7066
7067;; HHH: Not Changed. Multi method. Will probably not handle the case where
7068;; a user name is not provided in the "file name" very well.
7069(defun tramp-dissect-multi-file-name (name)
7070 "Not implemented yet."
7071 (let ((regexp (nth 0 tramp-multi-file-name-structure))
7072 (method-index (nth 1 tramp-multi-file-name-structure))
7073 (hops-index (nth 2 tramp-multi-file-name-structure))
7074 (localname-index (nth 3 tramp-multi-file-name-structure))
7075 (hop-regexp (nth 0 tramp-multi-file-name-hop-structure))
7076 (hop-method-index (nth 1 tramp-multi-file-name-hop-structure))
7077 (hop-user-index (nth 2 tramp-multi-file-name-hop-structure))
7078 (hop-host-index (nth 3 tramp-multi-file-name-hop-structure))
7079 method hops len hop-methods hop-users hop-hosts localname)
7080 (unless (string-match (format regexp hop-regexp) name)
7081 (error "Not a multi tramp file name: %s" name))
7082 (setq method (match-string method-index name))
7083 (setq hops (match-string hops-index name))
7084 (setq len (/ (length (match-data t)) 2))
7085 (when (< localname-index 0) (setq localname-index (+ localname-index len)))
7086 (setq localname (match-string localname-index name))
7087 (let ((index 0))
7088 (while (string-match hop-regexp hops index)
7089 (setq index (match-end 0))
7090 (setq hop-methods
7091 (cons (match-string hop-method-index hops) hop-methods))
7092 (setq hop-users
7093 (cons (match-string hop-user-index hops) hop-users))
7094 (setq hop-hosts
7095 (cons (match-string hop-host-index hops) hop-hosts))))
7096 (vector
7097 method
7098 (apply 'vector (reverse hop-methods))
7099 (apply 'vector (reverse hop-users))
7100 (apply 'vector (reverse hop-hosts))
7101 localname)))
7102
7103(defun tramp-make-tramp-file-name (multi-method method user host localname)
7104 "Constructs a tramp file name from METHOD, USER, HOST and LOCALNAME."
7105 (if multi-method
7106 (tramp-make-tramp-multi-file-name multi-method method user host localname)
7107 (format-spec
7108 (concat tramp-prefix-format
7109 (when method (concat "%m" tramp-postfix-single-method-format))
7110 (when user (concat "%u" tramp-postfix-user-format))
7111 (when host (concat "%h" tramp-postfix-host-format))
7112 (when localname (concat "%p")))
7113 `((?m . ,method) (?u . ,user) (?h . ,host) (?p . ,localname)))))
7114
7115;; CCC: Henrik Holm: Not Changed. Multi Method. What should be done
7116;; with this when USER is nil?
7117(defun tramp-make-tramp-multi-file-name (multi-method method user host localname)
7118 "Constructs a tramp file name for a multi-hop method."
7119 (unless tramp-make-multi-tramp-file-format
7120 (error "`tramp-make-multi-tramp-file-format' is nil"))
7121 (let* ((prefix-format (nth 0 tramp-make-multi-tramp-file-format))
7122 (hop-format (nth 1 tramp-make-multi-tramp-file-format))
7123 (localname-format (nth 2 tramp-make-multi-tramp-file-format))
7124 (prefix (format-spec prefix-format `((?m . ,multi-method))))
7125 (hops "")
7126 (localname (format-spec localname-format `((?p . ,localname))))
7127 (i 0)
7128 (len (length method)))
7129 (while (< i len)
7130 (let ((m (aref method i)) (u (aref user i)) (h (aref host i)))
7131 (setq hops (concat hops (format-spec hop-format
7132 `((?m . ,m) (?u . ,u) (?h . ,h)))))
7133 (setq i (1+ i))))
7134 (concat prefix hops localname)))
7135
7136(defun tramp-make-copy-program-file-name (user host localname)
7137 "Create a file name suitable to be passed to `rcp' and workalikes."
7138 (if user
7139 (format "%s@%s:%s" user host localname)
7140 (format "%s:%s" host localname)))
7141 6441
7142(defun tramp-method-out-of-band-p (multi-method method user host) 6442Example:
6443
6444 (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
6445
6446would yield `t'. On the other hand, the following check results in nil:
6447
6448 (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
6449 (and (stringp (file-remote-p file1))
6450 (stringp (file-remote-p file2))
6451 (string-equal (file-remote-p file1) (file-remote-p file2))))
6452
6453(defun tramp-make-tramp-file-name (method user host localname)
6454 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
6455 (concat tramp-prefix-format
6456 (when (not (zerop (length method)))
6457 (concat method tramp-postfix-method-format))
6458 (when (not (zerop (length user)))
6459 (concat user tramp-postfix-user-format))
6460 (when host host) tramp-postfix-host-format
6461 (when localname localname)))
6462
6463(defun tramp-completion-make-tramp-file-name (method user host localname)
6464 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
6465It must not be a complete Tramp file name, but as long as there are
6466necessary only. This function will be used in file name completion."
6467 (concat tramp-prefix-format
6468 (when (not (zerop (length method)))
6469 (concat method tramp-postfix-method-format))
6470 (when (not (zerop (length user)))
6471 (concat user tramp-postfix-user-format))
6472 (when (not (zerop (length host)))
6473 (concat host tramp-postfix-host-format))
6474 (when localname localname)))
6475
6476(defun tramp-make-copy-program-file-name (vec)
6477 "Create a file name suitable to be passed to `rcp' and workalikes."
6478 (let ((user (tramp-file-name-user vec))
6479 (host (car (split-string
6480 (tramp-file-name-host vec) tramp-prefix-port-regexp)))
6481 (localname (tramp-shell-quote-argument
6482 (tramp-file-name-localname vec))))
6483 (if (not (zerop (length user)))
6484 (format "%s@%s:%s" user host localname)
6485 (format "%s:%s" host localname))))
6486
6487(defun tramp-method-out-of-band-p (vec)
7143 "Return t if this is an out-of-band method, nil otherwise." 6488 "Return t if this is an out-of-band method, nil otherwise."
7144 (tramp-get-method-parameter 6489 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program))
7145 multi-method
7146 (tramp-find-method multi-method method user host)
7147 user host 'tramp-copy-program))
7148 6490
7149;; Variables local to connection. 6491;; Variables local to connection.
7150 6492
7151(defun tramp-get-ls-command (multi-method method user host) 6493(defun tramp-get-ls-command (vec)
7152 (or 6494 (with-connection-property vec "ls"
7153 (save-excursion 6495 (with-current-buffer (tramp-get-buffer vec)
7154 (tramp-maybe-open-connection multi-method method user host) 6496 (tramp-message vec 5 "Finding a suitable `ls' command")
7155 (set-buffer (tramp-get-buffer multi-method method user host)) 6497 (or
7156 tramp-ls-command) 6498 (catch 'ls-found
7157 (error "Couldn't find remote `ls' command"))) 6499 (dolist (cmd '("ls" "gnuls" "gls"))
7158 6500 (let ((dl tramp-remote-path)
7159(defun tramp-get-test-groks-nt (multi-method method user host) 6501 result)
7160 (save-excursion 6502 (while
7161 (tramp-maybe-open-connection multi-method method user host) 6503 (and
7162 (set-buffer (tramp-get-buffer multi-method method user host)) 6504 dl
7163 tramp-test-groks-nt)) 6505 (setq result
7164 6506 (tramp-find-executable vec cmd dl t t)))
7165(defun tramp-get-file-exists-command (multi-method method user host) 6507 ;; Check parameter.
7166 (or 6508 (when (zerop (tramp-send-command-and-check
7167 (save-excursion 6509 vec (format "%s -lnd /" result)))
7168 (tramp-maybe-open-connection multi-method method user host) 6510 (throw 'ls-found result))
7169 (set-buffer (tramp-get-buffer multi-method method user host)) 6511 ;; Remove unneeded directories from path.
7170 tramp-file-exists-command) 6512 (while
7171 (error "Couldn't find remote `test -e' command"))) 6513 (and
6514 dl
6515 (not
6516 (string-equal
6517 result (expand-file-name-as-directory cmd (car dl)))))
6518 (setq dl (cdr dl)))
6519 (setq dl (cdr dl))))))
6520 (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
6521
6522(defun tramp-get-test-command (vec)
6523 (with-connection-property vec "test"
6524 (with-current-buffer (tramp-get-buffer vec)
6525 (tramp-message vec 5 "Finding a suitable `test' command")
6526 (if (zerop (tramp-send-command-and-check vec "test 0"))
6527 "test"
6528 (tramp-find-executable vec "test" tramp-remote-path)))))
6529
6530(defun tramp-get-test-nt-command (vec)
6531 ;; Does `test A -nt B' work? Use abominable `find' construct if it
6532 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
6533 ;; for otherwise the shell crashes.
6534 (with-connection-property vec "test-nt"
6535 (or
6536 (progn
6537 (tramp-send-command
6538 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
6539 (with-current-buffer (tramp-get-buffer vec)
6540 (goto-char (point-min))
6541 (when (looking-at
6542 (format "\n%s\r?\n" (regexp-quote tramp-end-of-output)))
6543 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
6544 (progn
6545 (tramp-send-command
6546 vec
6547 (format
6548 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
6549 (tramp-get-test-command vec)))
6550 "tramp_test_nt %s %s"))))
6551
6552(defun tramp-get-file-exists-command (vec)
6553 (with-connection-property vec "file-exists"
6554 (with-current-buffer (tramp-get-buffer vec)
6555 (tramp-message vec 5 "Finding command to check if file exists")
6556 (tramp-find-file-exists-command vec))))
6557
6558(defun tramp-get-remote-ln (vec)
6559 (with-connection-property vec "ln"
6560 (with-current-buffer (tramp-get-buffer vec)
6561 (tramp-message vec 5 "Finding a suitable `ln' command")
6562 (tramp-find-executable vec "ln" tramp-remote-path))))
6563
6564(defun tramp-get-remote-perl (vec)
6565 (with-connection-property vec "perl"
6566 (with-current-buffer (tramp-get-buffer vec)
6567 (tramp-message vec 5 "Finding a suitable `perl' command")
6568 (or (tramp-find-executable vec "perl5" tramp-remote-path)
6569 (tramp-find-executable vec "perl" tramp-remote-path)))))
6570
6571(defun tramp-get-remote-stat (vec)
6572 (with-connection-property vec "stat"
6573 (with-current-buffer (tramp-get-buffer vec)
6574 (tramp-message vec 5 "Finding a suitable `stat' command")
6575 (let ((result (tramp-find-executable vec "stat" tramp-remote-path))
6576 tmp)
6577 ;; Check whether stat(1) returns usable syntax.
6578 (when result
6579 (setq tmp
6580 ;; We don't want to display an error message.
6581 (with-temp-message (or (current-message) "")
6582 (condition-case nil
6583 (tramp-send-command-and-read
6584 vec (format "%s -c '(\"%%N\")' /" result))
6585 (error nil))))
6586 (unless (and (listp tmp) (stringp (car tmp))
6587 (string-match "^./.$" (car tmp)))
6588 (setq result nil)))
6589 result))))
7172 6590
7173(defun tramp-get-remote-perl (multi-method method user host) 6591(defun tramp-get-remote-id (vec)
7174 (tramp-get-connection-property "perl" nil multi-method method user host)) 6592 (with-connection-property vec "id"
6593 (with-current-buffer (tramp-get-buffer vec)
6594 (tramp-message vec 5 "Finding POSIX `id' command")
6595 (or
6596 (catch 'id-found
6597 (let ((dl tramp-remote-path)
6598 result)
6599 (while
6600 (and
6601 dl
6602 (setq result
6603 (tramp-find-executable vec "id" dl t t)))
6604 ;; Check POSIX parameter.
6605 (when (zerop (tramp-send-command-and-check
6606 vec (format "%s -u" result)))
6607 (throw 'id-found result))
6608 ;; Remove unneeded directories from path.
6609 (while
6610 (and
6611 dl
6612 (not
6613 (string-equal
6614 result
6615 (concat (file-name-as-directory (car dl)) "id"))))
6616 (setq dl (cdr dl)))
6617 (setq dl (cdr dl)))))
6618 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
6619
6620(defun tramp-get-remote-uid (vec id-format)
6621 (with-connection-property vec (format "uid-%s" id-format)
6622 (let ((res (tramp-send-command-and-read
6623 vec
6624 (format "%s -u%s %s"
6625 (tramp-get-remote-id vec)
6626 (if (equal id-format 'integer) "" "n")
6627 (if (equal id-format 'integer)
6628 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
6629 ;; The command might not always return a number.
6630 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
6631
6632(defun tramp-get-remote-gid (vec id-format)
6633 (with-connection-property vec (format "gid-%s" id-format)
6634 (let ((res (tramp-send-command-and-read
6635 vec
6636 (format "%s -g%s %s"
6637 (tramp-get-remote-id vec)
6638 (if (equal id-format 'integer) "" "n")
6639 (if (equal id-format 'integer)
6640 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
6641 ;; The command might not always return a number.
6642 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
7175 6643
7176(defun tramp-get-remote-ln (multi-method method user host) 6644;; Some predefined connection properties.
6645(defun tramp-get-remote-coding (vec prop)
6646 ;; Local coding handles properties like remote coding. So we could
6647 ;; call it without pain.
6648 (let ((ret (tramp-get-local-coding vec prop)))
6649 ;; The connection property might have been cached. So we must send
6650 ;; the script - maybe.
6651 (when (not (stringp ret))
6652 (let ((name (symbol-name ret)))
6653 (while (string-match (regexp-quote "-") name)
6654 (setq name (replace-match "_" nil t name)))
6655 (tramp-maybe-send-script vec (symbol-value ret) name)
6656 (setq ret name)))
6657 ;; Return the value.
6658 ret))
6659
6660(defun tramp-get-local-coding (vec prop)
7177 (or 6661 (or
7178 (tramp-get-connection-property "ln" nil multi-method method user host) 6662 (tramp-get-connection-property vec prop nil)
7179 (error "Couldn't find remote `ln' command"))) 6663 (progn
7180 6664 (tramp-find-inline-encoding vec)
7181(defun tramp-get-remote-uid (multi-method method user host) 6665 (tramp-get-connection-property vec prop nil))))
7182 (tramp-get-connection-property "uid" nil multi-method method user host))
7183
7184(defun tramp-get-remote-gid (multi-method method user host)
7185 (tramp-get-connection-property "gid" nil multi-method method user host))
7186
7187;; Get a property of a TRAMP connection.
7188(defun tramp-get-connection-property
7189 (property default multi-method method user host)
7190 "Get the named property for the connection.
7191If the value is not set for the connection, return `default'"
7192 (tramp-maybe-open-connection multi-method method user host)
7193 (with-current-buffer (tramp-get-buffer multi-method method user host)
7194 (let (error)
7195 (condition-case nil
7196 (symbol-value (intern (concat "tramp-connection-property-" property)))
7197 (error default)))))
7198
7199;; Set a property of a TRAMP connection.
7200(defun tramp-set-connection-property
7201 (property value multi-method method user host)
7202 "Set the named property of a TRAMP connection."
7203 (tramp-maybe-open-connection multi-method method user host)
7204 (with-current-buffer (tramp-get-buffer multi-method method user host)
7205 (set (make-local-variable
7206 (intern (concat "tramp-connection-property-" property)))
7207 value)))
7208 6666
7209;; Some predefined connection properties. 6667(defun tramp-get-method-parameter (method param)
7210(defun tramp-set-remote-encoding (multi-method method user host rem-enc)
7211 (tramp-set-connection-property "remote-encoding" rem-enc
7212 multi-method method user host))
7213(defun tramp-get-remote-encoding (multi-method method user host)
7214 (tramp-get-connection-property "remote-encoding" nil
7215 multi-method method user host))
7216
7217(defun tramp-set-remote-decoding (multi-method method user host rem-dec)
7218 (tramp-set-connection-property "remote-decoding" rem-dec
7219 multi-method method user host))
7220(defun tramp-get-remote-decoding (multi-method method user host)
7221 (tramp-get-connection-property "remote-decoding" nil
7222 multi-method method user host))
7223
7224(defun tramp-set-local-encoding (multi-method method user host loc-enc)
7225 (tramp-set-connection-property "local-encoding" loc-enc
7226 multi-method method user host))
7227(defun tramp-get-local-encoding (multi-method method user host)
7228 (tramp-get-connection-property "local-encoding" nil
7229 multi-method method user host))
7230
7231(defun tramp-set-local-decoding (multi-method method user host loc-dec)
7232 (tramp-set-connection-property "local-decoding" loc-dec
7233 multi-method method user host))
7234(defun tramp-get-local-decoding (multi-method method user host)
7235 (tramp-get-connection-property "local-decoding" nil
7236 multi-method method user host))
7237
7238(defun tramp-get-method-parameter (multi-method method user host param)
7239 "Return the method parameter PARAM. 6668 "Return the method parameter PARAM.
7240If the `tramp-methods' entry does not exist, use the variable PARAM 6669If the `tramp-methods' entry does not exist, return NIL."
7241as default." 6670 (let ((entry (assoc param (assoc method tramp-methods))))
7242 (unless (boundp param) 6671 (when entry (cadr entry))))
7243 (error "Non-existing method parameter `%s'" param))
7244 (let ((entry (assoc param
7245 (assoc (tramp-find-method multi-method method user host)
7246 tramp-methods))))
7247 (if entry
7248 (cadr entry)
7249 (symbol-value param))))
7250
7251 6672
7252;; Auto saving to a special directory. 6673;; Auto saving to a special directory.
7253 6674
7254(defun tramp-exists-file-name-handler (operation &rest args) 6675(defun tramp-exists-file-name-handler (operation &rest args)
7255 (let ((buffer-file-name "/") 6676 "Checks whether OPERATION runs a file name handler."
7256 (fnha file-name-handler-alist) 6677 ;; The file name handler is determined on base of either an
7257 (check-file-name-operation operation) 6678 ;; argument, `buffer-file-name', or `default-directory'.
7258 (file-name-handler-alist 6679 (condition-case nil
7259 (list 6680 (let* ((buffer-file-name "/")
7260 (cons "/" 6681 (default-directory "/")
7261 '(lambda (operation &rest args) 6682 (fnha file-name-handler-alist)
7262 "Returns OPERATION if it is the one to be checked" 6683 (check-file-name-operation operation)
7263 (if (equal check-file-name-operation operation) 6684 (file-name-handler-alist
7264 operation 6685 (list
7265 (let ((file-name-handler-alist fnha)) 6686 (cons "/"
7266 (apply operation args)))))))) 6687 '(lambda (operation &rest args)
7267 (eq (apply operation args) operation))) 6688 "Returns OPERATION if it is the one to be checked."
6689 (if (equal check-file-name-operation operation)
6690 operation
6691 (let ((file-name-handler-alist fnha))
6692 (apply operation args))))))))
6693 (equal (apply operation args) operation))
6694 (error nil)))
7268 6695
7269(unless (tramp-exists-file-name-handler 'make-auto-save-file-name) 6696(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
7270 (defadvice make-auto-save-file-name 6697 (defadvice make-auto-save-file-name
7271 (around tramp-advice-make-auto-save-file-name () activate) 6698 (around tramp-advice-make-auto-save-file-name () activate)
7272 "Invoke `tramp-handle-make-auto-save-file-name' for tramp files." 6699 "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files."
7273 (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))) 6700 (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
7274 (setq ad-return-value (tramp-handle-make-auto-save-file-name)) 6701 (setq ad-return-value (tramp-handle-make-auto-save-file-name))
7275 ad-do-it)) 6702 ad-do-it))
@@ -7316,12 +6743,6 @@ ALIST is of the form ((FROM . TO) ...)."
7316 (setq alist (cdr alist)))) 6743 (setq alist (cdr alist))))
7317 string)) 6744 string))
7318 6745
7319(defun tramp-insert-with-face (face string)
7320 "Insert text with a specific face."
7321 (let ((start (point)))
7322 (insert string)
7323 (add-text-properties start (point) (list 'face face))))
7324
7325;; ------------------------------------------------------------ 6746;; ------------------------------------------------------------
7326;; -- Compatibility functions section -- 6747;; -- Compatibility functions section --
7327;; ------------------------------------------------------------ 6748;; ------------------------------------------------------------
@@ -7345,28 +6766,63 @@ this is the function `temp-directory'."
7345 "`temp-directory' is defined -- using /tmp.")) 6766 "`temp-directory' is defined -- using /tmp."))
7346 (file-name-as-directory "/tmp")))) 6767 (file-name-as-directory "/tmp"))))
7347 6768
7348(defun tramp-read-passwd (user host prompt) 6769(defun tramp-read-passwd (proc &optional prompt)
7349 "Read a password from user (compat function). 6770 "Read a password from user (compat function).
7350Invokes `password-read' if available, `read-passwd' else." 6771Invokes `password-read' if available, `read-passwd' else."
7351 (if (functionp 'password-read) 6772 (let* ((key (tramp-make-tramp-file-name
7352 (let* ((key (concat (or user (user-login-name)) "@" host)) 6773 tramp-current-method tramp-current-user
7353 (password (apply #'password-read (list prompt key)))) 6774 tramp-current-host ""))
7354 (apply #'password-cache-add (list key password)) 6775 (pw-prompt
7355 password) 6776 (or prompt
7356 (read-passwd prompt))) 6777 (with-current-buffer (process-buffer proc)
7357 6778 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
7358(defun tramp-clear-passwd (&optional user host) 6779 (format "%s for %s " (capitalize (match-string 1)) key)))))
7359 "Clear password cache for connection related to current-buffer." 6780 (if (functionp 'password-read)
6781 (let ((password (apply #'password-read (list pw-prompt key))))
6782 (apply #'password-cache-add (list key password))
6783 password)
6784 (read-passwd pw-prompt))))
6785
6786(defun tramp-clear-passwd ()
6787 "Clear password cache for connection related to current-buffer.
6788If METHOD, USER or HOST is given, take then for computing the key."
7360 (interactive) 6789 (interactive)
7361 (let ((filename (or buffer-file-name list-buffers-directory ""))) 6790 (when (functionp 'password-cache-remove)
7362 (when (and (functionp 'password-cache-remove) 6791 (apply #'password-cache-remove
7363 (or (and user host) (tramp-tramp-file-p filename))) 6792 (list (tramp-make-tramp-file-name
7364 (let* ((v (when (tramp-tramp-file-p filename) 6793 tramp-current-method
7365 (tramp-dissect-file-name filename))) 6794 tramp-current-user
7366 (luser (or user (tramp-file-name-user v) (user-login-name))) 6795 tramp-current-host
7367 (lhost (or host (tramp-file-name-host v) (system-name))) 6796 "")))))
7368 (key (concat luser "@" lhost))) 6797
7369 (apply #'password-cache-remove (list key)))))) 6798;; Snarfed code from time-date.el and parse-time.el
6799
6800(defconst tramp-half-a-year '(241 17024)
6801"Evaluated by \"(days-to-time 183)\".")
6802
6803(defconst tramp-parse-time-months
6804 '(("jan" . 1) ("feb" . 2) ("mar" . 3)
6805 ("apr" . 4) ("may" . 5) ("jun" . 6)
6806 ("jul" . 7) ("aug" . 8) ("sep" . 9)
6807 ("oct" . 10) ("nov" . 11) ("dec" . 12))
6808 "Alist mapping month names to integers.")
6809
6810(defun tramp-time-less-p (t1 t2)
6811 "Say whether time value T1 is less than time value T2."
6812 (unless t1 (setq t1 '(0 0)))
6813 (unless t2 (setq t2 '(0 0)))
6814 (or (< (car t1) (car t2))
6815 (and (= (car t1) (car t2))
6816 (< (nth 1 t1) (nth 1 t2)))))
6817
6818(defun tramp-time-subtract (t1 t2)
6819 "Subtract two time values.
6820Return the difference in the format of a time value."
6821 (unless t1 (setq t1 '(0 0)))
6822 (unless t2 (setq t2 '(0 0)))
6823 (let ((borrow (< (cadr t1) (cadr t2))))
6824 (list (- (car t1) (car t2) (if borrow 1 0))
6825 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
7370 6826
7371(defun tramp-time-diff (t1 t2) 6827(defun tramp-time-diff (t1 t2)
7372 "Return the difference between the two times, in seconds. 6828 "Return the difference between the two times, in seconds.
@@ -7385,11 +6841,7 @@ T1 and T2 are time values (as returned by `current-time' for example)."
7385 (if (< (length t1) 3) (append t1 '(0)) t1) 6841 (if (< (length t1) 3) (append t1 '(0)) t1)
7386 (if (< (length t2) 3) (append t2 '(0)) t2))) 6842 (if (< (length t2) 3) (append t2 '(0)) t2)))
7387 (t 6843 (t
7388 ;; snarfed from Emacs 21 time-date.el; combining 6844 (let ((time (tramp-time-subtract t1 t2)))
7389 ;; time-to-seconds and subtract-time
7390 (let ((time (let ((borrow (< (cadr t1) (cadr t2))))
7391 (list (- (car t1) (car t2) (if borrow 1 0))
7392 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))))
7393 (+ (* (car time) 65536.0) 6845 (+ (* (car time) 65536.0)
7394 (cadr time) 6846 (cadr time)
7395 (/ (or (nth 2 time) 0) 1000000.0)))))) 6847 (/ (or (nth 2 time) 0) 1000000.0))))))
@@ -7428,11 +6880,9 @@ it does the right thing."
7428 "Specify if query is needed for process when Emacs is exited. 6880 "Specify if query is needed for process when Emacs is exited.
7429If the second argument flag is non-nil, Emacs will query the user before 6881If the second argument flag is non-nil, Emacs will query the user before
7430exiting if process is running." 6882exiting if process is running."
7431 (funcall
7432 (if (fboundp 'set-process-query-on-exit-flag) 6883 (if (fboundp 'set-process-query-on-exit-flag)
7433 (symbol-function 'set-process-query-on-exit-flag) 6884 (funcall (symbol-function 'set-process-query-on-exit-flag) process flag)
7434 (symbol-function 'process-kill-without-query)) 6885 (funcall (symbol-function 'process-kill-without-query) process flag)))
7435 process flag))
7436 6886
7437 6887
7438;; ------------------------------------------------------------ 6888;; ------------------------------------------------------------
@@ -7479,29 +6929,6 @@ Only works for Bourne-like shells."
7479 t t result))) 6929 t t result)))
7480 result)))) 6930 result))))
7481 6931
7482;; ;; EFS hooks itself into the file name handling stuff in more places
7483;; ;; than just `file-name-handler-alist'. The following tells EFS to stay
7484;; ;; away from tramp.el file names.
7485;; ;;
7486;; ;; This is needed because EFS installs (efs-dired-before-readin) into
7487;; ;; 'dired-before-readin-hook'. This prevents EFS from opening an FTP
7488;; ;; connection to help it's dired process. Not that I have any real
7489;; ;; idea *why* this is helpful to dired.
7490;; ;;
7491;; ;; Anyway, this advice fixes the problem (with a sledgehammer :)
7492;; ;;
7493;; ;; Daniel Pittman <daniel@danann.net>
7494;; ;;
7495;; ;; CCC: when the other defadvice calls have disappeared, make sure
7496;; ;; not to call defadvice unless it's necessary. How do we find out whether
7497;; ;; it is necessary? (featurep 'efs) is surely the wrong way --
7498;; ;; EFS might nicht be loaded yet.
7499;; (defadvice efs-ftp-path (around dont-match-tramp-localname activate protect)
7500;; "Cause efs-ftp-path to fail when the path is a TRAMP localname."
7501;; (if (tramp-tramp-file-p (ad-get-arg 0))
7502;; nil
7503;; ad-do-it))
7504
7505;; We currently (sometimes) use "[" and "]" in the filename format. 6932;; We currently (sometimes) use "[" and "]" in the filename format.
7506;; This means that Emacs wants to expand wildcards if 6933;; This means that Emacs wants to expand wildcards if
7507;; `find-file-wildcards' is non-nil, and then barfs because no 6934;; `find-file-wildcards' is non-nil, and then barfs because no
@@ -7552,10 +6979,6 @@ Only works for Bourne-like shells."
7552 (format "tramp (%s)" tramp-version) ; package name and version 6979 (format "tramp (%s)" tramp-version) ; package name and version
7553 (delq nil 6980 (delq nil
7554 `(;; Current state 6981 `(;; Current state
7555 tramp-ls-command
7556 tramp-test-groks-nt
7557 tramp-file-exists-command
7558 tramp-current-multi-method
7559 tramp-current-method 6982 tramp-current-method
7560 tramp-current-user 6983 tramp-current-user
7561 tramp-current-host 6984 tramp-current-host
@@ -7563,6 +6986,11 @@ Only works for Bourne-like shells."
7563 ;; System defaults 6986 ;; System defaults
7564 tramp-auto-save-directory ; vars to dump 6987 tramp-auto-save-directory ; vars to dump
7565 tramp-default-method 6988 tramp-default-method
6989 tramp-default-method-alist
6990 tramp-default-host
6991 tramp-default-proxies-alist
6992 tramp-default-user
6993 tramp-default-user-alist
7566 tramp-rsh-end-of-line 6994 tramp-rsh-end-of-line
7567 tramp-default-password-end-of-line 6995 tramp-default-password-end-of-line
7568 tramp-remote-path 6996 tramp-remote-path
@@ -7576,24 +7004,21 @@ Only works for Bourne-like shells."
7576 tramp-temp-name-prefix 7004 tramp-temp-name-prefix
7577 tramp-file-name-structure 7005 tramp-file-name-structure
7578 tramp-file-name-regexp 7006 tramp-file-name-regexp
7579 tramp-multi-file-name-structure
7580 tramp-multi-file-name-hop-structure
7581 tramp-multi-methods
7582 tramp-multi-connection-function-alist
7583 tramp-methods 7007 tramp-methods
7584 tramp-end-of-output 7008 tramp-end-of-output
7585 tramp-coding-commands 7009 tramp-local-coding-commands
7010 tramp-remote-coding-commands
7586 tramp-actions-before-shell 7011 tramp-actions-before-shell
7587 tramp-actions-copy-out-of-band 7012 tramp-actions-copy-out-of-band
7588 tramp-multi-actions
7589 tramp-terminal-type 7013 tramp-terminal-type
7590 ;; Mask non-7bit characters 7014 ;; Mask non-7bit characters
7591 (tramp-shell-prompt-pattern . tramp-reporter-dump-variable) 7015 (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
7592 tramp-chunksize
7593 ,(when (boundp 'tramp-backup-directory-alist) 7016 ,(when (boundp 'tramp-backup-directory-alist)
7594 'tramp-backup-directory-alist) 7017 'tramp-backup-directory-alist)
7595 ,(when (boundp 'tramp-bkup-backup-directory-info) 7018 ,(when (boundp 'tramp-bkup-backup-directory-info)
7596 'tramp-bkup-backup-directory-info) 7019 'tramp-bkup-backup-directory-info)
7020 ;; Dump cache.
7021 (tramp-cache-data . tramp-reporter-dump-variable)
7597 7022
7598 ;; Non-tramp variables of interest 7023 ;; Non-tramp variables of interest
7599 ;; Mask non-7bit characters 7024 ;; Mask non-7bit characters
@@ -7616,18 +7041,21 @@ Only works for Bourne-like shells."
7616 'tramp-load-report-modules ; pre-hook 7041 'tramp-load-report-modules ; pre-hook
7617 'tramp-append-tramp-buffers ; post-hook 7042 'tramp-append-tramp-buffers ; post-hook
7618 "\ 7043 "\
7619Enter your bug report in this message, including as much detail as you 7044Enter your bug report in this message, including as much detail
7620possibly can about the problem, what you did to cause it and what the 7045as you possibly can about the problem, what you did to cause it
7621local and remote machines are. 7046and what the local and remote machines are.
7047
7048If you can give a simple set of instructions to make this bug
7049happen reliably, please include those. Thank you for helping
7050kill bugs in TRAMP.
7622 7051
7623If you can give a simple set of instructions to make this bug happen 7052Another useful thing to do is to put
7624reliably, please include those. Thank you for helping kill bugs in
7625TRAMP.
7626 7053
7627Another useful thing to do is to put (setq tramp-debug-buffer t) in 7054 (setq tramp-verbose 8)
7628the ~/.emacs file and to repeat the bug. Then, include the contents 7055
7629of the *tramp/foo* buffer and the *debug tramp/foo* buffer in your bug 7056in the ~/.emacs file and to repeat the bug. Then, include the
7630report. 7057contents of the *tramp/foo* buffer and the *debug tramp/foo*
7058buffer in your bug report.
7631 7059
7632--bug report follows this line-- 7060--bug report follows this line--
7633")))) 7061"))))
@@ -7639,29 +7067,32 @@ Used for non-7bit chars in strings."
7639 (val (with-current-buffer reporter-eval-buffer 7067 (val (with-current-buffer reporter-eval-buffer
7640 (symbol-value varsym)))) 7068 (symbol-value varsym))))
7641 7069
7642 ;; There are characters to be masked. 7070 (if (hash-table-p val)
7643 (when (and (boundp 'mm-7bit-chars) 7071 ;; Pretty print the cache.
7644 (string-match 7072 (set varsym (read (format "(%s)" (tramp-cache-print val))))
7645 (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) 7073 ;; There are characters to be masked.
7646 (with-current-buffer reporter-eval-buffer 7074 (when (and (boundp 'mm-7bit-chars)
7647 (set varsym (concat "(base64-decode-string \"" 7075 (string-match
7648 (base64-encode-string val) 7076 (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
7649 "\")")))) 7077 (with-current-buffer reporter-eval-buffer
7078 (set varsym (format "(base64-decode-string \"%s\""
7079 (base64-encode-string val))))))
7650 7080
7651 ;; Dump variable. 7081 ;; Dump variable.
7652 (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf) 7082 (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
7653 7083
7654 ;; Remove string quotation. 7084 (unless (hash-table-p val)
7655 (forward-line -1) 7085 ;; Remove string quotation.
7656 (when (looking-at 7086 (forward-line -1)
7657 (concat "\\(^.*\\)" "\"" ;; \1 " 7087 (when (looking-at
7658 "\\((base64-decode-string \\)" "\\\\" ;; \2 \ 7088 (concat "\\(^.*\\)" "\"" ;; \1 "
7659 "\\(\".*\\)" "\\\\" ;; \3 \ 7089 "\\((base64-decode-string \\)" "\\\\" ;; \2 \
7660 "\\(\")\\)" "\"$")) ;; \4 " 7090 "\\(\".*\\)" "\\\\" ;; \3 \
7661 (replace-match "\\1\\2\\3\\4") 7091 "\\(\")\\)" "\"$")) ;; \4 "
7662 (beginning-of-line) 7092 (replace-match "\\1\\2\\3\\4")
7663 (insert " ;; variable encoded due to non-printable characters\n")) 7093 (beginning-of-line)
7664 (forward-line 1) 7094 (insert " ;; variable encoded due to non-printable characters\n"))
7095 (forward-line 1))
7665 7096
7666 ;; Reset VARSYM to old value. 7097 ;; Reset VARSYM to old value.
7667 (with-current-buffer reporter-eval-buffer 7098 (with-current-buffer reporter-eval-buffer
@@ -7683,8 +7114,39 @@ Used for non-7bit chars in strings."
7683 (funcall (symbol-function 'mml-mode) t))) 7114 (funcall (symbol-function 'mml-mode) t)))
7684 7115
7685(defun tramp-append-tramp-buffers () 7116(defun tramp-append-tramp-buffers ()
7686 "Append Tramp buffers into the bug report." 7117 "Append Tramp buffers and buffer local variables into the bug report."
7687 7118
7119 (goto-char (point-max))
7120
7121 ;; Dump buffer local variables.
7122 (dolist (buffer
7123 (delq nil
7124 (mapcar
7125 '(lambda (b)
7126 (when (string-match "\\*tramp/" (buffer-name b)) b))
7127 (buffer-list))))
7128 (let ((reporter-eval-buffer buffer)
7129 (buffer-name (buffer-name buffer))
7130 (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
7131 (with-current-buffer elbuf
7132 (emacs-lisp-mode)
7133 (erase-buffer)
7134 (insert "\n(setq\n")
7135 (lisp-indent-line)
7136 (funcall (symbol-function 'reporter-dump-variable)
7137 'buffer-name (current-buffer))
7138 (dolist (varsym-or-cons-cell (buffer-local-variables buffer))
7139 (let ((varsym (or (car-safe varsym-or-cons-cell)
7140 varsym-or-cons-cell)))
7141 (when (string-match "tramp" (symbol-name varsym))
7142 (funcall
7143 (symbol-function 'reporter-dump-variable)
7144 varsym (current-buffer)))))
7145 (lisp-indent-line)
7146 (insert ")\n"))
7147 (insert-buffer-substring elbuf)))
7148
7149 ;; Append buffers only when we are in message mode.
7688 (when (and 7150 (when (and
7689 (eq major-mode 'message-mode) 7151 (eq major-mode 'message-mode)
7690 (boundp 'mml-mode) 7152 (boundp 'mml-mode)
@@ -7705,24 +7167,26 @@ Used for non-7bit chars in strings."
7705 (setq buffer-read-only nil) 7167 (setq buffer-read-only nil)
7706 (goto-char (point-min)) 7168 (goto-char (point-min))
7707 (while (not (eobp)) 7169 (while (not (eobp))
7708 (if (re-search-forward tramp-buf-regexp (tramp-point-at-eol) t) 7170 (if (re-search-forward tramp-buf-regexp (tramp-line-end-position) t)
7709 (forward-line 1) 7171 (forward-line 1)
7710 (forward-line 0) 7172 (forward-line 0)
7711 (let ((start (point))) 7173 (let ((start (point)))
7712 (forward-line 1) 7174 (forward-line 1)
7713 (kill-region start (point))))) 7175 (kill-region start (point)))))
7714 (insert " 7176 (insert "
7715The buffer(s) above will be appended to this message. If you don't want 7177The buffer(s) above will be appended to this message. If you
7716to append a buffer because it contains sensible data, or because the buffer 7178don't want to append a buffer because it contains sensitive data,
7717is too large, you should delete the respective buffer. The buffer(s) will 7179or because the buffer is too large, you should delete the
7718contain user and host names. Passwords will never be included there.") 7180respective buffer. The buffer(s) will contain user and host
7181names. Passwords will never be included there.")
7719 7182
7720 (when (and tramp-debug-buffer (> tramp-verbose 9)) 7183 (when (>= tramp-verbose 6)
7721 (insert "\n\n") 7184 (insert "\n\n")
7722 (let ((start (point))) 7185 (let ((start (point)))
7723 (insert "\ 7186 (insert "\
7724Please note that you have set `tramp-verbose' to a value greater than 9. 7187Please note that you have set `tramp-verbose' to a value of at
7725Therefore, the contents of files might be included in the debug buffer(s).") 7188least 6. Therefore, the contents of files might be included in
7189the debug buffer(s).")
7726 (add-text-properties start (point) (list 'face 'italic)))) 7190 (add-text-properties start (point) (list 'face 'italic))))
7727 7191
7728 (set-buffer-modified-p nil) 7192 (set-buffer-modified-p nil)
@@ -7735,7 +7199,10 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7735 (kill-buffer nil) 7199 (kill-buffer nil)
7736 (switch-to-buffer curbuf) 7200 (switch-to-buffer curbuf)
7737 (goto-char (point-max)) 7201 (goto-char (point-max))
7738 (insert "\n\n") 7202 (insert "\n\
7203This is a special notion of the `gnus/message' package. If you
7204use another mail agent (by copying the contents of this buffer)
7205please ensure that the buffers are attached to your email.\n\n")
7739 (dolist (buffer buffer-list) 7206 (dolist (buffer buffer-list)
7740 (funcall (symbol-function 'mml-insert-empty-tag) 7207 (funcall (symbol-function 'mml-insert-empty-tag)
7741 'part 'type "text/plain" 'encoding "base64" 7208 'part 'type "text/plain" 'encoding "base64"
@@ -7766,9 +7233,9 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7766 ;; ange-ftp settings must be enabled. 7233 ;; ange-ftp settings must be enabled.
7767 (when (functionp 'tramp-ftp-enable-ange-ftp) 7234 (when (functionp 'tramp-ftp-enable-ange-ftp)
7768 (funcall (symbol-function 'tramp-ftp-enable-ange-ftp))) 7235 (funcall (symbol-function 'tramp-ftp-enable-ange-ftp)))
7769 ;; `tramp-util' unloads also `tramp'. 7236 ;; Maybe its not loaded yet.
7770 (condition-case nil ;; maybe its not loaded yet. 7237 (condition-case nil
7771 (unload-feature (if (featurep 'tramp-util) 'tramp-util 'tramp) 'force) 7238 (unload-feature 'tramp 'force)
7772 (error nil))) 7239 (error nil)))
7773 7240
7774(provide 'tramp) 7241(provide 'tramp)
@@ -7776,9 +7243,9 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7776;; Make sure that we get integration with the VC package. 7243;; Make sure that we get integration with the VC package.
7777;; When it is loaded, we need to pull in the integration module. 7244;; When it is loaded, we need to pull in the integration module.
7778;; This must come after (provide 'tramp) because tramp-vc.el 7245;; This must come after (provide 'tramp) because tramp-vc.el
7779;; requires tramp. 7246;; requires tramp. Not necessary in Emacs 23.
7780(eval-after-load "vc" 7247(eval-after-load "vc"
7781 '(progn 7248 '(unless (functionp 'start-file-process)
7782 (require 'tramp-vc) 7249 (require 'tramp-vc)
7783 (add-hook 'tramp-unload-hook 7250 (add-hook 'tramp-unload-hook
7784 '(lambda () 7251 '(lambda ()
@@ -7795,6 +7262,12 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7795;; Another approach is to read a netrc file like ~/.authinfo 7262;; Another approach is to read a netrc file like ~/.authinfo
7796;; from Gnus. 7263;; from Gnus.
7797;; * Handle nonlocal exits such as C-g. 7264;; * Handle nonlocal exits such as C-g.
7265;; * But it would probably be better to use with-local-quit at the
7266;; place where it's actually needed: around any potentially
7267;; indefinitely blocking piece of code. In this case it would be
7268;; within Tramp around one of its calls to accept-process-output (or
7269;; around one of the loops that calls accept-process-output)
7270;; (Stefann Monnier).
7798;; * Autodetect if remote `ls' groks the "--dired" switch. 7271;; * Autodetect if remote `ls' groks the "--dired" switch.
7799;; * Add fallback for inline encodings. This should be used 7272;; * Add fallback for inline encodings. This should be used
7800;; if the remote end doesn't support mimencode or a similar program. 7273;; if the remote end doesn't support mimencode or a similar program.
@@ -7808,9 +7281,6 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7808;; two commands to write a null byte: 7281;; two commands to write a null byte:
7809;; dd if=/dev/zero bs=1 count=1 7282;; dd if=/dev/zero bs=1 count=1
7810;; echo | tr '\n' '\000' 7283;; echo | tr '\n' '\000'
7811;; * Separate local `tramp-coding-commands' from remote ones. Connect
7812;; the two via a format which can be `uu' or `b64'. Then we can search
7813;; for the right local commands and the right remote commands separately.
7814;; * Cooperate with PCL-CVS. It uses start-process, which doesn't 7284;; * Cooperate with PCL-CVS. It uses start-process, which doesn't
7815;; work for remote files. 7285;; work for remote files.
7816;; * Rewrite `tramp-shell-quote-argument' to abstain from using 7286;; * Rewrite `tramp-shell-quote-argument' to abstain from using
@@ -7830,43 +7300,27 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7830;; * Don't use globbing for directories with many files, as this is 7300;; * Don't use globbing for directories with many files, as this is
7831;; likely to produce long command lines, and some shells choke on 7301;; likely to produce long command lines, and some shells choke on
7832;; long command lines. 7302;; long command lines.
7833;; * Find out about the new auto-save mechanism in Emacs 21 and
7834;; do the right thing.
7835;; * `vc-directory' does not work. It never displays any files, even 7303;; * `vc-directory' does not work. It never displays any files, even
7836;; if it does show files when run locally. 7304;; if it does show files when run locally.
7837;; * Allow correction of passwords, if the remote end allows this. 7305;; * Allow correction of passwords, if the remote end allows this.
7838;; (Mark Hershberger) 7306;; (Mark Hershberger)
7839;; * How to deal with MULE in `insert-file-contents' and `write-region'? 7307;; * How to deal with MULE in `insert-file-contents' and `write-region'?
7840;; * Do asynchronous `shell-command's.
7841;; * Grok `append' parameter for `write-region'. 7308;; * Grok `append' parameter for `write-region'.
7842;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'? 7309;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
7843;; * abbreviate-file-name 7310;; * abbreviate-file-name
7844;; * grok ~ in tramp-remote-path (Henrik Holm <henrikh@tele.ntnu.no>) 7311;; * grok ~ in tramp-remote-path (Henrik Holm <henrikh@tele.ntnu.no>)
7845;; * Also allow to omit user names when doing multi-hop. Not sure yet
7846;; what the user names should default to, though.
7847;; * better error checking. At least whenever we see something 7312;; * better error checking. At least whenever we see something
7848;; strange when doing zerop, we should kill the process and start 7313;; strange when doing zerop, we should kill the process and start
7849;; again. (Greg Stark) 7314;; again. (Greg Stark)
7850;; * Add caching for filename completion. (Greg Stark)
7851;; Of course, this has issues with usability (stale cache bites)
7852;; -- <daniel@danann.net>
7853;; * Provide a local cache of old versions of remote files for the rsync 7315;; * Provide a local cache of old versions of remote files for the rsync
7854;; transfer method to use. (Greg Stark) 7316;; transfer method to use. (Greg Stark)
7855;; * Remove unneeded parameters from methods. 7317;; * Remove unneeded parameters from methods.
7856;; * Invoke rsync once for copying a whole directory hierarchy. 7318;; * Invoke rsync once for copying a whole directory hierarchy.
7857;; (Francesco Potort,Al(B) 7319;; (Francesco Potort,Al(B)
7858;; * Should we set PATH ourselves or should we rely on the remote end
7859;; to do it?
7860;; * Make it work for XEmacs 20, which is missing `with-timeout'.
7861;; * Make it work for different encodings, and for different file name 7320;; * Make it work for different encodings, and for different file name
7862;; encodings, too. (Daniel Pittman) 7321;; encodings, too. (Daniel Pittman)
7863;; * Change applicable functions to pass a struct tramp-file-name rather
7864;; than the individual items MULTI-METHOD, METHOD, USER, HOST, LOCALNAME.
7865;; * Implement asynchronous shell commands.
7866;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman) 7322;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
7867;; * Progress reports while copying files. (Michael Kifer) 7323;; * Progress reports while copying files. (Michael Kifer)
7868;; * `Smart' connection method that uses inline for small and out of
7869;; band for large files. (Michael Kifer)
7870;; * Don't search for perl5 and perl. Instead, only search for perl and 7324;; * Don't search for perl5 and perl. Instead, only search for perl and
7871;; then look if it's the right version (with `perl -v'). 7325;; then look if it's the right version (with `perl -v').
7872;; * When editing a remote CVS controlled file as a different user, VC 7326;; * When editing a remote CVS controlled file as a different user, VC
@@ -7879,19 +7333,49 @@ Therefore, the contents of files might be included in the debug buffer(s).")
7879;; about Tramp, it does not do the right thing if the target file 7333;; about Tramp, it does not do the right thing if the target file
7880;; name is a Tramp name. 7334;; name is a Tramp name.
7881;; * Username and hostname completion. 7335;; * Username and hostname completion.
7882;; ** If `partial-completion-mode' isn't loaded, "/foo:bla" tries to
7883;; connect to host "blabla" already if that host is unique. No idea
7884;; how to suppress. Maybe not an essential problem.
7885;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode'. 7336;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode'.
7886;; ** Extend `tramp-get-completion-su' for NIS and shadow passwords.
7887;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'. 7337;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
7888;; Code is nearly identical. 7338;; Code is nearly identical.
7889;; ** Decide whiche files to take for searching user/host names depending on
7890;; operating system (windows-nt) in `tramp-completion-function-alist'.
7891;; ** Enhance variables for debug.
7892;; ** Implement "/multi:" completion.
7893;; ** Add a learning mode for completion. Make results persistent.
7894;; * Allow out-of-band methods as _last_ multi-hop. 7339;; * Allow out-of-band methods as _last_ multi-hop.
7340;; * WIBNI if we had a command "trampclient"? If I was editing in
7341;; some shell with root priviledges, it would be nice if I could
7342;; just call
7343;; trampclient filename.c
7344;; as an editor, and the _current_ shell would connect to an Emacs
7345;; server and would be used in an existing non-priviledged Emacs
7346;; session for doing the editing in question.
7347;; That way, I need not tell Emacs my password again and be afraid
7348;; that it makes it into core dumps or other ugly stuff (I had Emacs
7349;; once display a just typed password in the context of a keyboard
7350;; sequence prompt for a question immediately following in a shell
7351;; script run within Emacs -- nasty).
7352;; And if I have some ssh session running to a different computer,
7353;; having the possibility of passing a local file there to a local
7354;; Emacs session (in case I can arrange for a connection back) would
7355;; be nice.
7356;; Likely the corresponding tramp server should not allow the
7357;; equivalent of the emacsclient -eval option in order to make this
7358;; reasonably unproblematic. And maybe trampclient should have some
7359;; way of passing credentials, like by using an SSL socket or
7360;; something. (David Kastrup)
7361;; * Could Tramp reasonably look for a prompt after ^M rather than
7362;; only after ^J ? (Stefan Monnier)
7363;; * WIBNI there was an interactive command prompting for tramp
7364;; method, hostname, username and filename and translates the user
7365;; input into the correct filename syntax (depending on the Emacs
7366;; flavor) (Reiner Steib)
7367;; * Let the user edit the connection properties interactively.
7368;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
7369;; * Reconnect directly to a compliant shell without first going
7370;; through the user's default shell. (Pete Forman)
7371;; * It's just that when I come to Customize `tramp-default-user-alist'
7372;; I'm presented with a mismatch and raw lisp for a value. It is my
7373;; understanding that a variable declared with defcustom is a User
7374;; Option and should not be modified by the code. add-to-list is
7375;; called in several places. One way to handle that is to have a new
7376;; ordinary variable that gets its initial value from
7377;; tramp-default-user-alist and then is added to. (Pete Forman)
7378;; * Make `tramp-default-user' obsolete.
7895 7379
7896;; Functions for file-name-handler-alist: 7380;; Functions for file-name-handler-alist:
7897;; diff-latest-backup-file -- in diff.el 7381;; diff-latest-backup-file -- in diff.el
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 485c58afa65..f7961ee267d 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -11,8 +11,8 @@
11 11
12;; GNU Emacs is free software; you can redistribute it and/or modify 12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by 13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option) 14;; the Free Software Foundation; either version 3 of the License, or
15;; any later version. 15;; (at your option) any later version.
16 16
17;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,22 +20,26 @@
20;; GNU General Public License for more details. 20;; GNU General Public License for more details.
21 21
22;; You should have received a copy of the GNU General Public License 22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; along with GNU Emacs; see the file COPYING. If not, see
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; <http://www.gnu.org/licenses/>.
25;; Boston, MA 02110-1301, USA.
26 25
27;;; Code: 26;;; Code:
28 27
29;; In the Tramp CVS repository, the version numer and the bug report address 28;; In the Tramp CVS repository, the version numer and the bug report address
30;; are auto-frobbed from configure.ac, so you should edit that file and run 29;; are auto-frobbed from configure.ac, so you should edit that file and run
31;; "autoconf && ./configure" to change them. 30;; "autoconf && ./configure" to change them. (X)Emacs version check is defined
31;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there.
32 32
33(defconst tramp-version "2.0.56" 33(defconst tramp-version "2.1.10-pre"
34 "This version of Tramp.") 34 "This version of Tramp.")
35 35
36(defconst tramp-bug-report-address "tramp-devel@gnu.org" 36(defconst tramp-bug-report-address "tramp-devel@gnu.org"
37 "Email address to send bug reports to.") 37 "Email address to send bug reports to.")
38 38
39;; Check for (X)Emacs version.
40(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.10-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok")))
41 (unless (string-match "\\`ok\\'" x) (error x)))
42
39(provide 'trampver) 43(provide 'trampver)
40 44
41;;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1 45;;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index efb5980766d..86d930127b5 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -711,6 +711,7 @@ If PREDICATE is non-nil, it will also be used to refine the match
711If no directory information can be extracted from the completed 711If no directory information can be extracted from the completed
712component, `default-directory' is used as the basis for completion." 712component, `default-directory' is used as the basis for completion."
713 (let* ((name (substitute-env-vars pcomplete-stub)) 713 (let* ((name (substitute-env-vars pcomplete-stub))
714 (completion-ignore-case pcomplete-ignore-case)
714 (default-directory (expand-file-name 715 (default-directory (expand-file-name
715 (or (file-name-directory name) 716 (or (file-name-directory name)
716 default-directory))) 717 default-directory)))
diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el
index 6e36b5a93e3..880972bff9d 100644
--- a/lisp/pcvs-info.el
+++ b/lisp/pcvs-info.el
@@ -85,9 +85,9 @@ to confuse some users sometimes."
85 85
86(defface cvs-unknown 86(defface cvs-unknown
87 '((((class color) (background dark)) 87 '((((class color) (background dark))
88 (:foreground "red")) 88 (:foreground "red1"))
89 (((class color) (background light)) 89 (((class color) (background light))
90 (:foreground "red")) 90 (:foreground "red1"))
91 (t (:slant italic))) 91 (t (:slant italic)))
92 "PCL-CVS face used to highlight unknown file status." 92 "PCL-CVS face used to highlight unknown file status."
93 :group 'pcl-cvs) 93 :group 'pcl-cvs)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index a9f5f77c126..94def936fb9 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -87,13 +87,13 @@
87 87
88;;;###autoload 88;;;###autoload
89(defcustom compilation-mode-hook nil 89(defcustom compilation-mode-hook nil
90 "*List of hook functions run by `compilation-mode' (see `run-mode-hooks')." 90 "List of hook functions run by `compilation-mode' (see `run-mode-hooks')."
91 :type 'hook 91 :type 'hook
92 :group 'compilation) 92 :group 'compilation)
93 93
94;;;###autoload 94;;;###autoload
95(defcustom compilation-window-height nil 95(defcustom compilation-window-height nil
96 "*Number of lines in a compilation window. If nil, use Emacs default." 96 "Number of lines in a compilation window. If nil, use Emacs default."
97 :type '(choice (const :tag "Default" nil) 97 :type '(choice (const :tag "Default" nil)
98 integer) 98 integer)
99 :group 'compilation) 99 :group 'compilation)
@@ -442,7 +442,7 @@ Highlight entire line if t; don't highlight source lines if nil.")
442 "Overlay used to temporarily highlight compilation matches.") 442 "Overlay used to temporarily highlight compilation matches.")
443 443
444(defcustom compilation-error-screen-columns t 444(defcustom compilation-error-screen-columns t
445 "*If non-nil, column numbers in error messages are screen columns. 445 "If non-nil, column numbers in error messages are screen columns.
446Otherwise they are interpreted as character positions, with 446Otherwise they are interpreted as character positions, with
447each character occupying one column. 447each character occupying one column.
448The default is to use screen columns, which requires that the compilation 448The default is to use screen columns, which requires that the compilation
@@ -453,21 +453,21 @@ especially the TAB character."
453 :version "20.4") 453 :version "20.4")
454 454
455(defcustom compilation-read-command t 455(defcustom compilation-read-command t
456 "*Non-nil means \\[compile] reads the compilation command to use. 456 "Non-nil means \\[compile] reads the compilation command to use.
457Otherwise, \\[compile] just uses the value of `compile-command'." 457Otherwise, \\[compile] just uses the value of `compile-command'."
458 :type 'boolean 458 :type 'boolean
459 :group 'compilation) 459 :group 'compilation)
460 460
461;;;###autoload 461;;;###autoload
462(defcustom compilation-ask-about-save t 462(defcustom compilation-ask-about-save t
463 "*Non-nil means \\[compile] asks which buffers to save before compiling. 463 "Non-nil means \\[compile] asks which buffers to save before compiling.
464Otherwise, it saves all modified buffers without asking." 464Otherwise, it saves all modified buffers without asking."
465 :type 'boolean 465 :type 'boolean
466 :group 'compilation) 466 :group 'compilation)
467 467
468;;;###autoload 468;;;###autoload
469(defcustom compilation-search-path '(nil) 469(defcustom compilation-search-path '(nil)
470 "*List of directories to search for source files named in error messages. 470 "List of directories to search for source files named in error messages.
471Elements should be directory names, not file names of directories. 471Elements should be directory names, not file names of directories.
472The value nil as an element means to try the default directory." 472The value nil as an element means to try the default directory."
473 :type '(repeat (choice (const :tag "Default" nil) 473 :type '(repeat (choice (const :tag "Default" nil)
@@ -476,7 +476,7 @@ The value nil as an element means to try the default directory."
476 476
477;;;###autoload 477;;;###autoload
478(defcustom compile-command "make -k " 478(defcustom compile-command "make -k "
479 "*Last shell command used to do a compilation; default for next compilation. 479 "Last shell command used to do a compilation; default for next compilation.
480 480
481Sometimes it is useful for files to supply local values for this variable. 481Sometimes it is useful for files to supply local values for this variable.
482You might also use mode hooks to specify it in certain modes, like this: 482You might also use mode hooks to specify it in certain modes, like this:
@@ -494,7 +494,7 @@ You might also use mode hooks to specify it in certain modes, like this:
494 494
495;;;###autoload 495;;;###autoload
496(defcustom compilation-disable-input nil 496(defcustom compilation-disable-input nil
497 "*If non-nil, send end-of-file as compilation process input. 497 "If non-nil, send end-of-file as compilation process input.
498This only affects platforms that support asynchronous processes (see 498This only affects platforms that support asynchronous processes (see
499`start-process'); synchronous compilation processes never accept input." 499`start-process'); synchronous compilation processes never accept input."
500 :type 'boolean 500 :type 'boolean
@@ -605,6 +605,14 @@ Faces `compilation-error-face', `compilation-warning-face',
605(defvar compilation-error-list nil) 605(defvar compilation-error-list nil)
606(defvar compilation-old-error-list nil) 606(defvar compilation-old-error-list nil)
607 607
608(defcustom compilation-auto-jump-to-first-error nil
609 "If non-nil, automatically jump to the first error after `compile'."
610 :type 'boolean)
611
612(defvar compilation-auto-jump-to-next nil
613 "If non-nil, automatically jump to the next error encountered.")
614(make-variable-buffer-local 'compilation-auto-jump-to-next)
615
608(defun compilation-face (type) 616(defun compilation-face (type)
609 (or (and (car type) (match-end (car type)) compilation-warning-face) 617 (or (and (car type) (match-end (car type)) compilation-warning-face)
610 (and (cdr type) (match-end (cdr type)) compilation-info-face) 618 (and (cdr type) (match-end (cdr type)) compilation-info-face)
@@ -652,13 +660,18 @@ Faces `compilation-error-face', `compilation-warning-face',
652 l2 660 l2
653 (setcdr l1 (cons (list ,key) l2))))))) 661 (setcdr l1 (cons (list ,key) l2)))))))
654 662
663(defun compilation-auto-jump (buffer pos)
664 (with-current-buffer buffer
665 (goto-char pos)
666 (compile-goto-error)))
655 667
656;; This function is the central driver, called when font-locking to gather 668;; This function is the central driver, called when font-locking to gather
657;; all information needed to later jump to corresponding source code. 669;; all information needed to later jump to corresponding source code.
658;; Return a property list with all meta information on this error location. 670;; Return a property list with all meta information on this error location.
659 671
660(defun compilation-error-properties (file line end-line col end-col type fmt) 672(defun compilation-error-properties (file line end-line col end-col type fmt)
661 (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point)) 673 (unless (< (next-single-property-change (match-beginning 0)
674 'directory nil (point))
662 (point)) 675 (point))
663 (if file 676 (if file
664 (if (functionp file) 677 (if (functionp file)
@@ -710,6 +723,13 @@ Faces `compilation-error-face', `compilation-warning-face',
710 (setq type (or (and (car type) (match-end (car type)) 1) 723 (setq type (or (and (car type) (match-end (car type)) 1)
711 (and (cdr type) (match-end (cdr type)) 0) 724 (and (cdr type) (match-end (cdr type)) 0)
712 2))) 725 2)))
726
727 (when (and compilation-auto-jump-to-next
728 (>= type compilation-skip-threshold))
729 (kill-local-variable 'compilation-auto-jump-to-next)
730 (run-with-timer 0 nil 'compilation-auto-jump
731 (current-buffer) (match-beginning 0)))
732
713 (compilation-internal-error-properties file line end-line col end-col type fmt))) 733 (compilation-internal-error-properties file line end-line col end-col type fmt)))
714 734
715(defun compilation-move-to-column (col screen) 735(defun compilation-move-to-column (col screen)
@@ -932,7 +952,7 @@ original use. Otherwise, recompile using `compile-command'."
932 `(,(eval compile-command)))))) 952 `(,(eval compile-command))))))
933 953
934(defcustom compilation-scroll-output nil 954(defcustom compilation-scroll-output nil
935 "*Non-nil to scroll the *compilation* buffer window as output appears. 955 "Non-nil to scroll the *compilation* buffer window as output appears.
936 956
937Setting it causes the Compilation mode commands to put point at the 957Setting it causes the Compilation mode commands to put point at the
938end of their output window so that the end of the output is always 958end of their output window so that the end of the output is always
@@ -1026,8 +1046,9 @@ Returns the compilation buffer created."
1026 ;; Clear out the compilation buffer. 1046 ;; Clear out the compilation buffer.
1027 (let ((inhibit-read-only t) 1047 (let ((inhibit-read-only t)
1028 (default-directory thisdir)) 1048 (default-directory thisdir))
1029 ;; Then evaluate a cd command if any, but don't perform it yet, else start-command 1049 ;; Then evaluate a cd command if any, but don't perform it yet, else
1030 ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" 1050 ;; start-command would do it again through the shell: (cd "..") AND
1051 ;; sh -c "cd ..; make"
1031 (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) 1052 (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
1032 (if (match-end 1) 1053 (if (match-end 1)
1033 (substitute-env-vars (match-string 1 command)) 1054 (substitute-env-vars (match-string 1 command))
@@ -1043,6 +1064,8 @@ Returns the compilation buffer created."
1043 (if highlight-regexp 1064 (if highlight-regexp
1044 (set (make-local-variable 'compilation-highlight-regexp) 1065 (set (make-local-variable 'compilation-highlight-regexp)
1045 highlight-regexp)) 1066 highlight-regexp))
1067 (if compilation-auto-jump-to-first-error
1068 (set (make-local-variable 'compilation-auto-jump-to-next) t))
1046 ;; Output a mode setter, for saving and later reloading this buffer. 1069 ;; Output a mode setter, for saving and later reloading this buffer.
1047 (insert "-*- mode: " name-of-mode 1070 (insert "-*- mode: " name-of-mode
1048 "; default-directory: " (prin1-to-string default-directory) 1071 "; default-directory: " (prin1-to-string default-directory)
@@ -1075,7 +1098,8 @@ Returns the compilation buffer created."
1075 (unless (getenv "EMACS") 1098 (unless (getenv "EMACS")
1076 (list "EMACS=t")) 1099 (list "EMACS=t"))
1077 (list "INSIDE_EMACS=t") 1100 (list "INSIDE_EMACS=t")
1078 (copy-sequence process-environment)))) 1101 (copy-sequence process-environment)))
1102 (start-process (symbol-function 'start-process)))
1079 (set (make-local-variable 'compilation-arguments) 1103 (set (make-local-variable 'compilation-arguments)
1080 (list command mode name-function highlight-regexp)) 1104 (list command mode name-function highlight-regexp))
1081 (set (make-local-variable 'revert-buffer-function) 1105 (set (make-local-variable 'revert-buffer-function)
@@ -1091,53 +1115,39 @@ Returns the compilation buffer created."
1091 (funcall compilation-process-setup-function)) 1115 (funcall compilation-process-setup-function))
1092 (compilation-set-window-height outwin) 1116 (compilation-set-window-height outwin)
1093 ;; Start the compilation. 1117 ;; Start the compilation.
1094 (if (fboundp 'start-process) 1118 (let ((proc
1095 (let ((proc (if (eq mode t) 1119 (if (eq mode t)
1096 (get-buffer-process 1120 ;; comint uses `start-file-process'.
1097 (with-no-warnings 1121 (get-buffer-process
1098 (comint-exec outbuf (downcase mode-name) 1122 (with-no-warnings
1099 shell-file-name nil `("-c" ,command)))) 1123 (comint-exec outbuf (downcase mode-name)
1100 (start-process-shell-command (downcase mode-name) 1124 shell-file-name nil `("-c" ,command))))
1101 outbuf command)))) 1125 ;; Redefine temporarily `start-process' in order to
1102 ;; Make the buffer's mode line show process state. 1126 ;; handle remote compilation.
1103 (setq mode-line-process '(":%s")) 1127 (fset 'start-process
1104 (set-process-sentinel proc 'compilation-sentinel) 1128 (lambda (name buffer program &rest program-args)
1105 (set-process-filter proc 'compilation-filter) 1129 (apply
1106 (set-marker (process-mark proc) (point) outbuf) 1130 (if (file-remote-p default-directory)
1107 (when compilation-disable-input 1131 'start-file-process
1108 (condition-case nil 1132 start-process)
1109 (process-send-eof proc) 1133 name buffer program program-args)))
1110 ;; The process may have exited already. 1134 (unwind-protect
1111 (error nil))) 1135 (start-process-shell-command (downcase mode-name)
1112 (setq compilation-in-progress 1136 outbuf command)
1113 (cons proc compilation-in-progress))) 1137 ;; Unwindform: Reset original definition of `start-process'.
1114 ;; No asynchronous processes available. 1138 (fset 'start-process start-process)))))
1115 (message "Executing `%s'..." command) 1139 ;; Make the buffer's mode line show process state.
1116 ;; Fake modeline display as if `start-process' were run. 1140 (setq mode-line-process '(":%s"))
1117 (setq mode-line-process ":run") 1141 (set-process-sentinel proc 'compilation-sentinel)
1118 (force-mode-line-update) 1142 (set-process-filter proc 'compilation-filter)
1119 (sit-for 0) ; Force redisplay 1143 (set-marker (process-mark proc) (point) outbuf)
1120 (let* ((buffer-read-only nil) ; call-process needs to modify outbuf 1144 (when compilation-disable-input
1121 (status (call-process shell-file-name nil outbuf nil "-c" 1145 (condition-case nil
1122 command))) 1146 (process-send-eof proc)
1123 (cond ((numberp status) 1147 ;; The process may have exited already.
1124 (compilation-handle-exit 'exit status 1148 (error nil)))
1125 (if (zerop status) 1149 (setq compilation-in-progress
1126 "finished\n" 1150 (cons proc compilation-in-progress))))
1127 (format "\
1128exited abnormally with code %d\n"
1129 status))))
1130 ((stringp status)
1131 (compilation-handle-exit 'signal status
1132 (concat status "\n")))
1133 (t
1134 (compilation-handle-exit 'bizarre status status))))
1135 ;; Without async subprocesses, the buffer is not yet
1136 ;; fontified, so fontify it now.
1137 (let ((font-lock-verbose nil)) ; shut up font-lock messages
1138 (font-lock-fontify-buffer))
1139 (set-buffer-modified-p nil)
1140 (message "Executing `%s'...done" command)))
1141 ;; Now finally cd to where the shell started make/grep/... 1151 ;; Now finally cd to where the shell started make/grep/...
1142 (setq default-directory thisdir)) 1152 (setq default-directory thisdir))
1143 (if (buffer-local-value 'compilation-scroll-output outbuf) 1153 (if (buffer-local-value 'compilation-scroll-output outbuf)
@@ -1258,7 +1268,7 @@ exited abnormally with code %d\n"
1258 "*If non-nil, skip multiple error messages for the same source location.") 1268 "*If non-nil, skip multiple error messages for the same source location.")
1259 1269
1260(defcustom compilation-skip-threshold 1 1270(defcustom compilation-skip-threshold 1
1261 "*Compilation motion commands skip less important messages. 1271 "Compilation motion commands skip less important messages.
1262The value can be either 2 -- skip anything less than error, 1 -- 1272The value can be either 2 -- skip anything less than error, 1 --
1263skip anything less than warning or 0 -- don't skip any messages. 1273skip anything less than warning or 0 -- don't skip any messages.
1264Note that all messages not positively identified as warning or 1274Note that all messages not positively identified as warning or
@@ -1270,7 +1280,7 @@ info, are considered errors."
1270 :version "22.1") 1280 :version "22.1")
1271 1281
1272(defcustom compilation-skip-visited nil 1282(defcustom compilation-skip-visited nil
1273 "*Compilation motion commands skip visited messages if this is t. 1283 "Compilation motion commands skip visited messages if this is t.
1274Visited messages are ones for which the file, line and column have been jumped 1284Visited messages are ones for which the file, line and column have been jumped
1275to from the current content in the current compilation buffer, even if it was 1285to from the current content in the current compilation buffer, even if it was
1276from a different message." 1286from a different message."
@@ -1371,6 +1381,8 @@ Optional argument MINOR indicates this is called from
1371 ;; with the next-error function in simple.el, and it's only 1381 ;; with the next-error function in simple.el, and it's only
1372 ;; coincidentally named similarly to compilation-next-error. 1382 ;; coincidentally named similarly to compilation-next-error.
1373 (setq next-error-function 'compilation-next-error-function) 1383 (setq next-error-function 'compilation-next-error-function)
1384 (set (make-local-variable 'comint-file-name-prefix)
1385 (or (file-remote-p default-directory) ""))
1374 (set (make-local-variable 'font-lock-extra-managed-props) 1386 (set (make-local-variable 'font-lock-extra-managed-props)
1375 '(directory message help-echo mouse-face debug)) 1387 '(directory message help-echo mouse-face debug))
1376 (set (make-local-variable 'compilation-locs) 1388 (set (make-local-variable 'compilation-locs)
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 4dbc9893f61..7bc904f8319 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -1765,7 +1765,7 @@ static char *magick[] = {
1765 1765
1766(defface breakpoint-enabled 1766(defface breakpoint-enabled
1767 '((t 1767 '((t
1768 :foreground "red" 1768 :foreground "red1"
1769 :weight bold)) 1769 :weight bold))
1770 "Face for enabled breakpoint icon in fringe." 1770 "Face for enabled breakpoint icon in fringe."
1771 :group 'gud) 1771 :group 'gud)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index aa382d4e185..97144fec83b 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -237,7 +237,7 @@ Used to grey out relevant toolbar icons.")
237 ([menu-bar run] menu-item 237 ([menu-bar run] menu-item
238 ,(propertize "run" 'face 'font-lock-doc-face) gud-run 238 ,(propertize "run" 'face 'font-lock-doc-face) gud-run
239 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 239 :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb)))
240 ([menu-bar go] menu-item 240 ([menu-bar go] menu-item
241 ,(propertize " go " 'face 'font-lock-doc-face) gud-go 241 ,(propertize " go " 'face 'font-lock-doc-face) gud-go
242 :visible (and (not gud-running) 242 :visible (and (not gud-running)
243 (eq gud-minor-mode 'gdba))) 243 (eq gud-minor-mode 'gdba)))
@@ -292,6 +292,11 @@ Used to grey out relevant toolbar icons.")
292(defun gud-file-name (f) 292(defun gud-file-name (f)
293 "Transform a relative file name to an absolute file name. 293 "Transform a relative file name to an absolute file name.
294Uses `gud-<MINOR-MODE>-directories' to find the source files." 294Uses `gud-<MINOR-MODE>-directories' to find the source files."
295 ;; When `default-directory' is a remote file name, prepend its
296 ;; remote part to f, which is the local file name. Fortunately,
297 ;; `file-remote-p' returns exactly this remote file name part (or
298 ;; nil otherwise).
299 (setq f (concat (or (file-remote-p default-directory) "") f))
295 (if (file-exists-p f) (expand-file-name f) 300 (if (file-exists-p f) (expand-file-name f)
296 (let ((directories (gud-val 'directories)) 301 (let ((directories (gud-val 'directories))
297 (result nil)) 302 (result nil))
@@ -2510,7 +2515,10 @@ comint mode, which see."
2510 (while (and w (not (eq (car w) t))) 2515 (while (and w (not (eq (car w) t)))
2511 (setq w (cdr w))) 2516 (setq w (cdr w)))
2512 (if w 2517 (if w
2513 (setcar w file))) 2518 (setcar w
2519 (if (file-remote-p default-directory)
2520 (setq file (file-name-nondirectory file))
2521 file))))
2514 (apply 'make-comint (concat "gud" filepart) program nil 2522 (apply 'make-comint (concat "gud" filepart) program nil
2515 (if massage-args (funcall massage-args file args) args)) 2523 (if massage-args (funcall massage-args file args) args))
2516 ;; Since comint clobbered the mode, we don't set it until now. 2524 ;; Since comint clobbered the mode, we don't set it until now.
@@ -3114,7 +3122,7 @@ class of the file (using s to separate nested class ids)."
3114 'syntax-table (eval-when-compile 3122 'syntax-table (eval-when-compile
3115 (string-to-syntax "> b"))) 3123 (string-to-syntax "> b")))
3116 ;; Make sure that rehighlighting the previous line won't erase our 3124 ;; Make sure that rehighlighting the previous line won't erase our
3117 ;; syntax-table property. 3125 ;; syntax-table property.
3118 (put-text-property (1- (match-beginning 0)) (match-end 0) 3126 (put-text-property (1- (match-beginning 0)) (match-end 0)
3119 'font-lock-multiline t) 3127 'font-lock-multiline t)
3120 nil))))) 3128 nil)))))
@@ -3193,8 +3201,12 @@ Treats actions as defuns."
3193 (goto-char (point-max))) 3201 (goto-char (point-max)))
3194 t) 3202 t)
3195 3203
3204;; Besides .gdbinit, gdb documents other names to be usable for init
3205;; files, cross-debuggers can use something like
3206;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
3207;; don't interfere with each other.
3196;;;###autoload 3208;;;###autoload
3197(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode)) 3209(add-to-list 'auto-mode-alist '("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode))
3198 3210
3199;;;###autoload 3211;;;###autoload
3200(define-derived-mode gdb-script-mode nil "GDB-Script" 3212(define-derived-mode gdb-script-mode nil "GDB-Script"
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 5c117dffd5d..26fc122631d 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -996,7 +996,16 @@ don't move and return nil. Otherwise return t."
996 (throw 'done t))))))) 996 (throw 'done t)))))))
997 (setq arg (1- arg))) 997 (setq arg (1- arg)))
998 (zerop arg))) 998 (zerop arg)))
999 999
1000(defvar python-which-func-length-limit 40
1001 "Non-strict length limit for `python-which-func' output.")
1002
1003(defun python-which-func ()
1004 (let ((function-name (python-current-defun python-which-func-length-limit)))
1005 (set-text-properties 0 (length function-name) nil function-name)
1006 function-name))
1007
1008
1000;;;; Imenu. 1009;;;; Imenu.
1001 1010
1002(defvar python-recursing) 1011(defvar python-recursing)
@@ -1814,22 +1823,30 @@ of current line."
1814 (1+ (/ (current-indentation) python-indent))) 1823 (1+ (/ (current-indentation) python-indent)))
1815 1824
1816;; Fixme: Consider top-level assignments, imports, &c. 1825;; Fixme: Consider top-level assignments, imports, &c.
1817(defun python-current-defun () 1826(defun python-current-defun (&optional length-limit)
1818 "`add-log-current-defun-function' for Python." 1827 "`add-log-current-defun-function' for Python."
1819 (save-excursion 1828 (save-excursion
1820 ;; Move up the tree of nested `class' and `def' blocks until we 1829 ;; Move up the tree of nested `class' and `def' blocks until we
1821 ;; get to zero indentation, accumulating the defined names. 1830 ;; get to zero indentation, accumulating the defined names.
1822 (let ((start t) 1831 (let ((start t)
1823 accum) 1832 (accum)
1824 (while (or start (> (current-indentation) 0)) 1833 (length -1))
1834 (while (and (or start (> (current-indentation) 0))
1835 (or (null length-limit)
1836 (null (cdr accum))
1837 (< length length-limit)))
1825 (setq start nil) 1838 (setq start nil)
1826 (python-beginning-of-block) 1839 (python-beginning-of-block)
1827 (end-of-line) 1840 (end-of-line)
1828 (beginning-of-defun) 1841 (beginning-of-defun)
1829 (if (looking-at (rx (0+ space) (or "def" "class") (1+ space) 1842 (when (looking-at (rx (0+ space) (or "def" "class") (1+ space)
1830 (group (1+ (or word (syntax symbol)))))) 1843 (group (1+ (or word (syntax symbol))))))
1831 (push (match-string 1) accum))) 1844 (push (match-string 1) accum)
1832 (if accum (mapconcat 'identity accum "."))))) 1845 (setq length (+ length 1 (length (car accum))))))
1846 (when accum
1847 (when (and length-limit (> length length-limit))
1848 (setcar accum ".."))
1849 (mapconcat 'identity accum ".")))))
1833 1850
1834(defun python-mark-block () 1851(defun python-mark-block ()
1835 "Mark the block around point. 1852 "Mark the block around point.
@@ -2248,6 +2265,7 @@ with skeleton expansions for compound statement templates.
2248 (set (make-local-variable 'beginning-of-defun-function) 2265 (set (make-local-variable 'beginning-of-defun-function)
2249 'python-beginning-of-defun) 2266 'python-beginning-of-defun)
2250 (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun) 2267 (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun)
2268 (add-hook 'which-func-functions 'python-which-func nil t)
2251 (setq imenu-create-index-function #'python-imenu-create-index) 2269 (setq imenu-create-index-function #'python-imenu-create-index)
2252 (set (make-local-variable 'eldoc-documentation-function) 2270 (set (make-local-variable 'eldoc-documentation-function)
2253 #'python-eldoc-function) 2271 #'python-eldoc-function)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 43c70f67dfb..5b5c13342ad 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -76,8 +76,8 @@
76 :version "20.3") 76 :version "20.3")
77 77
78(defcustom which-func-modes 78(defcustom which-func-modes
79 '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode 79 '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode python-mode
80 sh-mode fortran-mode f90-mode ada-mode) 80 makefile-mode sh-mode fortran-mode f90-mode ada-mode)
81 "List of major modes for which Which Function mode should be used. 81 "List of major modes for which Which Function mode should be used.
82For other modes it is disabled. If this is equal to t, 82For other modes it is disabled. If this is equal to t,
83then Which Function mode is enabled in any major mode that supports it." 83then Which Function mode is enabled in any major mode that supports it."
diff --git a/lisp/replace.el b/lisp/replace.el
index ed1fa9a6b59..5d4c2a2eba6 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -860,7 +860,7 @@ Compatibility function for \\[next-error] invocations."
860 860
861(defface match 861(defface match
862 '((((class color) (min-colors 88) (background light)) 862 '((((class color) (min-colors 88) (background light))
863 :background "yellow") 863 :background "yellow1")
864 (((class color) (min-colors 88) (background dark)) 864 (((class color) (min-colors 88) (background dark))
865 :background "RoyalBlue3") 865 :background "RoyalBlue3")
866 (((class color) (min-colors 8) (background light)) 866 (((class color) (min-colors 8) (background light))
diff --git a/lisp/subr.el b/lisp/subr.el
index ff43b9f9c7f..9d2dcb496b0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -103,7 +103,7 @@ change the list."
103When COND yields non-nil, eval BODY forms sequentially and return 103When COND yields non-nil, eval BODY forms sequentially and return
104value of last one, or nil if there are none. 104value of last one, or nil if there are none.
105 105
106\(fn COND BODY ...)" 106\(fn COND BODY...)"
107 (declare (indent 1) (debug t)) 107 (declare (indent 1) (debug t))
108 (list 'if cond (cons 'progn body))) 108 (list 'if cond (cons 'progn body)))
109 109
@@ -112,7 +112,7 @@ value of last one, or nil if there are none.
112When COND yields nil, eval BODY forms sequentially and return 112When COND yields nil, eval BODY forms sequentially and return
113value of last one, or nil if there are none. 113value of last one, or nil if there are none.
114 114
115\(fn COND BODY ...)" 115\(fn COND BODY...)"
116 (declare (indent 1) (debug t)) 116 (declare (indent 1) (debug t))
117 (cons 'if (cons cond (cons nil body)))) 117 (cons 'if (cons cond (cons nil body))))
118 118
@@ -510,6 +510,7 @@ Don't call this function; it is for internal use only."
510 (if (integerp b) (< a b) 510 (if (integerp b) (< a b)
511 t) 511 t)
512 (if (integerp b) t 512 (if (integerp b) t
513 ;; string< also accepts symbols.
513 (string< a b)))))) 514 (string< a b))))))
514 (dolist (p list) 515 (dolist (p list)
515 (funcall function (car p) (cdr p)))) 516 (funcall function (car p) (cdr p))))
@@ -1219,7 +1220,8 @@ if it is empty or a duplicate."
1219Execution is delayed if `delay-mode-hooks' is non-nil. 1220Execution is delayed if `delay-mode-hooks' is non-nil.
1220If `delay-mode-hooks' is nil, run `after-change-major-mode-hook' 1221If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
1221after running the mode hooks. 1222after running the mode hooks.
1222Major mode functions should use this." 1223Major mode functions should use this instead of `run-hooks' when running their
1224FOO-mode-hook."
1223 (if delay-mode-hooks 1225 (if delay-mode-hooks
1224 ;; Delaying case. 1226 ;; Delaying case.
1225 (dolist (hook hooks) 1227 (dolist (hook hooks)
@@ -2484,6 +2486,29 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
2484 (or (input-pending-p) 2486 (or (input-pending-p)
2485 ,@body)))))) 2487 ,@body))))))
2486 2488
2489(defmacro condition-case-no-debug (var bodyform &rest handlers)
2490 "Like `condition-case' except that it does not catch anything when debugging.
2491More specifically if `debug-on-error' is set, then it does not catch any signal."
2492 (declare (debug condition-case) (indent 2))
2493 (let ((bodysym (make-symbol "body")))
2494 `(let ((,bodysym (lambda () ,bodyform)))
2495 (if debug-on-error
2496 (funcall ,bodysym)
2497 (condition-case ,var
2498 (funcall ,bodysym)
2499 ,@handlers)))))
2500
2501(defmacro with-demoted-errors (&rest body)
2502 "Run BODY and demote any errors to simple messages.
2503If `debug-on-error' is non-nil, run BODY without catching its errors.
2504This is to be used around code which is not expected to signal an error
2505but which should be robust in the unexpected case that an error is signalled."
2506 (declare (debug t) (indent 0))
2507 (let ((err (make-symbol "err")))
2508 `(condition-case-no-debug ,err
2509 (progn ,@body)
2510 (error (message "Error: %s" ,err) nil))))
2511
2487(defmacro combine-after-change-calls (&rest body) 2512(defmacro combine-after-change-calls (&rest body)
2488 "Execute BODY, but don't call the after-change functions till the end. 2513 "Execute BODY, but don't call the after-change functions till the end.
2489If BODY makes changes in the buffer, they are recorded 2514If BODY makes changes in the buffer, they are recorded
@@ -2518,6 +2543,20 @@ The value returned is the value of the last form in BODY."
2518 2543
2519;;;; Constructing completion tables. 2544;;;; Constructing completion tables.
2520 2545
2546(defun complete-with-action (action table string pred)
2547 "Perform completion ACTION.
2548STRING is the string to complete.
2549TABLE is the completion table, which should not be a function.
2550PRED is a completion predicate.
2551ACTION can be one of nil, t or `lambda'."
2552 ;; (assert (not (functionp table)))
2553 (funcall
2554 (cond
2555 ((null action) 'try-completion)
2556 ((eq action t) 'all-completions)
2557 (t 'test-completion))
2558 string table pred))
2559
2521(defmacro dynamic-completion-table (fun) 2560(defmacro dynamic-completion-table (fun)
2522 "Use function FUN as a dynamic completion table. 2561 "Use function FUN as a dynamic completion table.
2523FUN is called with one argument, the string for which completion is required, 2562FUN is called with one argument, the string for which completion is required,
@@ -2539,10 +2578,7 @@ that can be used as the ALIST argument to `try-completion' and
2539 (with-current-buffer (let ((,win (minibuffer-selected-window))) 2578 (with-current-buffer (let ((,win (minibuffer-selected-window)))
2540 (if (window-live-p ,win) (window-buffer ,win) 2579 (if (window-live-p ,win) (window-buffer ,win)
2541 (current-buffer))) 2580 (current-buffer)))
2542 (cond 2581 (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
2543 ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
2544 ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
2545 (t (test-completion ,string (,fun ,string) ,predicate)))))))
2546 2582
2547(defmacro lazy-completion-table (var fun) 2583(defmacro lazy-completion-table (var fun)
2548 ;; We used to have `&rest args' where `args' were evaluated late (at the 2584 ;; We used to have `&rest args' where `args' were evaluated late (at the
@@ -2667,6 +2703,18 @@ of a match for REGEXP."
2667 (looking-at (concat "\\(?:" regexp "\\)\\'"))))) 2703 (looking-at (concat "\\(?:" regexp "\\)\\'")))))
2668 (not (null pos)))) 2704 (not (null pos))))
2669 2705
2706(defsubst looking-at-p (regexp)
2707 "\
2708Same as `looking-at' except this function does not change the match data."
2709 (let ((inhibit-changing-match-data t))
2710 (looking-at regexp)))
2711
2712(defsubst string-match-p (regexp string &optional start)
2713 "\
2714Same as `string-match' except this function does not change the match data."
2715 (let ((inhibit-changing-match-data t))
2716 (string-match regexp string start)))
2717
2670(defun subregexp-context-p (regexp pos &optional start) 2718(defun subregexp-context-p (regexp pos &optional start)
2671 "Return non-nil if POS is in a normal subregexp context in REGEXP. 2719 "Return non-nil if POS is in a normal subregexp context in REGEXP.
2672A subregexp context is one where a sub-regexp can appear. 2720A subregexp context is one where a sub-regexp can appear.
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 244f9bb0bce..a7eb10dbb4f 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 5.01 8;; Version: 5.03b
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -83,7 +83,7 @@
83 83
84;;; Version 84;;; Version
85 85
86(defconst org-version "5.01" 86(defconst org-version "5.03b"
87 "The version number of the file org.el.") 87 "The version number of the file org.el.")
88(defun org-version () 88(defun org-version ()
89 (interactive) 89 (interactive)
@@ -489,15 +489,22 @@ the values `folded', `children', or `subtree'."
489 :tag "Org Edit Structure" 489 :tag "Org Edit Structure"
490 :group 'org-structure) 490 :group 'org-structure)
491 491
492(defcustom org-special-ctrl-a nil 492
493 "Non-nil means `C-a' behaves specially in headlines. 493(defcustom org-special-ctrl-a/e nil
494 "Non-nil means `C-a' and `C-e' behave specially in headlines.
494When set, `C-a' will bring back the cursor to the beginning of the 495When set, `C-a' will bring back the cursor to the beginning of the
495headline text, i.e. after the stars and after a possible TODO keyword. 496headline text, i.e. after the stars and after a possible TODO keyword.
496When the cursor is already at that position, another `C-a' will bring 497When the cursor is already at that position, another `C-a' will bring
497it to the beginning of the line." 498it to the beginning of the line.
499`C-e' will jump to the end of the headline, ignoring the presence of tags
500in the headline. A second `C-e' will then jump to the true end of the
501line, after any tags."
498 :group 'org-edit-structure 502 :group 'org-edit-structure
499 :type 'boolean) 503 :type 'boolean)
500 504
505(if (fboundp 'defvaralias)
506 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
507
501(defcustom org-odd-levels-only nil 508(defcustom org-odd-levels-only nil
502 "Non-nil means, skip even levels and only use odd levels for the outline. 509 "Non-nil means, skip even levels and only use odd levels for the outline.
503This has the effect that two stars are being added/taken away in 510This has the effect that two stars are being added/taken away in
@@ -1763,7 +1770,7 @@ lined-up with respect to each other."
1763 :group 'org-properties 1770 :group 'org-properties
1764 :type 'string) 1771 :type 'string)
1765 1772
1766(defcustom org-default-columns-format "%25ITEM %TODO %3PRIORITY %TAGS" 1773(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
1767 "The default column format, if no other format has been defined. 1774 "The default column format, if no other format has been defined.
1768This variable can be set on the per-file basis by inserting a line 1775This variable can be set on the per-file basis by inserting a line
1769 1776
@@ -3244,6 +3251,12 @@ color of the frame."
3244 "Face for column display of entry properties." 3251 "Face for column display of entry properties."
3245 :group 'org-faces) 3252 :group 'org-faces)
3246 3253
3254(when (fboundp 'set-face-attribute)
3255 ;; Make sure that a fixed-width face is used when we have a column table.
3256 (set-face-attribute 'org-column nil
3257 :height (face-attribute 'default :height)
3258 :family (face-attribute 'default :family)))
3259
3247(defface org-warning ;; font-lock-warning-face 3260(defface org-warning ;; font-lock-warning-face
3248 (org-compatible-face 3261 (org-compatible-face
3249 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3262 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
@@ -3402,8 +3415,13 @@ to the part of the headline after the DONE keyword."
3402 '(org-level-1 org-level-2 org-level-3 org-level-4 3415 '(org-level-1 org-level-2 org-level-3 org-level-4
3403 org-level-5 org-level-6 org-level-7 org-level-8 3416 org-level-5 org-level-6 org-level-7 org-level-8
3404 )) 3417 ))
3405(defconst org-n-levels (length org-level-faces))
3406 3418
3419(defcustom org-n-level-faces (length org-level-faces)
3420 "The number different faces to be used for headlines.
3421Org-mode defines 8 different headline faces, so this can be at most 8.
3422If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3423 :type 'number
3424 :group 'org-faces)
3407 3425
3408;;; Variables for pre-computed regular expressions, all buffer local 3426;;; Variables for pre-computed regular expressions, all buffer local
3409 3427
@@ -3573,7 +3591,7 @@ means to push this value onto the list in the variable.")
3573 ((equal key "TAGS") 3591 ((equal key "TAGS")
3574 (setq tags (append tags (org-split-string value splitre)))) 3592 (setq tags (append tags (org-split-string value splitre))))
3575 ((equal key "COLUMNS") 3593 ((equal key "COLUMNS")
3576 (org-set-local 'org-default-columns-format value)) 3594 (org-set-local 'org-columns-default-format value))
3577 ((equal key "LINK") 3595 ((equal key "LINK")
3578 (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) 3596 (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
3579 (push (cons (match-string 1 value) 3597 (push (cons (match-string 1 value)
@@ -3678,15 +3696,15 @@ means to push this value onto the list in the variable.")
3678 (mapconcat 'regexp-quote org-not-done-keywords "\\|") 3696 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
3679 "\\)\\>") 3697 "\\)\\>")
3680 org-todo-line-regexp 3698 org-todo-line-regexp
3681 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3699 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
3682 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 3700 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3683 "\\)\\>\\)? *\\(.*\\)") 3701 "\\)\\>\\)?[ \t]*\\(.*\\)")
3684 org-nl-done-regexp 3702 org-nl-done-regexp
3685 (concat "[\r\n]\\*+[ \t]+" 3703 (concat "\n\\*+[ \t]+"
3686 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") 3704 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
3687 "\\)" "\\>") 3705 "\\)" "\\>")
3688 org-todo-line-tags-regexp 3706 org-todo-line-tags-regexp
3689 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3707 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
3690 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 3708 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3691 (org-re 3709 (org-re
3692 "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) 3710 "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)"))
@@ -3982,7 +4000,7 @@ The following commands are available:
3982 (org-add-to-invisibility-spec '(org-cwidth)) 4000 (org-add-to-invisibility-spec '(org-cwidth))
3983 (when (featurep 'xemacs) 4001 (when (featurep 'xemacs)
3984 (org-set-local 'line-move-ignore-invisible t)) 4002 (org-set-local 'line-move-ignore-invisible t))
3985 (setq outline-regexp "\\*+") 4003 (setq outline-regexp "\\*+ ")
3986 (setq outline-level 'org-outline-level) 4004 (setq outline-level 'org-outline-level)
3987 (when (and org-ellipsis (stringp org-ellipsis) 4005 (when (and org-ellipsis (stringp org-ellipsis)
3988 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) 4006 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table))
@@ -4412,17 +4430,20 @@ between words."
4412 (looking-at outline-regexp) 4430 (looking-at outline-regexp)
4413 (if (match-beginning 1) 4431 (if (match-beginning 1)
4414 (+ (org-get-string-indentation (match-string 1)) 1000) 4432 (+ (org-get-string-indentation (match-string 1)) 1000)
4415 (- (match-end 0) (match-beginning 0))))) 4433 (1- (- (match-end 0) (match-beginning 0))))))
4416 4434
4417(defvar org-font-lock-keywords nil) 4435(defvar org-font-lock-keywords nil)
4418 4436
4437(defconst org-property-re "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(\\S-.*\\)"
4438 "Regular expression matching a property line.")
4439
4419(defun org-set-font-lock-defaults () 4440(defun org-set-font-lock-defaults ()
4420 (let* ((em org-fontify-emphasized-text) 4441 (let* ((em org-fontify-emphasized-text)
4421 (lk org-activate-links) 4442 (lk org-activate-links)
4422 (org-font-lock-extra-keywords 4443 (org-font-lock-extra-keywords
4423 ;; Headlines 4444 ;; Headlines
4424 (list 4445 (list
4425 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) 4446 '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1))
4426 (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) 4447 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
4427 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 4448 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
4428 (1 'org-table)) 4449 (1 'org-table))
@@ -4436,7 +4457,7 @@ between words."
4436 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) 4457 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
4437 '(org-hide-wide-columns (0 nil append)) 4458 '(org-hide-wide-columns (0 nil append))
4438 ;; TODO lines 4459 ;; TODO lines
4439 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 4460 (list (concat "^\\*+[ \t]+" org-not-done-regexp)
4440 '(1 'org-todo t)) 4461 '(1 'org-todo t))
4441 ;; Priorities 4462 ;; Priorities
4442 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) 4463 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t))
@@ -4452,13 +4473,13 @@ between words."
4452 '(org-do-emphasis-faces (0 nil append)) 4473 '(org-do-emphasis-faces (0 nil append))
4453 '(org-do-emphasis-faces))) 4474 '(org-do-emphasis-faces)))
4454 ;; Checkboxes, similar to Frank Ruell's org-checklet.el 4475 ;; Checkboxes, similar to Frank Ruell's org-checklet.el
4455 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" 4476 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
4456 2 'bold prepend) 4477 2 'bold prepend)
4457 (if org-provide-checkbox-statistics 4478 (if org-provide-checkbox-statistics
4458 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 4479 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
4459 (0 (org-get-checkbox-statistics-face) t))) 4480 (0 (org-get-checkbox-statistics-face) t)))
4460 ;; COMMENT 4481 ;; COMMENT
4461 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string 4482 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
4462 "\\|" org-quote-string "\\)\\>") 4483 "\\|" org-quote-string "\\)\\>")
4463 '(1 'org-special-keyword t)) 4484 '(1 'org-special-keyword t))
4464 '("^#.*" (0 'font-lock-comment-face t)) 4485 '("^#.*" (0 'font-lock-comment-face t))
@@ -4475,14 +4496,18 @@ between words."
4475 ;; Table stuff 4496 ;; Table stuff
4476 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 4497 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
4477 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 4498 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
4478 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) 4499; '("^[ \t]*| *\\([#!$*_^/]\\) *|" (1 'org-formula t))
4500 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
4501 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
4479 ;; Drawers 4502 ;; Drawers
4480 (list org-drawer-regexp '(0 'org-drawer t)) 4503; (list org-drawer-regexp '(0 'org-drawer t))
4481 (list "^[ \t]*:END:" '(0 'org-drawer t)) 4504; (list "^[ \t]*:END:" '(0 'org-drawer t))
4505 (list org-drawer-regexp '(0 'org-special-keyword t))
4506 (list "^[ \t]*:END:" '(0 'org-special-keyword t))
4482 ;; Properties 4507 ;; Properties
4483 '("^[ \t]*\\(:[a-zA-Z0-9]+:\\)[ \t]*\\(\\S-.*\\)" 4508 (list org-property-re
4484 (1 'org-special-keyword t) (2 'org-property-value t)) 4509 '(1 'org-special-keyword t)
4485;FIXME (1 'org-tag t) (2 'org-property-value t)) 4510 '(3 'org-property-value t))
4486 (if org-format-transports-properties-p 4511 (if org-format-transports-properties-p
4487 '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) 4512 '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
4488 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) 4513 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
@@ -4499,9 +4524,9 @@ between words."
4499(defvar org-f nil) 4524(defvar org-f nil)
4500(defun org-get-level-face (n) 4525(defun org-get-level-face (n)
4501 "Get the right face for match N in font-lock matching of healdines." 4526 "Get the right face for match N in font-lock matching of healdines."
4502 (setq org-l (- (match-end 2) (match-beginning 1))) 4527 (setq org-l (- (match-end 2) (match-beginning 1) 1))
4503 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) 4528 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
4504 (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces)) 4529 (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
4505 (cond 4530 (cond
4506 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) 4531 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
4507 ((eq n 2) org-f) 4532 ((eq n 2) org-f)
@@ -4559,7 +4584,7 @@ between words."
4559 (interactive "P") 4584 (interactive "P")
4560 (let* ((outline-regexp 4585 (let* ((outline-regexp
4561 (if (and (org-mode-p) org-cycle-include-plain-lists) 4586 (if (and (org-mode-p) org-cycle-include-plain-lists)
4562 "\\(?:\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" 4587 "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)"
4563 outline-regexp)) 4588 outline-regexp))
4564 (bob-special (and org-cycle-global-at-bob (bobp) 4589 (bob-special (and org-cycle-global-at-bob (bobp)
4565 (not (looking-at outline-regexp)))) 4590 (not (looking-at outline-regexp))))
@@ -5175,8 +5200,8 @@ If the region is active in `transient-mark-mode', promote all headings
5175in the region." 5200in the region."
5176 (org-back-to-heading t) 5201 (org-back-to-heading t)
5177 (let* ((level (save-match-data (funcall outline-level))) 5202 (let* ((level (save-match-data (funcall outline-level)))
5178 (up-head (make-string (org-get-legal-level level -1) ?*)) 5203 (up-head (concat (make-string (org-get-legal-level level -1) ?*) " "))
5179 (diff (abs (- level (length up-head))))) 5204 (diff (abs (- level (length up-head) -1))))
5180 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) 5205 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
5181 (replace-match up-head nil t) 5206 (replace-match up-head nil t)
5182 ;; Fixup tag positioning 5207 ;; Fixup tag positioning
@@ -5189,8 +5214,8 @@ If the region is active in `transient-mark-mode', demote all headings
5189in the region." 5214in the region."
5190 (org-back-to-heading t) 5215 (org-back-to-heading t)
5191 (let* ((level (save-match-data (funcall outline-level))) 5216 (let* ((level (save-match-data (funcall outline-level)))
5192 (down-head (make-string (org-get-legal-level level 1) ?*)) 5217 (down-head (concat (make-string (org-get-legal-level level 1) ?*) " "))
5193 (diff (abs (- level (length down-head))))) 5218 (diff (abs (- level (length down-head) -1))))
5194 (replace-match down-head nil t) 5219 (replace-match down-head nil t)
5195 ;; Fixup tag positioning 5220 ;; Fixup tag positioning
5196 (and org-auto-align-tags (org-set-tags nil t)) 5221 (and org-auto-align-tags (org-set-tags nil t))
@@ -5251,8 +5276,8 @@ level 5 etc."
5251 (let ((org-odd-levels-only nil) n) 5276 (let ((org-odd-levels-only nil) n)
5252 (save-excursion 5277 (save-excursion
5253 (goto-char (point-min)) 5278 (goto-char (point-min))
5254 (while (re-search-forward "^\\*\\*+" nil t) 5279 (while (re-search-forward "^\\*\\*+ " nil t)
5255 (setq n (1- (length (match-string 0)))) 5280 (setq n (- (length (match-string 0)) 2))
5256 (while (>= (setq n (1- n)) 0) 5281 (while (>= (setq n (1- n)) 0)
5257 (org-demote)) 5282 (org-demote))
5258 (end-of-line 1)))))) 5283 (end-of-line 1))))))
@@ -5266,15 +5291,15 @@ is signaled in this case."
5266 (interactive) 5291 (interactive)
5267 (goto-char (point-min)) 5292 (goto-char (point-min))
5268 ;; First check if there are no even levels 5293 ;; First check if there are no even levels
5269 (when (re-search-forward "^\\(\\*\\*\\)+[^*]" nil t) 5294 (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
5270 (org-show-context t) 5295 (org-show-context t)
5271 (error "Not all levels are odd in this file. Conversion not possible.")) 5296 (error "Not all levels are odd in this file. Conversion not possible."))
5272 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") 5297 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
5273 (let ((org-odd-levels-only nil) n) 5298 (let ((org-odd-levels-only nil) n)
5274 (save-excursion 5299 (save-excursion
5275 (goto-char (point-min)) 5300 (goto-char (point-min))
5276 (while (re-search-forward "^\\*\\*+" nil t) 5301 (while (re-search-forward "^\\*\\*+ " nil t)
5277 (setq n (/ (length (match-string 0)) 2)) 5302 (setq n (/ (length (1- (match-string 0))) 2))
5278 (while (>= (setq n (1- n)) 0) 5303 (while (>= (setq n (1- n)) 0)
5279 (org-promote)) 5304 (org-promote))
5280 (end-of-line 1)))))) 5305 (end-of-line 1))))))
@@ -5399,7 +5424,7 @@ If optional TREE is given, use this text instead of the kill ring."
5399 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) 5424 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
5400 5425
5401 (old-level (if (string-match ^re txt) 5426 (old-level (if (string-match ^re txt)
5402 (- (match-end 0) (match-beginning 0)) 5427 (- (match-end 0) (match-beginning 0) 1)
5403 -1)) 5428 -1))
5404 (force-level (cond (level (prefix-numeric-value level)) 5429 (force-level (cond (level (prefix-numeric-value level))
5405 ((string-match 5430 ((string-match
@@ -5693,7 +5718,7 @@ Return t when things worked, nil when we are not in an item."
5693 (save-excursion 5718 (save-excursion
5694 (goto-char (match-end 0)) 5719 (goto-char (match-end 0))
5695 (skip-chars-forward " \t") 5720 (skip-chars-forward " \t")
5696 (looking-at "\\[[ X]\\]")))) 5721 (looking-at "\\[[- X]\\]"))))
5697 5722
5698(defun org-toggle-checkbox (&optional arg) 5723(defun org-toggle-checkbox (&optional arg)
5699 "Toggle the checkbox in the current line." 5724 "Toggle the checkbox in the current line."
@@ -5707,7 +5732,11 @@ Return t when things worked, nil when we are not in an item."
5707 (setq beg (point) end (save-excursion (outline-next-heading) (point)))) 5732 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
5708 ((org-at-item-checkbox-p) 5733 ((org-at-item-checkbox-p)
5709 (save-excursion 5734 (save-excursion
5710 (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t)) 5735 (replace-match
5736 (cond (arg "[-]")
5737 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
5738 (t "[ ]"))
5739 t t))
5711 (throw 'exit t)) 5740 (throw 'exit t))
5712 (t (error "Not at a checkbox or heading, and no active region"))) 5741 (t (error "Not at a checkbox or heading, and no active region")))
5713 (save-excursion 5742 (save-excursion
@@ -5741,7 +5770,7 @@ the whole buffer."
5741 (end (move-marker (make-marker) 5770 (end (move-marker (make-marker)
5742 (progn (outline-next-heading) (point)))) 5771 (progn (outline-next-heading) (point))))
5743 (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") 5772 (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)")
5744 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)") 5773 (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
5745 b1 e1 f1 c-on c-off lim (cstat 0)) 5774 b1 e1 f1 c-on c-off lim (cstat 0))
5746 (when all 5775 (when all
5747 (goto-char (point-min)) 5776 (goto-char (point-min))
@@ -5761,7 +5790,7 @@ the whole buffer."
5761 (goto-char e1) 5790 (goto-char e1)
5762 (when lim 5791 (when lim
5763 (while (re-search-forward re-box lim t) 5792 (while (re-search-forward re-box lim t)
5764 (if (equal (match-string 2) "[ ]") 5793 (if (member (match-string 2) '("[ ]" "[-]"))
5765 (setq c-off (1+ c-off)) 5794 (setq c-off (1+ c-off))
5766 (setq c-on (1+ c-on)))) 5795 (setq c-on (1+ c-on))))
5767 (delete-region b1 e1) 5796 (delete-region b1 e1)
@@ -6285,6 +6314,8 @@ C-c C-c Set tags / toggle checkbox"
6285 '([(meta shift down)] org-shiftmetadown) 6314 '([(meta shift down)] org-shiftmetadown)
6286 '([(meta shift left)] org-shiftmetaleft) 6315 '([(meta shift left)] org-shiftmetaleft)
6287 '([(meta shift right)] org-shiftmetaright) 6316 '([(meta shift right)] org-shiftmetaright)
6317 '([(shift up)] org-shiftup)
6318 '([(shift down)] org-shiftdown)
6288 '("\M-q" fill-paragraph) 6319 '("\M-q" fill-paragraph)
6289 '("\C-c^" org-sort) 6320 '("\C-c^" org-sort)
6290 '("\C-c-" org-cycle-list-bullet))) 6321 '("\C-c-" org-cycle-list-bullet)))
@@ -6466,8 +6497,7 @@ this heading."
6466 (if heading 6497 (if heading
6467 (progn 6498 (progn
6468 (if (re-search-forward 6499 (if (re-search-forward
6469 (concat "\\(^\\|\r\\)" 6500 (concat "^" (regexp-quote heading)
6470 (regexp-quote heading)
6471 (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) 6501 (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)"))
6472 nil t) 6502 nil t)
6473 (goto-char (match-end 0)) 6503 (goto-char (match-end 0))
@@ -7131,7 +7161,7 @@ Optional argument NEW may specify text to replace the current field content."
7131 (setq n (concat new "|") org-table-may-need-update t))) 7161 (setq n (concat new "|") org-table-may-need-update t)))
7132 (or (equal n o) 7162 (or (equal n o)
7133 (let (org-table-may-need-update) 7163 (let (org-table-may-need-update)
7134 (replace-match n)))) 7164 (replace-match n t t))))
7135 (setq org-table-may-need-update t)) 7165 (setq org-table-may-need-update t))
7136 (goto-char pos)))))) 7166 (goto-char pos))))))
7137 7167
@@ -7302,7 +7332,6 @@ is always the old value."
7302 val) 7332 val)
7303 (forward-char 1) "")) 7333 (forward-char 1) ""))
7304 7334
7305
7306(defun org-table-field-info (arg) 7335(defun org-table-field-info (arg)
7307 "Show info about the current field, and highlight any reference at point." 7336 "Show info about the current field, and highlight any reference at point."
7308 (interactive "P") 7337 (interactive "P")
@@ -7723,7 +7752,7 @@ should be done in reverse order."
7723 (setq beg (point-at-bol 1))) 7752 (setq beg (point-at-bol 1)))
7724 (goto-char pos) 7753 (goto-char pos)
7725 (if (re-search-forward org-table-hline-regexp tend t) 7754 (if (re-search-forward org-table-hline-regexp tend t)
7726 (setq end (point-at-bol 0)) 7755 (setq end (point-at-bol 1))
7727 (goto-char tend) 7756 (goto-char tend)
7728 (setq end (point-at-bol)))) 7757 (setq end (point-at-bol))))
7729 (setq beg (move-marker (make-marker) beg) 7758 (setq beg (move-marker (make-marker) beg)
@@ -8709,7 +8738,7 @@ HIGHLIGHT means, just highlight the range."
8709 (goto-line r1) 8738 (goto-line r1)
8710 (while (not (looking-at org-table-dataline-regexp)) 8739 (while (not (looking-at org-table-dataline-regexp))
8711 (beginning-of-line 2)) 8740 (beginning-of-line 2))
8712 (prog1 (org-table-get-field c1) 8741 (prog1 (org-trim (org-table-get-field c1))
8713 (if highlight (org-table-highlight-rectangle (point) (point))))) 8742 (if highlight (org-table-highlight-rectangle (point) (point)))))
8714 ;; A range, return a vector 8743 ;; A range, return a vector
8715 ;; First sort the numbers to get a regular ractangle 8744 ;; First sort the numbers to get a regular ractangle
@@ -8729,7 +8758,8 @@ HIGHLIGHT means, just highlight the range."
8729 (org-table-highlight-rectangle 8758 (org-table-highlight-rectangle
8730 beg (progn (skip-chars-forward "^|\n") (point)))) 8759 beg (progn (skip-chars-forward "^|\n") (point))))
8731 ;; return string representation of calc vector 8760 ;; return string representation of calc vector
8732 (apply 'append (org-table-copy-region beg end)))))) 8761 (mapcar 'org-trim
8762 (apply 'append (org-table-copy-region beg end)))))))
8733 8763
8734(defun org-table-get-descriptor-line (desc &optional cline bline table) 8764(defun org-table-get-descriptor-line (desc &optional cline bline table)
8735 "Analyze descriptor DESC and retrieve the corresponding line number. 8765 "Analyze descriptor DESC and retrieve the corresponding line number.
@@ -9313,10 +9343,10 @@ With prefix ARG, apply the new formulas to the table."
9313 ((looking-at "[ \t]") 9343 ((looking-at "[ \t]")
9314 (goto-char pos) 9344 (goto-char pos)
9315 (call-interactively 'lisp-indent-line)) 9345 (call-interactively 'lisp-indent-line))
9316 ((looking-at "[$@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) 9346 ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
9317 ((not (fboundp 'pp-buffer)) 9347 ((not (fboundp 'pp-buffer))
9318 (error "Cannot pretty-print. Command `pp-buffer' is not available.")) 9348 (error "Cannot pretty-print. Command `pp-buffer' is not available."))
9319 ((looking-at "[$@0-9a-zA-Z]+ *= *'(") 9349 ((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
9320 (goto-char (- (match-end 0) 2)) 9350 (goto-char (- (match-end 0) 2))
9321 (setq beg (point)) 9351 (setq beg (point))
9322 (setq ind (make-string (current-column) ?\ )) 9352 (setq ind (make-string (current-column) ?\ ))
@@ -10800,9 +10830,10 @@ With three \\[universal-argument] prefixes, negate the meaning of
10800 (setq link (org-completing-read 10830 (setq link (org-completing-read
10801 "Link: " 10831 "Link: "
10802 (append 10832 (append
10803 (mapcar (lambda (x) (concat (car x) ":")) 10833 (mapcar (lambda (x) (list (concat (car x) ":")))
10804 (append org-link-abbrev-alist-local org-link-abbrev-alist)) 10834 (append org-link-abbrev-alist-local org-link-abbrev-alist))
10805 (mapcar (lambda (x) (concat x ":")) org-link-types)) 10835 (mapcar (lambda (x) (list (concat x ":")))
10836 org-link-types))
10806 nil nil nil 10837 nil nil nil
10807 'tmphist 10838 'tmphist
10808 (or (car (car org-stored-links))))) 10839 (or (car (car org-stored-links)))))
@@ -11015,12 +11046,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
11015 (switch-to-buffer-other-window 11046 (switch-to-buffer-other-window
11016 (org-get-buffer-for-internal-link (current-buffer))) 11047 (org-get-buffer-for-internal-link (current-buffer)))
11017 (org-mark-ring-push)) 11048 (org-mark-ring-push))
11018 (org-link-search 11049 (let ((cmd `(org-link-search
11019 path 11050 ,path
11020 (cond ((equal in-emacs '(4)) 'occur) 11051 ,(cond ((equal in-emacs '(4)) 'occur)
11021 ((equal in-emacs '(16)) 'org-occur) 11052 ((equal in-emacs '(16)) 'org-occur)
11022 (t nil)) 11053 (t nil))
11023 pos)) 11054 ,pos)))
11055 (condition-case nil (eval cmd)
11056 (error (progn (widen) (eval cmd))))))
11024 11057
11025 ((string= type "tree-match") 11058 ((string= type "tree-match")
11026 (org-occur (concat "\\[" (regexp-quote path) "\\]"))) 11059 (org-occur (concat "\\[" (regexp-quote path) "\\]")))
@@ -11170,7 +11203,7 @@ in all files. If AVOID-POS is given, ignore matches near that position."
11170 (let ((case-fold-search t) 11203 (let ((case-fold-search t)
11171 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) 11204 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
11172 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) 11205 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
11173 (append '((" ") ("\t") ("\n")) 11206 (append '(("") (" ") ("\t") ("\n"))
11174 org-emphasis-alist) 11207 org-emphasis-alist)
11175 "\\|") "\\)")) 11208 "\\|") "\\)"))
11176 (pos (point)) 11209 (pos (point))
@@ -11197,10 +11230,10 @@ in all files. If AVOID-POS is given, ignore matches near that position."
11197 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) 11230 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
11198 (t (org-do-occur (match-string 1 s))))) 11231 (t (org-do-occur (match-string 1 s)))))
11199 (t 11232 (t
11200 ;; A normal search string 11233 ;; A normal search strings
11201 (when (equal (string-to-char s) ?*) 11234 (when (equal (string-to-char s) ?*)
11202 ;; Anchor on headlines, post may include tags. 11235 ;; Anchor on headlines, post may include tags.
11203 (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" 11236 (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
11204 post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") 11237 post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$")
11205 s (substring s 1))) 11238 s (substring s 1)))
11206 (remove-text-properties 11239 (remove-text-properties
@@ -11707,6 +11740,7 @@ If the file does not exist, an error is thrown."
11707 ((or (stringp cmd) 11740 ((or (stringp cmd)
11708 (eq cmd 'emacs)) 11741 (eq cmd 'emacs))
11709 (funcall (cdr (assq 'file org-link-frame-setup)) file) 11742 (funcall (cdr (assq 'file org-link-frame-setup)) file)
11743 (widen)
11710 (if line (goto-line line) 11744 (if line (goto-line line)
11711 (if search (org-link-search search)))) 11745 (if search (org-link-search search))))
11712 ((consp cmd) 11746 ((consp cmd)
@@ -11793,7 +11827,8 @@ to be run from that hook to fucntion properly."
11793 (org-startup-folded nil) 11827 (org-startup-folded nil)
11794 org-time-was-given org-end-time-was-given x prompt char time) 11828 org-time-was-given org-end-time-was-given x prompt char time)
11795 (setq org-store-link-plist 11829 (setq org-store-link-plist
11796 (append (list :annotation v-a :initial v-i))) 11830 (append (list :annotation v-a :initial v-i)
11831 org-store-link-plist))
11797 (unless tpl (setq tpl "") (message "No template") (ding)) 11832 (unless tpl (setq tpl "") (message "No template") (ding))
11798 (erase-buffer) 11833 (erase-buffer)
11799 (insert (substitute-command-keys 11834 (insert (substitute-command-keys
@@ -11842,14 +11877,18 @@ to be run from that hook to fucntion properly."
11842 (let* ((org-last-tags-completion-table 11877 (let* ((org-last-tags-completion-table
11843 (org-global-tags-completion-table 11878 (org-global-tags-completion-table
11844 (if (equal char "G") (org-agenda-files) (and file (list file))))) 11879 (if (equal char "G") (org-agenda-files) (and file (list file)))))
11880 (org-add-colon-after-tag-completion t)
11845 (ins (completing-read 11881 (ins (completing-read
11846 (if prompt (concat prompt ": ") "Tags: ") 11882 (if prompt (concat prompt ": ") "Tags: ")
11847 'org-tags-completion-function nil nil nil 11883 'org-tags-completion-function nil nil nil
11848 'org-tags-history))) 11884 'org-tags-history)))
11849 (insert (concat ":" (mapconcat 'identity 11885 (setq ins (mapconcat 'identity
11850 (org-split-string ins (org-re "[^[:alnum:]]+")) 11886 (org-split-string ins (org-re "[^[:alnum:]]+"))
11851 ":") 11887 ":"))
11852 ":")))) 11888 (when (string-match "\\S-" ins)
11889 (or (equal (char-before) ?:) (insert ":"))
11890 (insert ins)
11891 (or (equal (char-after) ?:) (insert ":")))))
11853 (char 11892 (char
11854 (setq org-time-was-given (equal (upcase char) char)) 11893 (setq org-time-was-given (equal (upcase char) char))
11855 (setq time (org-read-date (equal (upcase char) "U") t nil 11894 (setq time (org-read-date (equal (upcase char) "U") t nil
@@ -11939,7 +11978,7 @@ See also the variable `org-reverse-note-order'."
11939 (let* ((lines (split-string txt "\n")) 11978 (let* ((lines (split-string txt "\n"))
11940 first) 11979 first)
11941 (setq first (car lines) lines (cdr lines)) 11980 (setq first (car lines) lines (cdr lines))
11942 (if (string-match "^\\*+" first) 11981 (if (string-match "^\\*+ " first)
11943 ;; Is already a headline 11982 ;; Is already a headline
11944 (setq indent nil) 11983 (setq indent nil)
11945 ;; We need to add a headline: Use time and first buffer line 11984 ;; We need to add a headline: Use time and first buffer line
@@ -11990,7 +12029,7 @@ See also the variable `org-reverse-note-order'."
11990 (save-restriction 12029 (save-restriction
11991 (widen) 12030 (widen)
11992 (goto-char (point-min)) 12031 (goto-char (point-min))
11993 (re-search-forward "^\\*" nil t) 12032 (re-search-forward "^\\*+ " nil t)
11994 (beginning-of-line 1) 12033 (beginning-of-line 1)
11995 (org-paste-subtree 1 txt))) 12034 (org-paste-subtree 1 txt)))
11996 ((and (org-on-heading-p t) (not current-prefix-arg)) 12035 ((and (org-on-heading-p t) (not current-prefix-arg))
@@ -12197,7 +12236,7 @@ At all other locations, this simply calls `ispell-complete-word'."
12197 (texp 12236 (texp
12198 (setq type :tex) 12237 (setq type :tex)
12199 org-html-entities) 12238 org-html-entities)
12200 ((string-match "\\`\\*+[ \t]*\\'" 12239 ((string-match "\\`\\*+[ \t]+\\'"
12201 (buffer-substring (point-at-bol) beg)) 12240 (buffer-substring (point-at-bol) beg))
12202 (setq type :todo) 12241 (setq type :todo)
12203 (mapcar 'list org-todo-keywords-1)) 12242 (mapcar 'list org-todo-keywords-1))
@@ -12258,12 +12297,12 @@ At all other locations, this simply calls `ispell-complete-word'."
12258 (save-excursion 12297 (save-excursion
12259 (org-back-to-heading) 12298 (org-back-to-heading)
12260 (if (looking-at (concat outline-regexp 12299 (if (looking-at (concat outline-regexp
12261 "\\( +\\<" org-comment-string "\\>\\)")) 12300 "\\( *\\<" org-comment-string "\\>\\)"))
12262 (replace-match "" t t nil 1) 12301 (replace-match "" t t nil 1)
12263 (if (looking-at outline-regexp) 12302 (if (looking-at outline-regexp)
12264 (progn 12303 (progn
12265 (goto-char (match-end 0)) 12304 (goto-char (match-end 0))
12266 (insert " " org-comment-string)))))) 12305 (insert org-comment-string " "))))))
12267 12306
12268(defvar org-last-todo-state-is-todo nil 12307(defvar org-last-todo-state-is-todo nil
12269 "This is non-nil when the last TODO state change led to a TODO state. 12308 "This is non-nil when the last TODO state change led to a TODO state.
@@ -12297,7 +12336,7 @@ For calling through lisp, arg is also interpreted in the following way:
12297 (interactive "P") 12336 (interactive "P")
12298 (save-excursion 12337 (save-excursion
12299 (org-back-to-heading) 12338 (org-back-to-heading)
12300 (if (looking-at outline-regexp) (goto-char (match-end 0))) 12339 (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
12301 (or (looking-at (concat " +" org-todo-regexp " *")) 12340 (or (looking-at (concat " +" org-todo-regexp " *"))
12302 (looking-at " *")) 12341 (looking-at " *"))
12303 (let* ((this (match-string 1)) 12342 (let* ((this (match-string 1))
@@ -12490,7 +12529,7 @@ of `org-todo-keywords-1'."
12490 org-todo-keywords-1))) 12529 org-todo-keywords-1)))
12491 (t (error "Invalid prefix argument: %s" arg))))) 12530 (t (error "Invalid prefix argument: %s" arg)))))
12492 (message "%d TODO entries found" 12531 (message "%d TODO entries found"
12493 (org-occur (concat "^" outline-regexp " +" kwd-re ))))) 12532 (org-occur (concat "^" outline-regexp " *" kwd-re )))))
12494 12533
12495(defun org-deadline () 12534(defun org-deadline ()
12496 "Insert the DEADLINE: string to make a deadline. 12535 "Insert the DEADLINE: string to make a deadline.
@@ -13064,6 +13103,29 @@ also TODO lines."
13064(defvar org-tags-overlay (org-make-overlay 1 1)) 13103(defvar org-tags-overlay (org-make-overlay 1 1))
13065(org-detach-overlay org-tags-overlay) 13104(org-detach-overlay org-tags-overlay)
13066 13105
13106(defun org-align-tags-here (to-col)
13107 ;; Assumes that this is a headline
13108 (let ((pos (point)) (col (current-column)) tags)
13109 (beginning-of-line 1)
13110 (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
13111 (< pos (match-beginning 2)))
13112 (progn
13113 (setq tags (match-string 2))
13114 (goto-char (match-beginning 1))
13115 (insert " ")
13116 (delete-region (point) (1+ (match-end 0)))
13117 (backward-char 1)
13118 (move-to-column
13119 (max (1+ (current-column))
13120 (1+ col)
13121 (if (> to-col 0)
13122 to-col
13123 (- (abs to-col) (length tags))))
13124 t)
13125 (insert tags)
13126 (move-to-column (min (current-column) col) t))
13127 (goto-char pos))))
13128
13067(defun org-set-tags (&optional arg just-align) 13129(defun org-set-tags (&optional arg just-align)
13068 "Set the tags for the current headline. 13130 "Set the tags for the current headline.
13069With prefix ARG, realign all tags in headings in the current buffer." 13131With prefix ARG, realign all tags in headings in the current buffer."
@@ -13102,30 +13164,31 @@ With prefix ARG, realign all tags in headings in the current buffer."
13102 (while (string-match "[-+&]+" tags) 13164 (while (string-match "[-+&]+" tags)
13103 ;; No boolean logic, just a list 13165 ;; No boolean logic, just a list
13104 (setq tags (replace-match ":" t t tags)))) 13166 (setq tags (replace-match ":" t t tags))))
13105 13167
13106 (if (string-match "\\`[\t ]*\\'" tags) 13168 (if (string-match "\\`[\t ]*\\'" tags)
13107 (setq tags "") 13169 (setq tags "")
13108 (unless (string-match ":$" tags) (setq tags (concat tags ":"))) 13170 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
13109 (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) 13171 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
13110 13172
13111 ;; Insert new tags at the correct column 13173 ;; Insert new tags at the correct column
13112 (beginning-of-line 1) 13174 (beginning-of-line 1)
13113 (if (re-search-forward 13175 (cond
13114 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") 13176 ((and (equal current "") (equal tags "")))
13115 (point-at-eol) t) 13177 ((re-search-forward
13116 (progn 13178 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
13117 (if (equal tags "") 13179 (point-at-eol) t)
13118 (setq rpl "") 13180 (if (equal tags "")
13119 (goto-char (match-beginning 0)) 13181 (setq rpl "")
13120 (setq c0 (current-column) p0 (point) 13182 (goto-char (match-beginning 0))
13121 c1 (max (1+ c0) (if (> org-tags-column 0) 13183 (setq c0 (current-column) p0 (point)
13122 org-tags-column 13184 c1 (max (1+ c0) (if (> org-tags-column 0)
13123 (- (- org-tags-column) (length tags)))) 13185 org-tags-column
13124 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) 13186 (- (- org-tags-column) (length tags))))
13125 (replace-match rpl t t) 13187 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
13126 (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) 13188 (replace-match rpl t t)
13127 tags) 13189 (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
13128 (error "Tags alignment failed"))))) 13190 tags)
13191 (t (error "Tags alignment failed"))))))
13129 13192
13130(defun org-tags-completion-function (string predicate &optional flag) 13193(defun org-tags-completion-function (string predicate &optional flag)
13131 (let (s1 s2 rtn (ctable org-last-tags-completion-table) 13194 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
@@ -13139,11 +13202,12 @@ With prefix ARG, realign all tags in headings in the current buffer."
13139 ;; try completion 13202 ;; try completion
13140 (setq rtn (try-completion s2 ctable confirm)) 13203 (setq rtn (try-completion s2 ctable confirm))
13141 (if (stringp rtn) 13204 (if (stringp rtn)
13142 (concat s1 s2 (substring rtn (length s2)) 13205 (setq rtn
13143 (if (and org-add-colon-after-tag-completion 13206 (concat s1 s2 (substring rtn (length s2))
13144 (assoc rtn ctable)) 13207 (if (and org-add-colon-after-tag-completion
13145 ":" ""))) 13208 (assoc rtn ctable))
13146 ) 13209 ":" ""))))
13210 rtn)
13147 ((eq flag t) 13211 ((eq flag t)
13148 ;; all-completions 13212 ;; all-completions
13149 (all-completions s2 ctable confirm) 13213 (all-completions s2 ctable confirm)
@@ -13202,7 +13266,7 @@ Returns the new tags string, or nil to not change the current settings."
13202 (save-excursion 13266 (save-excursion
13203 (beginning-of-line 1) 13267 (beginning-of-line 1)
13204 (if (looking-at 13268 (if (looking-at
13205 (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) 13269 (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
13206 (setq ov-start (match-beginning 1) 13270 (setq ov-start (match-beginning 1)
13207 ov-end (match-end 1) 13271 ov-end (match-end 1)
13208 ov-prefix "") 13272 ov-prefix "")
@@ -13358,7 +13422,7 @@ Returns the new tags string, or nil to not change the current settings."
13358 (error "Not on a heading")) 13422 (error "Not on a heading"))
13359 (save-excursion 13423 (save-excursion
13360 (beginning-of-line 1) 13424 (beginning-of-line 1)
13361 (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) 13425 (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
13362 (org-match-string-no-properties 1) 13426 (org-match-string-no-properties 1)
13363 ""))) 13427 "")))
13364 13428
@@ -13393,6 +13457,32 @@ but in some other way.")
13393(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" 13457(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
13394 "Regular expression matching the first line of a property drawer.") 13458 "Regular expression matching the first line of a property drawer.")
13395 13459
13460(defun org-property-action ()
13461 "Do an action on properties."
13462 (interactive)
13463 (let (c prop)
13464 (org-at-property-p)
13465 (setq prop (match-string 2))
13466 (message "Property Action: [s]et [d]elete [D]delete globally")
13467 (setq c (read-char-exclusive))
13468 (cond
13469 ((equal c ?s)
13470 (call-interactively 'org-set-property))
13471 ((equal c ?d)
13472 (call-interactively 'org-delete-property))
13473 ((equal c ?D)
13474 (call-interactively 'org-delete-property-globally))
13475 (t (error "No such property action %c" c)))))
13476
13477(defun org-at-property-p ()
13478 "Is the cursor in a property line?"
13479 ;; FIXME: Does not check if we are actually in the drawer.
13480 ;; FIXME: also returns true on any drawers.....
13481 ;; This is used by C-c C-c for property action.
13482 (save-excursion
13483 (beginning-of-line 1)
13484 (looking-at "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(.*\\)")))
13485
13396(defmacro org-with-point-at (pom &rest body) 13486(defmacro org-with-point-at (pom &rest body)
13397 "Move to buffer and point of point-or-marker POM for the duration of BODY." 13487 "Move to buffer and point of point-or-marker POM for the duration of BODY."
13398 (declare (indent 1) (debug t)) 13488 (declare (indent 1) (debug t))
@@ -13406,7 +13496,7 @@ but in some other way.")
13406 "Return the (beg . end) range of the body of the property drawer. 13496 "Return the (beg . end) range of the body of the property drawer.
13407BEG and END can be beginning and end of subtree, if not given 13497BEG and END can be beginning and end of subtree, if not given
13408they will be found. 13498they will be found.
13409If the drawer does not exist and FORCE is non-nil, greater the drawer." 13499If the drawer does not exist and FORCE is non-nil, create the drawer."
13410 (catch 'exit 13500 (catch 'exit
13411 (save-excursion 13501 (save-excursion
13412 (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) 13502 (let* ((beg (or beg (progn (org-back-to-heading t) (point))))
@@ -13414,18 +13504,14 @@ If the drawer does not exist and FORCE is non-nil, greater the drawer."
13414 (goto-char beg) 13504 (goto-char beg)
13415 (if (re-search-forward org-property-start-re end t) 13505 (if (re-search-forward org-property-start-re end t)
13416 (setq beg (1+ (match-end 0))) 13506 (setq beg (1+ (match-end 0)))
13417 (or force (throw 'exit nil)) 13507 (if force
13418 (beginning-of-line 2) 13508 (save-excursion
13419 (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) 13509 (org-insert-property-drawer)
13420 (not (equal (match-string 1) org-clock-string))) 13510 (setq end (progn (outline-next-heading) (point))))
13421 (beginning-of-line 2)) 13511 (throw 'exit nil))
13422 (insert ":PROPERTIES:\n:END:\n") 13512 (goto-char beg)
13423 (beginning-of-line -1) 13513 (if (re-search-forward org-property-start-re end t)
13424 (org-indent-line-function) 13514 (setq beg (1+ (match-end 0)))))
13425 (setq beg (1+ (point-at-eol)) end beg)
13426 (beginning-of-line 2)
13427 (org-indent-line-function)
13428 (throw 'exit (cons beg end)))
13429 (if (re-search-forward org-property-end-re end t) 13515 (if (re-search-forward org-property-end-re end t)
13430 (setq end (match-beginning 0)) 13516 (setq end (match-beginning 0))
13431 (or force (throw 'exit nil)) 13517 (or force (throw 'exit nil))
@@ -13448,10 +13534,11 @@ If WHICH is nil or `all', get all properties. If WHICH is
13448 (org-with-point-at pom 13534 (org-with-point-at pom
13449 (let ((clockstr (substring org-clock-string 0 -1)) 13535 (let ((clockstr (substring org-clock-string 0 -1))
13450 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) 13536 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY"))
13451 beg end range props key value) 13537 beg end range props sum-props key value)
13452 (save-excursion 13538 (save-excursion
13453 (when (condition-case nil (org-back-to-heading t) (error nil)) 13539 (when (condition-case nil (org-back-to-heading t) (error nil))
13454 (setq beg (point)) 13540 (setq beg (point))
13541 (setq sum-props (get-text-property (point) 'org-summaries))
13455 (outline-next-heading) 13542 (outline-next-heading)
13456 (setq end (point)) 13543 (setq end (point))
13457 (when (memq which '(all special)) 13544 (when (memq which '(all special))
@@ -13483,18 +13570,20 @@ If WHICH is nil or `all', get all properties. If WHICH is
13483 (when range 13570 (when range
13484 (goto-char (car range)) 13571 (goto-char (car range))
13485 (while (re-search-forward 13572 (while (re-search-forward
13486 "^[ \t]*:\\([a-zA-Z][a-zA-Z0-9]*\\):[ \t]*\\(\\S-.*\\S-\\)" 13573 "^[ \t]*:\\([a-zA-Z][a-zA-Z_0-9]*\\):[ \t]*\\(\\S-.*\\)?"
13487 (cdr range) t) 13574 (cdr range) t)
13488 (setq key (org-match-string-no-properties 1) 13575 (setq key (org-match-string-no-properties 1)
13489 value (org-match-string-no-properties 2)) 13576 value (org-trim (or (org-match-string-no-properties 2) "")))
13490 (unless (member key excluded) 13577 (unless (member key excluded)
13491 (push (cons key value) props))))) 13578 (push (cons key (or value "")) props)))))
13492 (nreverse props)))))) 13579 (append sum-props (nreverse props)))))))
13493 13580
13494(defun org-entry-get (pom property &optional inherit) 13581(defun org-entry-get (pom property &optional inherit)
13495 "Get value of PROPERTY for entry at point-or-marker POM. 13582 "Get value of PROPERTY for entry at point-or-marker POM.
13496If INHERIT is non-nil and the entry does not have the property, 13583If INHERIT is non-nil and the entry does not have the property,
13497then also check higher levels of the hierarchy." 13584then also check higher levels of the hierarchy.
13585If the property is present but empty, the return value is the empty string.
13586If the property is not present at all, nil is returned."
13498 (org-with-point-at pom 13587 (org-with-point-at pom
13499 (if inherit 13588 (if inherit
13500 (org-entry-get-with-inheritance property) 13589 (org-entry-get-with-inheritance property)
@@ -13505,10 +13594,12 @@ then also check higher levels of the hierarchy."
13505 (if (and range 13594 (if (and range
13506 (goto-char (car range)) 13595 (goto-char (car range))
13507 (re-search-forward 13596 (re-search-forward
13508 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") 13597 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)?")
13509 (cdr range) t)) 13598 (cdr range) t))
13510 ;; Found the property, return it. 13599 ;; Found the property, return it.
13511 (org-match-string-no-properties 1))))))) 13600 (if (match-end 1)
13601 (org-match-string-no-properties 1)
13602 "")))))))
13512 13603
13513(defun org-entry-delete (pom property) 13604(defun org-entry-delete (pom property)
13514 "Delete the property PROPERTY from entry at point-or-marker POM." 13605 "Delete the property PROPERTY from entry at point-or-marker POM."
@@ -13521,7 +13612,10 @@ then also check higher levels of the hierarchy."
13521 (re-search-forward 13612 (re-search-forward
13522 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") 13613 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)")
13523 (cdr range) t)) 13614 (cdr range) t))
13524 (delete-region (match-beginning 0) (1+ (point-at-eol)))))))) 13615 (progn
13616 (delete-region (match-beginning 0) (1+ (point-at-eol)))
13617 t)
13618 nil)))))
13525 13619
13526(defvar org-entry-property-inherited-from (make-marker)) 13620(defvar org-entry-property-inherited-from (make-marker))
13527 13621
@@ -13575,7 +13669,8 @@ then also check higher levels of the hierarchy."
13575 (backward-char 1) 13669 (backward-char 1)
13576 (org-indent-line-function) 13670 (org-indent-line-function)
13577 (insert ":" property ":")) 13671 (insert ":" property ":"))
13578 (and value (insert " " value))))))) 13672 (and value (insert " " value))
13673 (org-indent-line-function))))))
13579 13674
13580(defun org-buffer-property-keys (&optional include-specials) 13675(defun org-buffer-property-keys (&optional include-specials)
13581 "Get all property keys in the current buffer." 13676 "Get all property keys in the current buffer."
@@ -13594,56 +13689,197 @@ then also check higher levels of the hierarchy."
13594 (setq rtn (append org-special-properties rtn))) 13689 (setq rtn (append org-special-properties rtn)))
13595 (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) 13690 (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
13596 13691
13597;; FIXME: This should automatically find the right place int he entry.
13598;; And then org-entry-put should use it.
13599(defun org-insert-property-drawer () 13692(defun org-insert-property-drawer ()
13600 "Insert a property drawer at point." 13693 "Insert a property drawer into the current entry."
13601 (interactive) 13694 (interactive)
13602 (beginning-of-line 1) 13695 (org-back-to-heading t)
13603 (insert ":PROPERTIES:\n:END:\n") 13696 (let ((beg (point))
13604 (beginning-of-line -1) 13697 (re (concat "^[ \t]*" org-keyword-time-regexp))
13605 (org-indent-line-function) 13698 end hiddenp)
13606 (beginning-of-line 2) 13699 (outline-next-heading)
13607 (org-indent-line-function) 13700 (setq end (point))
13608 (end-of-line 0)) 13701 (goto-char beg)
13609 13702 (while (re-search-forward re end t))
13610(defvar org-column-overlays nil 13703 (setq hiddenp (org-invisible-p))
13704 (end-of-line 1)
13705 (insert "\n:PROPERTIES:\n:END:")
13706 (beginning-of-line 0)
13707 (org-indent-line-function)
13708 (beginning-of-line 2)
13709 (org-indent-line-function)
13710 (beginning-of-line 0)
13711 (if hiddenp
13712 (save-excursion
13713 (org-back-to-heading t)
13714 (hide-entry))
13715 (org-flag-drawer t))))
13716
13717(defun org-set-property (property value)
13718 "In the current entry, set PROPERTY to VALUE."
13719 (interactive
13720 (let* ((prop (completing-read "Property: "
13721 (mapcar 'list (org-buffer-property-keys))))
13722 (cur (org-entry-get nil prop))
13723 (allowed (org-property-get-allowed-values nil prop 'table))
13724 (val (if allowed
13725 (completing-read "Value: " allowed nil 'req-match)
13726 (read-string
13727 (concat "Value" (if (and cur (string-match "\\S-" cur))
13728 (concat "[" cur "]") "")
13729 ": ")
13730 "" cur))))
13731 (list prop (if (equal val "") cur val))))
13732 (unless (equal (org-entry-get nil property) value)
13733 (org-entry-put nil property value)))
13734
13735(defun org-delete-property (property)
13736 "In the current entry, delete PROPERTY."
13737 (interactive
13738 (let* ((prop (completing-read
13739 "Property: " (org-entry-properties nil 'standard))))
13740 (list prop)))
13741 (message (concat "Property " property
13742 (if (org-entry-delete nil property)
13743 " deleted"
13744 " was not present in the entry"))))
13745
13746(defun org-delete-property-globally (property)
13747 "Remove PROPERTY globally, from all entries."
13748 (interactive
13749 (let* ((prop (completing-read
13750 "Globally remove property: "
13751 (mapcar 'list (org-buffer-property-keys)))))
13752 (list prop)))
13753 (save-excursion
13754 (save-restriction
13755 (widen)
13756 (goto-char (point-min))
13757 (let ((cnt 0))
13758 (while (re-search-forward
13759 (concat "^[ \t]*:" (regexp-quote property) ":.*\n?")
13760 nil t)
13761 (setq cnt (1+ cnt))
13762 (replace-match ""))
13763 (message "Property \"%s\" removed from %d entries" property cnt)))))
13764
13765(defun org-property-get-allowed-values (pom property &optional table)
13766 "Get allowed values for the property PROPERTY.
13767When TABLE is non-nil, return an alist that can directly be used for
13768completion."
13769 (let (vals)
13770 (cond
13771 ((equal property "TODO")
13772 (setq vals (org-with-point-at pom
13773 (append org-todo-keywords-1 '("")))))
13774 ((equal property "PRIORITY")
13775 (let ((n org-lowest-priority))
13776 (while (>= n org-highest-priority)
13777 (push (char-to-string n) vals)
13778 (setq n (1- n)))))
13779 ((member property org-special-properties))
13780 (t
13781 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
13782 (when (and vals (string-match "\\S-" vals))
13783 (setq vals (car (read-from-string (concat "(" vals ")"))))
13784 (setq vals (mapcar (lambda (x)
13785 (cond ((stringp x) x)
13786 ((numberp x) (number-to-string x))
13787 ((symbolp x) (symbol-name x))
13788 (t "???")))
13789 vals)))))
13790 (if table (mapcar 'list vals) vals)))
13791
13792;;; Column View
13793
13794(defvar org-columns-overlays nil
13611 "Holds the list of current column overlays.") 13795 "Holds the list of current column overlays.")
13612 13796
13613(defvar org-current-columns-fmt nil 13797(defvar org-columns-current-fmt nil
13614 "Loval variable, holds the currently active column format.") 13798 "Local variable, holds the currently active column format.")
13615(defvar org-current-columns-maxwidths nil 13799(defvar org-columns-current-fmt-compiled nil
13800 "Local variable, holds the currently active column format.
13801This is the compiled version of the format.")
13802(defvar org-columns-current-maxwidths nil
13616 "Loval variable, holds the currently active maximum column widths.") 13803 "Loval variable, holds the currently active maximum column widths.")
13804(defvar org-columns-begin-marker (make-marker)
13805 "Points to the position where last a column creation command was called.")
13806(defvar org-columns-top-level-marker (make-marker)
13807 "Points to the position where current columns region starts.")
13617 13808
13618(defvar org-column-map (make-sparse-keymap) 13809(defvar org-columns-map (make-sparse-keymap)
13619 "The keymap valid in column display.") 13810 "The keymap valid in column display.")
13620 13811
13621(define-key org-column-map "e" 'org-column-edit) 13812(defun org-columns-content ()
13622(define-key org-column-map "v" 'org-column-show-value) 13813 "Switch to contents view while in columns view."
13623(define-key org-column-map "q" 'org-column-quit) 13814 (interactive)
13624(define-key org-column-map [left] 'backward-char) 13815 (org-overview)
13625(define-key org-column-map [right] 'forward-char) 13816 (org-content))
13626 13817
13627(easy-menu-define org-column-menu org-column-map "Org Column Menu" 13818(org-defkey org-columns-map "c" 'org-columns-content)
13819(org-defkey org-columns-map "o" 'org-overview)
13820(org-defkey org-columns-map "e" 'org-columns-edit-value)
13821(org-defkey org-columns-map "v" 'org-columns-show-value)
13822(org-defkey org-columns-map "q" 'org-columns-quit)
13823(org-defkey org-columns-map "r" 'org-columns-redo)
13824(org-defkey org-columns-map [left] 'backward-char)
13825(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
13826(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
13827(org-defkey org-columns-map [right] 'forward-char)
13828(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
13829(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value)
13830(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
13831(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
13832(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
13833(org-defkey org-columns-map "<" 'org-columns-narrow)
13834(org-defkey org-columns-map ">" 'org-columns-widen)
13835(org-defkey org-columns-map [(meta right)] 'org-columns-move-right)
13836(org-defkey org-columns-map [(meta left)] 'org-columns-move-left)
13837(org-defkey org-columns-map [(shift meta right)] 'org-columns-new)
13838(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
13839
13840(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
13628 '("Column" 13841 '("Column"
13629 ["Edit property" org-column-edit t] 13842 ["Edit property" org-columns-edit-value t]
13630 ["Show full value" org-column-show-value t] 13843 ["Next allowed value" org-columns-next-allowed-value t]
13631 ["Quit" org-column-quit t])) 13844 ["Previous allowed value" org-columns-previous-allowed-value t]
13845 ["Show full value" org-columns-show-value t]
13846 ["Edit allowed" org-columns-edit-allowed t]
13847 "--"
13848 ["Edit column attributes" org-columns-edit-attributes t]
13849 ["Increase column width" org-columns-widen t]
13850 ["Decrease column width" org-columns-narrow t]
13851 "--"
13852 ["Move column right" org-columns-move-right t]
13853 ["Move column left" org-columns-move-left t]
13854 ["Add column" org-columns-new t]
13855 ["Delete column" org-columns-delete t]
13856 "--"
13857 ["CONTENTS" org-columns-content t]
13858 ["OVERVIEW" org-overview t]
13859 ["Refresh columns display" org-columns-redo t]
13860 "--"
13861 ["Quit" org-columns-quit t]))
13632 13862
13633(defun org-new-column-overlay (beg end &optional string face) 13863(defun org-columns-new-overlay (beg end &optional string face)
13634 "Create a new column overlay an add it to the list." 13864 "Create a new column overlay and add it to the list."
13635 (let ((ov (org-make-overlay beg end))) 13865 (let ((ov (org-make-overlay beg end)))
13636 (org-overlay-put ov 'face (or face 'secondary-selection)) 13866 (org-overlay-put ov 'face (or face 'secondary-selection))
13637 (org-overlay-display ov string face) 13867 (org-overlay-display ov string face)
13638 (push ov org-column-overlays) 13868 (push ov org-columns-overlays)
13639 ov)) 13869 ov))
13640 13870
13641(defun org-overlay-columns (&optional props) 13871(defun org-columns-display-here (&optional props)
13642 "Overlay the current line with column display." 13872 "Overlay the current line with column display."
13643 (interactive) 13873 (interactive)
13644 (let ((fmt (copy-sequence org-current-columns-fmt)) 13874 (let* ((fmt org-columns-current-fmt-compiled)
13645 (beg (point-at-bol)) 13875 (beg (point-at-bol))
13646 (start 0) props pom property ass width f string ov) 13876 (level-face (save-excursion
13877 (beginning-of-line 1)
13878 (looking-at "\\(\\**\\)\\(\\* \\)")
13879 (org-get-level-face 2)))
13880 (color (list :foreground
13881 (face-attribute (or level-face 'default) :foreground)))
13882 props pom property ass width f string ov column)
13647 ;; Check if the entry is in another buffer. 13883 ;; Check if the entry is in another buffer.
13648 (unless props 13884 (unless props
13649 (if (eq major-mode 'org-agenda-mode) 13885 (if (eq major-mode 'org-agenda-mode)
@@ -13651,11 +13887,9 @@ then also check higher levels of the hierarchy."
13651 (get-text-property (point) 'org-marker)) 13887 (get-text-property (point) 'org-marker))
13652 props (if pom (org-entry-properties pom) nil)) 13888 props (if pom (org-entry-properties pom) nil))
13653 (setq props (org-entry-properties nil)))) 13889 (setq props (org-entry-properties nil))))
13654 ;; Parse the format 13890 ;; Walk the format
13655 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" 13891 (while (setq column (pop fmt))
13656 fmt start) 13892 (setq property (car column)
13657 (setq start (match-end 0)
13658 property (match-string 2 fmt)
13659 ass (if (equal property "ITEM") 13893 ass (if (equal property "ITEM")
13660 (cons "ITEM" 13894 (cons "ITEM"
13661 (save-match-data 13895 (save-match-data
@@ -13664,17 +13898,21 @@ then also check higher levels of the hierarchy."
13664 (buffer-substring-no-properties 13898 (buffer-substring-no-properties
13665 (point-at-bol) (point-at-eol)))))) 13899 (point-at-bol) (point-at-eol))))))
13666 (assoc property props)) 13900 (assoc property props))
13667 width (or (cdr (assoc property org-current-columns-maxwidths)) 13901 width (or (cdr (assoc property org-columns-current-maxwidths))
13668 (string-to-number (or (match-string 1 fmt) "10"))) 13902 (nth 2 column))
13669 f (format "%%-%d.%ds | " width width) 13903 f (format "%%-%d.%ds | " width width)
13670 string (format f (or (cdr ass) ""))) 13904 string (format f (or (cdr ass) "")))
13671 ;; Create the overlay 13905 ;; Create the overlay
13672 (org-unmodified 13906 (org-unmodified
13673 (setq ov (org-new-column-overlay 13907 (setq ov (org-columns-new-overlay
13674 beg (setq beg (1+ beg)) string 'org-column)) 13908 beg (setq beg (1+ beg)) string
13675 (org-overlay-put ov 'keymap org-column-map) 13909 (list color 'org-column)))
13676 (org-overlay-put ov 'org-column-key property) 13910;;; (list (get-text-property (point-at-bol) 'face) 'org-column)))
13677 (org-overlay-put ov 'org-column-value (cdr ass))) 13911 (org-overlay-put ov 'keymap org-columns-map)
13912 (org-overlay-put ov 'org-columns-key property)
13913 (org-overlay-put ov 'org-columns-value (cdr ass))
13914 (org-overlay-put ov 'org-columns-pom pom)
13915 (org-overlay-put ov 'org-columns-format f))
13678 (if (or (not (char-after beg)) 13916 (if (or (not (char-after beg))
13679 (equal (char-after beg) ?\n)) 13917 (equal (char-after beg) ?\n))
13680 (let ((inhibit-read-only t)) 13918 (let ((inhibit-read-only t))
@@ -13682,64 +13920,72 @@ then also check higher levels of the hierarchy."
13682 (goto-char beg) 13920 (goto-char beg)
13683 (insert " "))))) 13921 (insert " ")))))
13684 ;; Make the rest of the line disappear. 13922 ;; Make the rest of the line disappear.
13685 ;; FIXME: put the keymap also at the end of the line!
13686 (org-unmodified 13923 (org-unmodified
13687 (setq ov (org-new-column-overlay beg (point-at-eol))) 13924 (setq ov (org-columns-new-overlay beg (point-at-eol)))
13688 (org-overlay-put ov 'invisible t) 13925 (org-overlay-put ov 'invisible t)
13689 (org-overlay-put ov 'keymap 'org-column-map) 13926 (org-overlay-put ov 'keymap org-columns-map)
13690 (push ov org-column-overlays) 13927 (push ov org-columns-overlays)
13691 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) 13928 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
13692 (org-overlay-put ov 'keymap 'org-column-map) 13929 (org-overlay-put ov 'keymap org-columns-map)
13693 (push ov org-column-overlays) 13930 (push ov org-columns-overlays)
13694 (let ((inhibit-read-only t)) 13931 (let ((inhibit-read-only t))
13695 (put-text-property (1- (point-at-bol)) 13932 (put-text-property (1- (point-at-bol))
13696 (min (point-max) (1+ (point-at-eol))) 13933 (min (point-max) (1+ (point-at-eol)))
13697 'read-only "Type `e' to edit property"))))) 13934 'read-only "Type `e' to edit property")))))
13698 13935
13699(defun org-overlay-columns-title () 13936(defvar org-previous-header-line-format nil
13937 "The header line format before column view was turned on.")
13938(defvar org-columns-inhibit-recalculation nil
13939 "Inhibit recomputing of columns on column view startup.")
13940
13941(defvar header-line-format)
13942(defun org-columns-display-here-title ()
13700 "Overlay the newline before the current line with the table title." 13943 "Overlay the newline before the current line with the table title."
13701 (interactive) 13944 (interactive)
13702 (let ((fmt (copy-sequence org-current-columns-fmt)) 13945 (let ((fmt org-columns-current-fmt-compiled)
13703 (start 0)
13704 string (title "") 13946 string (title "")
13705 property width f ov) 13947 property width f column str)
13706 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" 13948 (while (setq column (pop fmt))
13707 fmt start) 13949 (setq property (car column)
13708 (setq start (match-end 0) 13950 str (or (nth 1 column) property)
13709 property (match-string 2 fmt) 13951 width (or (cdr (assoc property org-columns-current-maxwidths))
13710 width (or (cdr (assoc property org-current-columns-maxwidths)) 13952 (nth 2 column))
13711 (string-to-number (or (match-string 1 fmt) "10")))
13712 f (format "%%-%d.%ds | " width width) 13953 f (format "%%-%d.%ds | " width width)
13713 string (format f property) 13954 string (format f str)
13714 title (concat title string))) 13955 title (concat title string)))
13715 (org-unmodified 13956 (setq title (concat
13716 (setq ov (org-new-column-overlay 13957 (org-add-props " " nil 'display '(space :align-to 0))
13717 (1- (point-at-bol)) (point-at-bol) 13958 (org-add-props title nil 'face '(:weight bold :underline t))))
13718 (concat "\n" (make-string (length title) ?-) "\n" 13959 (org-set-local 'org-previous-header-line-format header-line-format)
13719 title "\n" (make-string (length title) ?-) "\n") 13960 (setq header-line-format title)))
13720 'bold)) 13961
13721 (org-overlay-put ov 'keymap org-column-map)))) 13962(defun org-columns-remove-overlays ()
13722
13723(defun org-remove-column-overlays ()
13724 "Remove all currently active column overlays." 13963 "Remove all currently active column overlays."
13725 (interactive) 13964 (interactive)
13726 (org-unmodified 13965 (when (marker-buffer org-columns-begin-marker)
13727 (mapc 'org-delete-overlay org-column-overlays) 13966 (with-current-buffer (marker-buffer org-columns-begin-marker)
13728 (setq org-column-overlays nil) 13967 (when (local-variable-p 'org-previous-header-line-format)
13729 (let ((inhibit-read-only t)) 13968 (setq header-line-format org-previous-header-line-format)
13730 (remove-text-properties (point-min) (point-max) '(read-only t))))) 13969 (kill-local-variable 'org-previous-header-line-format))
13970 (move-marker org-columns-begin-marker nil)
13971 (move-marker org-columns-top-level-marker nil)
13972 (org-unmodified
13973 (mapc 'org-delete-overlay org-columns-overlays)
13974 (setq org-columns-overlays nil)
13975 (let ((inhibit-read-only t))
13976 (remove-text-properties (point-min) (point-max) '(read-only t)))))))
13731 13977
13732(defun org-column-show-value () 13978(defun org-columns-show-value ()
13733 "Show the full value of the property." 13979 "Show the full value of the property."
13734 (interactive) 13980 (interactive)
13735 (let ((value (get-char-property (point) 'org-column-value))) 13981 (let ((value (get-char-property (point) 'org-columns-value)))
13736 (message "Value is: %s" (or value "")))) 13982 (message "Value is: %s" (or value ""))))
13737 13983
13738(defun org-column-quit () 13984(defun org-columns-quit ()
13739 "Remove the column overlays and in this way exit column editing." 13985 "Remove the column overlays and in this way exit column editing."
13740 (interactive) 13986 (interactive)
13741 (org-unmodified 13987 (org-unmodified
13742 (org-remove-column-overlays) 13988 (org-columns-remove-overlays)
13743 (let ((inhibit-read-only t)) 13989 (let ((inhibit-read-only t))
13744 ;; FIXME: is this safe??? 13990 ;; FIXME: is this safe???
13745 ;; or are there other reasons why there may be a read-only property???? 13991 ;; or are there other reasons why there may be a read-only property????
@@ -13747,13 +13993,13 @@ then also check higher levels of the hierarchy."
13747 (when (eq major-mode 'org-agenda-mode) 13993 (when (eq major-mode 'org-agenda-mode)
13748 (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) 13994 (message "Modification not yet reflected in Agenda buffer, use `r' to refresh")))
13749 13995
13750(defun org-column-edit () 13996(defun org-columns-edit-value ()
13751 "Edit the value of the property at point in column view. 13997 "Edit the value of the property at point in column view.
13752Where possible, use the standard interface for changing this line." 13998Where possible, use the standard interface for changing this line."
13753 (interactive) 13999 (interactive)
13754 (let* ((col (current-column)) 14000 (let* ((col (current-column))
13755 (key (get-char-property (point) 'org-column-key)) 14001 (key (get-char-property (point) 'org-columns-key))
13756 (value (get-char-property (point) 'org-column-value)) 14002 (value (get-char-property (point) 'org-columns-value))
13757 (bol (point-at-bol)) (eol (point-at-eol)) 14003 (bol (point-at-bol)) (eol (point-at-eol))
13758 (pom (or (get-text-property bol 'org-hd-marker) 14004 (pom (or (get-text-property bol 'org-hd-marker)
13759 (point))) ; keep despite of compiler waring 14005 (point))) ; keep despite of compiler waring
@@ -13763,8 +14009,8 @@ Where possible, use the standard interface for changing this line."
13763 (>= (overlay-start x) bol) 14009 (>= (overlay-start x) bol)
13764 (<= (overlay-start x) eol) 14010 (<= (overlay-start x) eol)
13765 x)) 14011 x))
13766 org-column-overlays))) 14012 org-columns-overlays)))
13767 nval eval) 14013 nval eval allowed)
13768 (when (equal key "ITEM") 14014 (when (equal key "ITEM")
13769 (error "Cannot edit item headline from here")) 14015 (error "Cannot edit item headline from here"))
13770 14016
@@ -13788,7 +14034,10 @@ Where possible, use the standard interface for changing this line."
13788 (setq eval '(org-with-point-at pom 14034 (setq eval '(org-with-point-at pom
13789 (call-interactively 'org-deadline)))) 14035 (call-interactively 'org-deadline))))
13790 (t 14036 (t
13791 (setq nval (read-string "Edit: " value)) 14037 (setq allowed (org-property-get-allowed-values pom key 'table))
14038 (if allowed
14039 (setq nval (completing-read "Value: " allowed nil t))
14040 (setq nval (read-string "Edit: " value)))
13792 (setq nval (org-trim nval)) 14041 (setq nval (org-trim nval))
13793 (when (not (equal nval value)) 14042 (when (not (equal nval value))
13794 (setq eval '(org-entry-put pom key nval))))) 14043 (setq eval '(org-entry-put pom key nval)))))
@@ -13797,67 +14046,272 @@ Where possible, use the standard interface for changing this line."
13797 (remove-text-properties (1- bol) eol '(read-only t)) 14046 (remove-text-properties (1- bol) eol '(read-only t))
13798 (unwind-protect 14047 (unwind-protect
13799 (progn 14048 (progn
13800 (setq org-column-overlays 14049 (setq org-columns-overlays
13801 (org-delete-all line-overlays org-column-overlays)) 14050 (org-delete-all line-overlays org-columns-overlays))
13802 (mapc 'org-delete-overlay line-overlays) 14051 (mapc 'org-delete-overlay line-overlays)
13803 (eval eval)) 14052 (org-columns-eval eval))
13804 (org-overlay-columns)))) 14053 (org-columns-display-here))))
13805 (move-to-column col))) 14054 (move-to-column col)
14055 (if (nth 3 (assoc key org-columns-current-fmt-compiled))
14056 (org-columns-update key))))
14057
14058(defun org-columns-edit-allowed ()
14059 "Edit the list of allowed values for the current property."
14060 (interactive)
14061 (let* ((col (current-column))
14062 (key (get-char-property (point) 'org-columns-key))
14063 (key1 (concat key "_ALL"))
14064 (value (get-char-property (point) 'org-columns-value))
14065 (allowed (org-entry-get (point) key1 t))
14066 nval)
14067 (setq nval (read-string "Allowed: " allowed))
14068 (org-entry-put
14069 (cond ((marker-position org-entry-property-inherited-from)
14070 org-entry-property-inherited-from)
14071 ((marker-position org-columns-top-level-marker)
14072 org-columns-top-level-marker))
14073 key1 nval)))
14074
14075(defun org-columns-eval (form)
14076 (let (hidep)
14077 (save-excursion
14078 (beginning-of-line 1)
14079 (next-line 1)
14080 (setq hidep (org-on-heading-p 1)))
14081 (eval form)
14082 (and hidep (hide-entry))))
14083
14084(defun org-columns-previous-allowed-value ()
14085 "Switch to the previous allowed value for this column."
14086 (interactive)
14087 (org-columns-next-allowed-value t))
14088
14089(defun org-columns-next-allowed-value (&optional previous)
14090 "Switch to the next allowed value for this column."
14091 (interactive)
14092 (let* ((col (current-column))
14093 (key (get-char-property (point) 'org-columns-key))
14094 (value (get-char-property (point) 'org-columns-value))
14095 (bol (point-at-bol)) (eol (point-at-eol))
14096 (pom (or (get-text-property bol 'org-hd-marker)
14097 (point))) ; keep despite of compiler waring
14098 (line-overlays
14099 (delq nil (mapcar (lambda (x)
14100 (and (eq (overlay-buffer x) (current-buffer))
14101 (>= (overlay-start x) bol)
14102 (<= (overlay-start x) eol)
14103 x))
14104 org-columns-overlays)))
14105 (allowed (or (org-property-get-allowed-values pom key)
14106 (and (equal
14107 (nth 4 (assoc key org-columns-current-fmt-compiled))
14108 'checkbox) '("[ ]" "[X]"))))
14109 nval)
14110 (when (equal key "ITEM")
14111 (error "Cannot edit item headline from here"))
14112 (unless allowed
14113 (error "Allowed values for this property have not been defined"))
14114 (if previous (setq allowed (reverse allowed)))
14115 (if (member value allowed)
14116 (setq nval (car (cdr (member value allowed)))))
14117 (setq nval (or nval (car allowed)))
14118 (if (equal nval value)
14119 (error "Only one allowed value for this property"))
14120 (let ((inhibit-read-only t))
14121 (remove-text-properties (1- bol) eol '(read-only t))
14122 (unwind-protect
14123 (progn
14124 (setq org-columns-overlays
14125 (org-delete-all line-overlays org-columns-overlays))
14126 (mapc 'org-delete-overlay line-overlays)
14127 (org-columns-eval '(org-entry-put pom key nval)))
14128 (org-columns-display-here)))
14129 (move-to-column col)
14130 (if (nth 3 (assoc key org-columns-current-fmt-compiled))
14131 (org-columns-update key))))
14132
14133(defun org-verify-version (task)
14134 (cond
14135 ((eq task 'columns)
14136 (if (or (featurep 'xemacs)
14137 (< emacs-major-version 22))
14138 (error "Emacs 22 is required for the columns feature")))))
13806 14139
13807(defun org-columns () 14140(defun org-columns ()
13808 "Turn on column view on an org-mode file." 14141 "Turn on column view on an org-mode file."
13809 (interactive) 14142 (interactive)
13810 (org-remove-column-overlays) 14143 (org-verify-version 'columns)
14144 (org-columns-remove-overlays)
14145 (move-marker org-columns-begin-marker (point))
13811 (let (beg end fmt cache maxwidths) 14146 (let (beg end fmt cache maxwidths)
13812 (move-marker org-entry-property-inherited-from nil) 14147 (when (condition-case nil (org-back-to-heading) (error nil))
13813 (setq fmt (org-entry-get nil "COLUMNS" t)) 14148 (move-marker org-entry-property-inherited-from nil)
13814 (unless fmt 14149 (setq fmt (org-entry-get nil "COLUMNS" t)))
13815 (message "No local columns format defined, using default")) 14150 (setq fmt (or fmt org-columns-default-format))
13816 (org-set-local 'org-current-columns-fmt (or fmt org-default-columns-format)) 14151 (org-set-local 'org-columns-current-fmt fmt)
13817 (org-back-to-heading) 14152 (org-columns-compile-format fmt)
13818 (save-excursion 14153 (save-excursion
13819 (if (marker-position org-entry-property-inherited-from) 14154 (if (marker-position org-entry-property-inherited-from)
13820 (goto-char org-entry-property-inherited-from)) 14155 (goto-char org-entry-property-inherited-from))
13821 (setq beg (point) 14156 (setq beg (point))
13822 end (org-end-of-subtree t t)) 14157 (move-marker org-columns-top-level-marker (point))
14158 (unless org-columns-inhibit-recalculation
14159 (org-columns-compute-all))
14160 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
14161 (point-max)))
13823 (goto-char beg) 14162 (goto-char beg)
13824 ;; Get and cache the properties 14163 ;; Get and cache the properties
13825 (while (re-search-forward (concat "^" outline-regexp) end t) 14164 (while (re-search-forward (concat "^" outline-regexp) end t)
13826 (push (cons (org-current-line) (org-entry-properties)) cache)) 14165 (push (cons (org-current-line) (org-entry-properties)) cache))
13827 (when cache 14166 (when cache
13828 (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) 14167 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
13829 (org-set-local 'org-current-columns-maxwidths maxwidths) 14168 (org-set-local 'org-columns-current-maxwidths maxwidths)
13830 (goto-line (car (org-last cache))) 14169 (goto-line (car (org-last cache)))
13831 (org-overlay-columns-title) 14170 (org-columns-display-here-title)
13832 (mapc (lambda (x) 14171 (mapc (lambda (x)
13833 (goto-line (car x)) 14172 (goto-line (car x))
13834 (org-overlay-columns (cdr x))) 14173 (org-columns-display-here (cdr x)))
13835 cache))))) 14174 cache)))))
13836 14175
14176(defun org-columns-new (&optional prop title width op fmt)
14177 "Insert a new column, to the leeft o the current column."
14178 (interactive)
14179 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
14180 cell)
14181 (setq prop (completing-read
14182 "Property: " (mapcar 'list (org-buffer-property-keys t))
14183 nil nil prop))
14184 (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
14185 (setq width (read-string "Column width: " (if width (number-to-string width))))
14186 (if (string-match "\\S-" width)
14187 (setq width (string-to-number width))
14188 (setq width nil))
14189 (setq fmt (completing-read "Summary [none]: "
14190 '(("none") ("add_numbers") ("add_times") ("checkbox"))
14191 nil t))
14192 (if (string-match "\\S-" fmt)
14193 (setq fmt (intern fmt))
14194 (setq fmt nil))
14195 (if (eq fmt 'none) (setq fmt nil))
14196 (if editp
14197 (progn
14198 (setcar editp prop)
14199 (setcdr editp (list title width nil fmt)))
14200 (setq cell (nthcdr (1- (current-column))
14201 org-columns-current-fmt-compiled))
14202 (setcdr cell (cons (list prop title width nil fmt)
14203 (cdr cell))))
14204 (org-columns-store-format)
14205 (org-columns-redo)))
14206
14207(defun org-columns-delete ()
14208 "Delete the column at point from columns view."
14209 (interactive)
14210 (let* ((n (current-column))
14211 (title (nth 1 (nth n org-columns-current-fmt-compiled))))
14212 (when (y-or-n-p
14213 (format "Are you sure you want to remove column \"%s\"? " title))
14214 (setq org-columns-current-fmt-compiled
14215 (delq (nth n org-columns-current-fmt-compiled)
14216 org-columns-current-fmt-compiled))
14217 (org-columns-store-format)
14218 (org-columns-redo)
14219 (if (>= (current-column) (length org-columns-current-fmt-compiled))
14220 (backward-char 1)))))
14221
14222(defun org-columns-edit-attributes ()
14223 "Edit the attributes of the current column."
14224 (interactive)
14225 (let* ((n (current-column))
14226 (info (nth n org-columns-current-fmt-compiled)))
14227 (apply 'org-columns-new info)))
14228
14229(defun org-columns-widen (arg)
14230 "Make the column wider by ARG characters."
14231 (interactive "p")
14232 (let* ((n (current-column))
14233 (entry (nth n org-columns-current-fmt-compiled))
14234 (width (or (nth 2 entry)
14235 (cdr (assoc (car entry) org-columns-current-maxwidths)))))
14236 (setq width (max 1 (+ width arg)))
14237 (setcar (nthcdr 2 entry) width)
14238 (org-columns-store-format)
14239 (org-columns-redo)))
14240
14241(defun org-columns-narrow (arg)
14242 "Make the column nrrower by ARG characters."
14243 (interactive "p")
14244 (org-columns-widen (- arg)))
14245
14246(defun org-columns-move-right ()
14247 "Swap this column with the one to the right."
14248 (interactive)
14249 (let* ((n (current-column))
14250 (cell (nthcdr n org-columns-current-fmt-compiled))
14251 e)
14252 (when (>= n (1- (length org-columns-current-fmt-compiled)))
14253 (error "Cannot shift this column further to the right"))
14254 (setq e (car cell))
14255 (setcar cell (car (cdr cell)))
14256 (setcdr cell (cons e (cdr (cdr cell))))
14257 (org-columns-store-format)
14258 (org-columns-redo)
14259 (forward-char 1)))
14260
14261(defun org-columns-move-left ()
14262 "Swap this column with the one to the left."
14263 (interactive)
14264 (let* ((n (current-column)))
14265 (when (= n 0)
14266 (error "Cannot shift this column further to the left"))
14267 (backward-char 1)
14268 (org-columns-move-right)
14269 (backward-char 1)))
14270
14271(defun org-columns-store-format ()
14272 "Store the text version of the current columns format in appropriate place.
14273This is either in the COLUMNS property of the node starting the current column
14274display, or in the #+COLUMNS line of the current buffer."
14275 (let (fmt)
14276 (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
14277 (if (marker-position org-columns-top-level-marker)
14278 (save-excursion
14279 (goto-char org-columns-top-level-marker)
14280 (if (org-entry-get nil "COLUMNS")
14281 (org-entry-put nil "COLUMNS" fmt)
14282 (goto-char (point-min))
14283 (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
14284 (replace-match (concat "#+COLUMNS: " fmt t t)))))
14285 (setq org-columns-current-fmt fmt))))
14286
13837(defvar org-overriding-columns-format nil 14287(defvar org-overriding-columns-format nil
13838 "FIXME:") 14288 "When set, overrides any other definition.")
13839(defvar org-agenda-view-columns-initially nil 14289(defvar org-agenda-view-columns-initially nil
13840 "FIXME:") 14290 "When set, switch to columns view immediately after creating the agenda.")
13841 14291
13842(defun org-agenda-columns () 14292(defun org-agenda-columns ()
13843 "Turn on column view in the agenda." 14293 "Turn on column view in the agenda."
13844 (interactive) 14294 (interactive)
13845 (let (fmt first-done cache maxwidths m) 14295 (org-verify-version 'columns)
14296 (org-columns-remove-overlays)
14297 (move-marker org-columns-begin-marker (point))
14298 (let (fmt cache maxwidths m)
13846 (cond 14299 (cond
13847 ((and (local-variable-p 'org-overriding-columns-format) 14300 ((and (local-variable-p 'org-overriding-columns-format)
13848 org-overriding-columns-format) 14301 org-overriding-columns-format)
13849 (setq fmt org-overriding-columns-format)) 14302 (setq fmt org-overriding-columns-format))
13850 ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) 14303 ((setq m (get-text-property (point-at-bol) 'org-hd-marker))
13851 (setq fmt (org-entry-get m "COLUMNS" t))) 14304 (setq fmt (org-entry-get m "COLUMNS" t)))
13852 ((and (boundp 'org-current-columns-fmt) 14305 ((and (boundp 'org-columns-current-fmt)
13853 (local-variable-p 'org-current-columns-fmt) 14306 (local-variable-p 'org-columns-current-fmt)
13854 org-current-columns-fmt) 14307 org-columns-current-fmt)
13855 (setq fmt org-current-columns-fmt)) 14308 (setq fmt org-columns-current-fmt))
13856 ((setq m (next-single-property-change (point-min) 'org-hd-marker)) 14309 ((setq m (next-single-property-change (point-min) 'org-hd-marker))
13857 (setq m (get-text-property m 'org-hd-marker)) 14310 (setq m (get-text-property m 'org-hd-marker))
13858 (setq fmt (org-entry-get m "COLUMNS" t)))) 14311 (setq fmt (org-entry-get m "COLUMNS" t))))
13859 (setq fmt (or fmt org-default-columns-format)) 14312 (setq fmt (or fmt org-columns-default-format))
13860 (org-set-local 'org-current-columns-fmt fmt) 14313 (org-set-local 'org-columns-current-fmt fmt)
14314 (org-columns-compile-format fmt)
13861 (save-excursion 14315 (save-excursion
13862 ;; Get and cache the properties 14316 ;; Get and cache the properties
13863 (goto-char (point-min)) 14317 (goto-char (point-min))
@@ -13867,16 +14321,16 @@ Where possible, use the standard interface for changing this line."
13867 (push (cons (org-current-line) (org-entry-properties m)) cache)) 14321 (push (cons (org-current-line) (org-entry-properties m)) cache))
13868 (beginning-of-line 2)) 14322 (beginning-of-line 2))
13869 (when cache 14323 (when cache
13870 (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) 14324 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
13871 (org-set-local 'org-current-columns-maxwidths maxwidths) 14325 (org-set-local 'org-columns-current-maxwidths maxwidths)
13872 (goto-line (car (org-last cache))) 14326 (goto-line (car (org-last cache)))
13873 (org-overlay-columns-title) 14327 (org-columns-display-here-title)
13874 (mapc (lambda (x) 14328 (mapc (lambda (x)
13875 (goto-line (car x)) 14329 (goto-line (car x))
13876 (org-overlay-columns (cdr x))) 14330 (org-columns-display-here (cdr x)))
13877 cache))))) 14331 cache)))))
13878 14332
13879(defun org-get-columns-autowidth-alist (s cache) 14333(defun org-columns-get-autowidth-alist (s cache)
13880 "Derive the maximum column widths from the format and the cache." 14334 "Derive the maximum column widths from the format and the cache."
13881 (let ((start 0) rtn) 14335 (let ((start 0) rtn)
13882 (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start) 14336 (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start)
@@ -13891,6 +14345,167 @@ Where possible, use the standard interface for changing this line."
13891 rtn) 14345 rtn)
13892 rtn)) 14346 rtn))
13893 14347
14348(defun org-columns-compute-all ()
14349 "Compute all columns that have operators defined."
14350 (remove-text-properties (point-min) (point-max) '(org-summaries t))
14351 (let ((columns org-columns-current-fmt-compiled) col)
14352 (while (setq col (pop columns))
14353 (when (nth 3 col)
14354 (save-excursion
14355 (org-columns-compute (car col)))))))
14356
14357(defun org-columns-update (property)
14358 "Recompute PROPERTY, and update the columns display for it."
14359 (org-columns-compute property)
14360 (let (fmt val pos)
14361 (save-excursion
14362 (mapc (lambda (ov)
14363 (when (equal (org-overlay-get ov 'org-columns-key) property)
14364 (setq pos (org-overlay-start ov))
14365 (goto-char pos)
14366 (when (setq val (cdr (assoc property
14367 (get-text-property (point-at-bol) 'org-summaries))))
14368 (setq fmt (org-overlay-get ov 'org-columns-format))
14369 (org-overlay-put ov 'display (format fmt val)))))
14370 org-columns-overlays))))
14371
14372(defun org-columns-compute (property)
14373 "Sum the values of property PROPERTY hierarchically, for the entire buffer."
14374 (interactive)
14375 (let* ((re (concat "^" outline-regexp))
14376 (lmax 30) ; Does anyone use deeper levels???
14377 (lsum (make-vector lmax 0))
14378 (level 0)
14379 (ass (assoc property org-columns-current-fmt-compiled))
14380 (format (nth 4 ass))
14381 (beg org-columns-top-level-marker)
14382 last-level val end sumpos sum-alist sum str)
14383 (save-excursion
14384 ;; Find the region to compute
14385 (goto-char beg)
14386 (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
14387 (goto-char end)
14388 ;; Walk the tree from the back and do the computations
14389 (while (re-search-backward re beg t)
14390 (setq sumpos (match-beginning 0)
14391 last-level level
14392 level (org-outline-level)
14393 val (org-entry-get nil property))
14394 (cond
14395 ((< level last-level)
14396 ;; put the sum of lower levels here as a property
14397 (setq sum (aref lsum last-level)
14398 str (org-column-number-to-string sum format)
14399 sum-alist (get-text-property sumpos 'org-summaries))
14400 (if (assoc property sum-alist)
14401 (setcdr (assoc property sum-alist) str)
14402 (push (cons property str) sum-alist)
14403 (add-text-properties sumpos (1+ sumpos)
14404 (list 'org-summaries sum-alist)))
14405 (when val
14406 (org-entry-put nil property str))
14407 ;; add current to current level accumulator
14408 (aset lsum level (+ (aref lsum level) sum))
14409 ;; clear accumulators for deeper levels
14410 (loop for l from (1+ level) to (1- lmax) do (aset lsum l 0)))
14411 ((>= level last-level)
14412 ;; add what we have here to the accumulator for this level
14413 (aset lsum level (+ (aref lsum level)
14414 (org-column-string-to-number (or val "0") format))))
14415 (t (error "This should not happen")))))))
14416
14417(defun org-columns-redo ()
14418 "Construct the column display again."
14419 (interactive)
14420 (message "Recomputing columns...")
14421 (save-excursion
14422 (if (marker-position org-columns-begin-marker)
14423 (goto-char org-columns-begin-marker))
14424 (org-columns-remove-overlays)
14425 (if (org-mode-p)
14426 (call-interactively 'org-columns)
14427 (call-interactively 'org-agenda-columns)))
14428 (message "Recomputing columns...done"))
14429
14430(defun org-columns-not-in-agenda ()
14431 (if (eq major-mode 'org-agenda-mode)
14432 (error "This command is only allowed in Org-mode buffers")))
14433
14434
14435(defun org-string-to-number (s)
14436 "Convert string to number, and interpret hh:mm:ss."
14437 (if (not (string-match ":" s))
14438 (string-to-number s)
14439 (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
14440 (while l
14441 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
14442 sum)))
14443
14444(defun org-column-number-to-string (n fmt)
14445 "Convert a computed column number to a string value, according to FMT."
14446 (cond
14447 ((eq fmt 'add_times)
14448 (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
14449 (format "%d:%02d" h m)))
14450 ((eq fmt 'checkbox)
14451 (cond ((= n (floor n)) "[X]")
14452 ((> n 1.) "[-]")
14453 (t "[ ]")))
14454 (t (number-to-string n))))
14455
14456(defun org-column-string-to-number (s fmt)
14457 "Convert a column value to a number that can be used for column computing."
14458 (cond
14459 ((string-match ":" s)
14460 (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
14461 (while l
14462 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
14463 sum))
14464 ((eq fmt 'checkbox)
14465 (if (equal s "[X]") 1. 0.000001))
14466 (t (string-to-number s))))
14467
14468(defun org-columns-uncompile-format (cfmt)
14469 "Turn the compiled columns format back into a string representation."
14470 (let ((rtn "") e s prop title op width fmt)
14471 (while (setq e (pop cfmt))
14472 (setq prop (car e)
14473 title (nth 1 e)
14474 width (nth 2 e)
14475 op (nth 3 e)
14476 fmt (nth 4 e))
14477 (cond
14478 ((eq fmt 'add_times) (setq op ":"))
14479 ((eq fmt 'checkbox) (setq op "X"))
14480 ((eq fmt 'add_numbers) (setq op "+")))
14481 (if (equal title prop) (setq title nil))
14482 (setq s (concat "%" (if width (number-to-string width))
14483 prop
14484 (if title (concat "(" title ")"))
14485 (if op (concat "{" op "}"))))
14486 (setq rtn (concat rtn " " s)))
14487 (org-trim rtn)))
14488
14489(defun org-columns-compile-format (fmt)
14490 "FIXME"
14491 (let ((start 0) width prop title op f)
14492 (setq org-columns-current-fmt-compiled nil)
14493 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z_0-9]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*"
14494 fmt start)
14495 (setq start (match-end 0)
14496 width (match-string 1 fmt)
14497 prop (match-string 2 fmt)
14498 title (or (match-string 3 fmt) prop)
14499 op (match-string 4 fmt)
14500 f nil)
14501 (if width (setq width (string-to-number width)))
14502 (cond
14503 ((equal op "+") (setq f 'add_numbers))
14504 ((equal op ":") (setq f 'add_times))
14505 ((equal op "X") (setq f 'checkbox)))
14506 (push (list prop title width op f) org-columns-current-fmt-compiled))
14507 (setq org-columns-current-fmt-compiled
14508 (nreverse org-columns-current-fmt-compiled))))
13894 14509
13895;;;; Timestamps 14510;;;; Timestamps
13896 14511
@@ -14084,7 +14699,7 @@ used to insert the time stamp into the buffer to include the time."
14084 ;; Help matching am/pm times, because `parse-time-string' does not do that. 14699 ;; Help matching am/pm times, because `parse-time-string' does not do that.
14085 ;; If there is a time with am/pm, and *no* time without it, we convert 14700 ;; If there is a time with am/pm, and *no* time without it, we convert
14086 ;; so that matching will be successful. 14701 ;; so that matching will be successful.
14087 ;; FIXME: make this replace twoce, so that we catch the end time. 14702 ;; FIXME: make this replace twice, so that we catch the end time.
14088 (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) 14703 (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
14089 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) 14704 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
14090 (setq hour (string-to-number (match-string 1 ans)) 14705 (setq hour (string-to-number (match-string 1 ans))
@@ -15308,8 +15923,7 @@ The following commands are available:
15308(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) 15923(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
15309(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) 15924(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
15310(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) 15925(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
15311; FIXME: other key? wtah about the menu???/ 15926
15312;(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
15313(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 15927(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
15314 "Local keymap for agenda entries from Org-mode.") 15928 "Local keymap for agenda entries from Org-mode.")
15315 15929
@@ -16555,7 +17169,6 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
16555 (mapcar 'list kwds) nil nil))) 17169 (mapcar 'list kwds) nil nil)))
16556 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) 17170 (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
16557 (org-set-local 'org-last-arg arg) 17171 (org-set-local 'org-last-arg arg)
16558;FIXME (org-set-local 'org-todo-keywords-for-agenda kwds)
16559 (setq org-agenda-redo-command 17172 (setq org-agenda-redo-command
16560 '(org-todo-list (or current-prefix-arg org-last-arg))) 17173 '(org-todo-list (or current-prefix-arg org-last-arg)))
16561 (setq files (org-agenda-files) 17174 (setq files (org-agenda-files)
@@ -16581,7 +17194,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
16581 (mapc (lambda (x) 17194 (mapc (lambda (x)
16582 (setq s (format "(%d)%s" (setq n (1+ n)) x)) 17195 (setq s (format "(%d)%s" (setq n (1+ n)) x))
16583 (if (> (+ (current-column) (string-width s) 1) (frame-width)) 17196 (if (> (+ (current-column) (string-width s) 1) (frame-width))
16584 (insert "\n ")) 17197 (insert "\n "))
16585 (insert " " s)) 17198 (insert " " s))
16586 kwds)) 17199 kwds))
16587 (insert "\n")) 17200 (insert "\n"))
@@ -16705,8 +17318,8 @@ MATCH is being ignored."
16705 "\\)\\>")) 17318 "\\)\\>"))
16706 (tags (nth 2 org-stuck-projects)) 17319 (tags (nth 2 org-stuck-projects))
16707 (tags-re (if (member "*" tags) 17320 (tags-re (if (member "*" tags)
16708 (org-re "^\\*+.*:[[:alnum:]_@]+:[ \t]*$") 17321 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
16709 (concat "^\\*+.*:\\(" 17322 (concat "^\\*+ .*:\\("
16710 (mapconcat 'identity tags "\\|") 17323 (mapconcat 'identity tags "\\|")
16711 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) 17324 (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))
16712 (gen-re (nth 3 org-stuck-projects)) 17325 (gen-re (nth 3 org-stuck-projects))
@@ -16951,7 +17564,7 @@ the documentation of `org-diary'."
16951(defun org-entry-is-done-p () 17564(defun org-entry-is-done-p ()
16952 "Is the current entry marked DONE?" 17565 "Is the current entry marked DONE?"
16953 (save-excursion 17566 (save-excursion
16954 (and (re-search-backward "[\r\n]\\*" nil t) 17567 (and (re-search-backward "[\r\n]\\* " nil t)
16955 (looking-at org-nl-done-regexp)))) 17568 (looking-at org-nl-done-regexp))))
16956 17569
16957(defun org-at-date-range-p (&optional inactive-ok) 17570(defun org-at-date-range-p (&optional inactive-ok)
@@ -16984,7 +17597,7 @@ the documentation of `org-diary'."
16984 (format "mouse-2 or RET jump to org file %s" 17597 (format "mouse-2 or RET jump to org file %s"
16985 (abbreviate-file-name buffer-file-name)))) 17598 (abbreviate-file-name buffer-file-name))))
16986 ;; FIXME: get rid of the \n at some point but watch out 17599 ;; FIXME: get rid of the \n at some point but watch out
16987 (regexp (concat "[\n\r]\\*+ *\\(" 17600 (regexp (concat "\n\\*+[ \t]+\\("
16988 (if org-select-this-todo-keyword 17601 (if org-select-this-todo-keyword
16989 (if (equal org-select-this-todo-keyword "*") 17602 (if (equal org-select-this-todo-keyword "*")
16990 org-todo-regexp 17603 org-todo-regexp
@@ -17093,12 +17706,12 @@ the documentation of `org-diary'."
17093 ;; substring should only run to end of time stamp 17706 ;; substring should only run to end of time stamp
17094 (setq timestr (substring timestr 0 (match-end 0)))) 17707 (setq timestr (substring timestr 0 (match-end 0))))
17095 (save-excursion 17708 (save-excursion
17096 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17709 (if (re-search-backward "^\\*+ " nil t)
17097 (progn 17710 (progn
17098 (goto-char (match-end 1)) 17711 (goto-char (match-beginning 0))
17099 (setq hdmarker (org-agenda-new-marker) 17712 (setq hdmarker (org-agenda-new-marker)
17100 tags (org-get-tags-at)) 17713 tags (org-get-tags-at))
17101 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17714 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17102 (setq txt (org-format-agenda-item 17715 (setq txt (org-format-agenda-item
17103 (format "%s%s" 17716 (format "%s%s"
17104 (if deadlinep "Deadline: " "") 17717 (if deadlinep "Deadline: " "")
@@ -17202,12 +17815,12 @@ the documentation of `org-diary'."
17202 ;; substring should only run to end of time stamp 17815 ;; substring should only run to end of time stamp
17203 (setq timestr (substring timestr 0 (match-end 0)))) 17816 (setq timestr (substring timestr 0 (match-end 0))))
17204 (save-excursion 17817 (save-excursion
17205 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17818 (if (re-search-backward "^\\*+ " nil t)
17206 (progn 17819 (progn
17207 (goto-char (match-end 1)) 17820 (goto-char (match-beginning 0))
17208 (setq hdmarker (org-agenda-new-marker) 17821 (setq hdmarker (org-agenda-new-marker)
17209 tags (org-get-tags-at)) 17822 tags (org-get-tags-at))
17210 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17823 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17211 (setq txt (org-format-agenda-item 17824 (setq txt (org-format-agenda-item
17212 (if closedp "Closed: " "Clocked: ") 17825 (if closedp "Closed: " "Clocked: ")
17213 (match-string 1) category tags timestr))) 17826 (match-string 1) category tags timestr)))
@@ -17252,10 +17865,10 @@ the documentation of `org-diary'."
17252 (if (and (< diff wdays) todayp (not (= diff 0))) 17865 (if (and (< diff wdays) todayp (not (= diff 0)))
17253 (save-excursion 17866 (save-excursion
17254 (setq category (org-get-category)) 17867 (setq category (org-get-category))
17255 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) 17868 (if (re-search-backward "^\\*+[ \t]+" nil t)
17256 (progn 17869 (progn
17257 (goto-char (match-end 0)) 17870 (goto-char (match-end 0))
17258 (setq pos1 (match-end 1)) 17871 (setq pos1 (match-beginning 0))
17259 (setq tags (org-get-tags-at pos1)) 17872 (setq tags (org-get-tags-at pos1))
17260 (setq head (buffer-substring-no-properties 17873 (setq head (buffer-substring-no-properties
17261 (point) 17874 (point)
@@ -17311,10 +17924,10 @@ the documentation of `org-diary'."
17311 (if (and (< diff 0) todayp) 17924 (if (and (< diff 0) todayp)
17312 (save-excursion 17925 (save-excursion
17313 (setq category (org-get-category)) 17926 (setq category (org-get-category))
17314 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) 17927 (if (re-search-backward "^\\*+[ \t]+" nil t)
17315 (progn 17928 (progn
17316 (goto-char (match-end 0)) 17929 (goto-char (match-end 0))
17317 (setq pos1 (match-end 1)) 17930 (setq pos1 (match-beginning 0))
17318 (setq tags (org-get-tags-at)) 17931 (setq tags (org-get-tags-at))
17319 (setq head (buffer-substring-no-properties 17932 (setq head (buffer-substring-no-properties
17320 (point) 17933 (point)
@@ -17364,12 +17977,12 @@ the documentation of `org-diary'."
17364 (save-excursion 17977 (save-excursion
17365 (setq marker (org-agenda-new-marker (point))) 17978 (setq marker (org-agenda-new-marker (point)))
17366 (setq category (org-get-category)) 17979 (setq category (org-get-category))
17367 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17980 (if (re-search-backward "^\\*+ " nil t)
17368 (progn 17981 (progn
17369 (setq hdmarker (org-agenda-new-marker (match-end 1))) 17982 (goto-char (match-beginning 0))
17370 (goto-char (match-end 1)) 17983 (setq hdmarker (org-agenda-new-marker (point)))
17371 (setq tags (org-get-tags-at)) 17984 (setq tags (org-get-tags-at))
17372 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17985 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17373 (setq txt (org-format-agenda-item 17986 (setq txt (org-format-agenda-item
17374 (format (if (= d1 d2) "" "(%d/%d): ") 17987 (format (if (= d1 d2) "" "(%d/%d): ")
17375 (1+ (- d0 d1)) (1+ (- d2 d1))) 17988 (1+ (- d0 d1)) (1+ (- d2 d1)))
@@ -17655,8 +18268,8 @@ HH:MM."
17655 18268
17656(defsubst org-cmp-category (a b) 18269(defsubst org-cmp-category (a b)
17657 "Compare the string values of categories of strings A and B." 18270 "Compare the string values of categories of strings A and B."
17658 (let ((ca (or (get-text-property 1 'category a) "")) 18271 (let ((ca (or (get-text-property 1 'org-category a) ""))
17659 (cb (or (get-text-property 1 'category b) ""))) 18272 (cb (or (get-text-property 1 'org-category b) "")))
17660 (cond ((string-lessp ca cb) -1) 18273 (cond ((string-lessp ca cb) -1)
17661 ((string-lessp cb ca) +1) 18274 ((string-lessp cb ca) +1)
17662 (t nil)))) 18275 (t nil))))
@@ -17715,7 +18328,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
17715 (if (not (one-window-p)) (delete-window)) 18328 (if (not (one-window-p)) (delete-window))
17716 (kill-buffer buf) 18329 (kill-buffer buf)
17717 (org-agenda-maybe-reset-markers 'force) 18330 (org-agenda-maybe-reset-markers 'force)
17718 (org-remove-column-overlays)) 18331 (org-columns-remove-overlays))
17719 ;; Maybe restore the pre-agenda window configuration. 18332 ;; Maybe restore the pre-agenda window configuration.
17720 (and org-agenda-restore-windows-after-quit 18333 (and org-agenda-restore-windows-after-quit
17721 (not (eq org-agenda-window-setup 'other-frame)) 18334 (not (eq org-agenda-window-setup 'other-frame))
@@ -17814,10 +18427,12 @@ With prefix ARG, go backward that many times the current span."
17814(defun org-agenda-day-view () 18427(defun org-agenda-day-view ()
17815 "Switch to daily view for agenda." 18428 "Switch to daily view for agenda."
17816 (interactive) 18429 (interactive)
18430 (setq org-agenda-ndays 1)
17817 (org-agenda-change-time-span 'day)) 18431 (org-agenda-change-time-span 'day))
17818(defun org-agenda-week-view () 18432(defun org-agenda-week-view ()
17819 "Switch to daily view for agenda." 18433 "Switch to daily view for agenda."
17820 (interactive) 18434 (interactive)
18435 (setq org-agenda-ndays 7)
17821 (org-agenda-change-time-span 'week)) 18436 (org-agenda-change-time-span 'week))
17822(defun org-agenda-month-view () 18437(defun org-agenda-month-view ()
17823 "Switch to daily view for agenda." 18438 "Switch to daily view for agenda."
@@ -17860,8 +18475,9 @@ so that the date SD will be in that range."
17860 ((eq span 'week) 18475 ((eq span 'week)
17861 (let* ((nt (calendar-day-of-week 18476 (let* ((nt (calendar-day-of-week
17862 (calendar-gregorian-from-absolute sd))) 18477 (calendar-gregorian-from-absolute sd)))
17863 (n1 org-agenda-start-on-weekday) 18478 (d (if org-agenda-start-on-weekday
17864 (d (- nt n1))) 18479 (- nt org-agenda-start-on-weekday)
18480 0)))
17865 (setq sd (- sd (+ (if (< d 0) 7 0) d))) 18481 (setq sd (- sd (+ (if (< d 0) 7 0) d)))
17866 (setq nd 7))) 18482 (setq nd 7)))
17867 ((eq span 'month) 18483 ((eq span 'month)
@@ -18329,7 +18945,7 @@ the tags of the current headline come last."
18329 (org-back-to-heading t) 18945 (org-back-to-heading t)
18330 (condition-case nil 18946 (condition-case nil
18331 (while t 18947 (while t
18332 (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")) 18948 (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$"))
18333 (setq tags (append (org-split-string 18949 (setq tags (append (org-split-string
18334 (org-match-string-no-properties 1) ":") 18950 (org-match-string-no-properties 1) ":")
18335 tags))) 18951 tags)))
@@ -19463,7 +20079,8 @@ translations. There is currently no way for users to extend this.")
19463 (re-archive (concat ":" org-archive-tag ":")) 20079 (re-archive (concat ":" org-archive-tag ":"))
19464 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) 20080 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))
19465 (htmlp (plist-get parameters :for-html)) 20081 (htmlp (plist-get parameters :for-html))
19466 (outline-regexp "\\*+") 20082 (inhibit-read-only t)
20083 (outline-regexp "\\*+ ")
19467 a b 20084 a b
19468 rtn p) 20085 rtn p)
19469 (save-excursion 20086 (save-excursion
@@ -19739,7 +20356,7 @@ underlined headlines. The default is 3."
19739 :skip-before-1st-heading 20356 :skip-before-1st-heading
19740 (plist-get opt-plist :skip-before-1st-heading) 20357 (plist-get opt-plist :skip-before-1st-heading)
19741 :add-text (plist-get opt-plist :text)) 20358 :add-text (plist-get opt-plist :text))
19742 "[\r\n]"))) 20359 "[\r\n]"))) ;; FIXME: why \r here???/
19743 thetoc have-headings first-heading-pos 20360 thetoc have-headings first-heading-pos
19744 table-open table-buffer) 20361 table-open table-buffer)
19745 20362
@@ -19846,7 +20463,7 @@ underlined headlines. The default is 3."
19846 (when custom-times 20463 (when custom-times
19847 (setq line (org-translate-time line))) 20464 (setq line (org-translate-time line)))
19848 (cond 20465 (cond
19849 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 20466 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
19850 ;; a Headline 20467 ;; a Headline
19851 (setq first-heading-pos (or first-heading-pos (point))) 20468 (setq first-heading-pos (or first-heading-pos (point)))
19852 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 20469 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
@@ -19953,7 +20570,7 @@ underlined headlines. The default is 3."
19953 ;; find the indentation of the next non-empty line 20570 ;; find the indentation of the next non-empty line
19954 (catch 'stop 20571 (catch 'stop
19955 (while lines 20572 (while lines
19956 (if (string-match "^\\*" (car lines)) (throw 'stop nil)) 20573 (if (string-match "^\\* " (car lines)) (throw 'stop nil))
19957 (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) 20574 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
19958 (throw 'stop (setq ind (org-get-indentation (car lines))))) 20575 (throw 'stop (setq ind (org-get-indentation (car lines)))))
19959 (pop lines))) 20576 (pop lines)))
@@ -20145,12 +20762,12 @@ this line is also exported in fixed-width font."
20145 (save-excursion 20762 (save-excursion
20146 (org-back-to-heading) 20763 (org-back-to-heading)
20147 (if (looking-at (concat outline-regexp 20764 (if (looking-at (concat outline-regexp
20148 "\\( +\\<" org-quote-string "\\>\\)")) 20765 "\\( *\\<" org-quote-string "\\>\\)"))
20149 (replace-match "" t t nil 1) 20766 (replace-match "" t t nil 1)
20150 (if (looking-at outline-regexp) 20767 (if (looking-at outline-regexp)
20151 (progn 20768 (progn
20152 (goto-char (match-end 0)) 20769 (goto-char (match-end 0))
20153 (insert " " org-quote-string)))))))) 20770 (insert org-quote-string " "))))))))
20154 20771
20155(defun org-export-as-html-and-open (arg) 20772(defun org-export-as-html-and-open (arg)
20156 "Export the outline as HTML and immediately open it with a browser. 20773 "Export the outline as HTML and immediately open it with a browser.
@@ -20303,7 +20920,7 @@ the body tags themselves."
20303 (file-name-nondirectory buffer-file-name))) 20920 (file-name-nondirectory buffer-file-name)))
20304 "UNTITLED")) 20921 "UNTITLED"))
20305 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 20922 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
20306 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) 20923 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
20307 (inquote nil) 20924 (inquote nil)
20308 (infixed nil) 20925 (infixed nil)
20309 (in-local-list nil) 20926 (in-local-list nil)
@@ -20495,7 +21112,7 @@ lang=\"%s\" xml:lang=\"%s\">
20495 (catch 'nextline 21112 (catch 'nextline
20496 21113
20497 ;; end of quote section? 21114 ;; end of quote section?
20498 (when (and inquote (string-match "^\\*+" line)) 21115 (when (and inquote (string-match "^\\*+ " line))
20499 (insert "</pre>\n") 21116 (insert "</pre>\n")
20500 (setq inquote nil)) 21117 (setq inquote nil))
20501 ;; inside a quote section? 21118 ;; inside a quote section?
@@ -20672,7 +21289,7 @@ lang=\"%s\" xml:lang=\"%s\">
20672 t t line))))) 21289 t t line)))))
20673 21290
20674 (cond 21291 (cond
20675 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 21292 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
20676 ;; This is a headline 21293 ;; This is a headline
20677 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 21294 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
20678 txt (match-string 2 line)) 21295 txt (match-string 2 line))
@@ -21595,7 +22212,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
21595 (with-current-buffer out (erase-buffer)) 22212 (with-current-buffer out (erase-buffer))
21596 ;; Kick off the output 22213 ;; Kick off the output
21597 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") 22214 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
21598 (while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't) 22215 (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
21599 (let* ((hd (match-string-no-properties 1)) 22216 (let* ((hd (match-string-no-properties 1))
21600 (level (length hd)) 22217 (level (length hd))
21601 (text (concat 22218 (text (concat
@@ -21827,7 +22444,13 @@ overwritten, and the table is not marked as requiring realignment."
21827 (goto-char (match-beginning 0)) 22444 (goto-char (match-beginning 0))
21828 (self-insert-command N)) 22445 (self-insert-command N))
21829 (setq org-table-may-need-update t) 22446 (setq org-table-may-need-update t)
21830 (self-insert-command N))) 22447 (self-insert-command N)
22448 (org-fix-tags-on-the-fly)))
22449
22450(defun org-fix-tags-on-the-fly ()
22451 (when (and (equal (char-after (point-at-bol)) ?*)
22452 (org-on-heading-p))
22453 (org-align-tags-here org-tags-column)))
21831 22454
21832(defun org-delete-backward-char (N) 22455(defun org-delete-backward-char (N)
21833 "Like `delete-backward-char', insert whitespace at field end in tables. 22456 "Like `delete-backward-char', insert whitespace at field end in tables.
@@ -21850,7 +22473,8 @@ because, in this case the deletion might narrow the column."
21850 ;; noalign: if there were two spaces at the end, this field 22473 ;; noalign: if there were two spaces at the end, this field
21851 ;; does not determine the width of the column. 22474 ;; does not determine the width of the column.
21852 (if noalign (setq org-table-may-need-update c))) 22475 (if noalign (setq org-table-may-need-update c)))
21853 (backward-delete-char N))) 22476 (backward-delete-char N)
22477 (org-fix-tags-on-the-fly)))
21854 22478
21855(defun org-delete-char (N) 22479(defun org-delete-char (N)
21856 "Like `delete-char', but insert whitespace at field end in tables. 22480 "Like `delete-char', but insert whitespace at field end in tables.
@@ -21875,7 +22499,8 @@ because, in this case the deletion might narrow the column."
21875 ;; does not determine the width of the column. 22499 ;; does not determine the width of the column.
21876 (if noalign (setq org-table-may-need-update c))) 22500 (if noalign (setq org-table-may-need-update c)))
21877 (delete-char N)) 22501 (delete-char N))
21878 (delete-char N))) 22502 (delete-char N)
22503 (org-fix-tags-on-the-fly)))
21879 22504
21880;; Make `delete-selection-mode' work with org-mode and orgtbl-mode 22505;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
21881(put 'org-self-insert-command 'delete-selection t) 22506(put 'org-self-insert-command 'delete-selection t)
@@ -22052,6 +22677,7 @@ depending on context. See the individual commands for more information."
22052 (cond 22677 (cond
22053 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) 22678 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
22054 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) 22679 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
22680 ((org-at-property-p) (call-interactively 'org-property-next-allowed-value))
22055 (t (org-shiftcursor-error)))) 22681 (t (org-shiftcursor-error))))
22056 22682
22057(defun org-shiftleft () 22683(defun org-shiftleft ()
@@ -22060,6 +22686,8 @@ depending on context. See the individual commands for more information."
22060 (cond 22686 (cond
22061 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) 22687 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
22062 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) 22688 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
22689 ((org-at-property-p)
22690 (call-interactively 'org-property-previous-allowed-value))
22063 (t (org-shiftcursor-error)))) 22691 (t (org-shiftcursor-error))))
22064 22692
22065(defun org-shiftcontrolright () 22693(defun org-shiftcontrolright ()
@@ -22152,6 +22780,8 @@ This command does many different things, depending on context:
22152 ((and (local-variable-p 'org-finish-function (current-buffer)) 22780 ((and (local-variable-p 'org-finish-function (current-buffer))
22153 (fboundp org-finish-function)) 22781 (fboundp org-finish-function))
22154 (funcall org-finish-function)) 22782 (funcall org-finish-function))
22783 ((org-at-property-p)
22784 (call-interactively 'org-property-action))
22155 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) 22785 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
22156 ((org-on-heading-p) (call-interactively 'org-set-tags)) 22786 ((org-on-heading-p) (call-interactively 'org-set-tags))
22157 ((org-at-table.el-p) 22787 ((org-at-table.el-p)
@@ -22306,9 +22936,9 @@ See the individual commands for more information."
22306 "--" 22936 "--"
22307 ["Jump" org-goto t] 22937 ["Jump" org-goto t]
22308 "--" 22938 "--"
22309 ["C-a finds headline start" 22939 ["C-a/e find headline start/end"
22310 (setq org-special-ctrl-a (not org-special-ctrl-a)) 22940 (setq org-special-ctrl-a/e (not org-special-ctrl-a/e))
22311 :style toggle :selected org-special-ctrl-a]) 22941 :style toggle :selected org-special-ctrl-a/e])
22312 ("Edit Structure" 22942 ("Edit Structure"
22313 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] 22943 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
22314 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] 22944 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
@@ -22361,17 +22991,7 @@ See the individual commands for more information."
22361 "--" 22991 "--"
22362 ["Set Priority" org-priority t] 22992 ["Set Priority" org-priority t]
22363 ["Priority Up" org-shiftup t] 22993 ["Priority Up" org-shiftup t]
22364 ["Priority Down" org-shiftdown t] 22994 ["Priority Down" org-shiftdown t])
22365 "--"
22366 ;; FIXME: why is this still here????
22367; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)]
22368; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)]
22369; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count))
22370; (or (org-on-heading-p) (org-at-item-p))]
22371; ["Insert [%] cookie" (progn (insert "[%]") (org-update-checkbox-count))
22372; (or (org-on-heading-p) (org-at-item-p))]
22373; ["Update Statistics" org-update-checkbox-count t]
22374 )
22375 ("TAGS and Properties" 22995 ("TAGS and Properties"
22376 ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] 22996 ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)]
22377 ["Column view of properties" org-columns t]) 22997 ["Column view of properties" org-columns t])
@@ -22811,16 +23431,16 @@ not an indirect buffer"
22811 ;; text in a line directly attached to a headline would otherwise 23431 ;; text in a line directly attached to a headline would otherwise
22812 ;; fill the headline as well. 23432 ;; fill the headline as well.
22813 (org-set-local 'comment-start-skip "^#+[ \t]*") 23433 (org-set-local 'comment-start-skip "^#+[ \t]*")
22814 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 23434 (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]")
22815;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$") 23435;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$")
22816 ;; The paragraph starter includes hand-formatted lists. 23436 ;; The paragraph starter includes hand-formatted lists.
22817 (org-set-local 'paragraph-start 23437 (org-set-local 'paragraph-start
22818 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 23438 "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
22819 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 23439 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
22820 ;; But only if the user has not turned off tables or fixed-width regions 23440 ;; But only if the user has not turned off tables or fixed-width regions
22821 (org-set-local 23441 (org-set-local
22822 'auto-fill-inhibit-regexp 23442 'auto-fill-inhibit-regexp
22823 (concat "\\*\\|#\\+" 23443 (concat "\\*+ \\|#\\+"
22824 "\\|[ \t]*" org-keyword-time-regexp 23444 "\\|[ \t]*" org-keyword-time-regexp
22825 (if (or org-enable-table-editor org-enable-fixed-width-editor) 23445 (if (or org-enable-table-editor org-enable-fixed-width-editor)
22826 (concat 23446 (concat
@@ -22866,10 +23486,13 @@ work correctly."
22866 23486
22867;; C-a should go to the beginning of a *visible* line, also in the 23487;; C-a should go to the beginning of a *visible* line, also in the
22868;; new outline.el. I guess this should be patched into Emacs? 23488;; new outline.el. I guess this should be patched into Emacs?
22869(defun org-beginning-of-line () 23489(defun org-beginning-of-line (&optional arg)
22870 "Go to the beginning of the current line. If that is invisible, continue 23490 "Go to the beginning of the current line. If that is invisible, continue
22871to a visible line beginning. This makes the function of C-a more intuitive." 23491to a visible line beginning. This makes the function of C-a more intuitive.
22872 (interactive) 23492If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
23493first attempt, and only move to after the tags when the cursor is already
23494beyond the end of the headline."
23495 (interactive "P")
22873 (let ((pos (point))) 23496 (let ((pos (point)))
22874 (beginning-of-line 1) 23497 (beginning-of-line 1)
22875 (if (bobp) 23498 (if (bobp)
@@ -22880,14 +23503,33 @@ to a visible line beginning. This makes the function of C-a more intuitive."
22880 (backward-char 1) 23503 (backward-char 1)
22881 (beginning-of-line 1)) 23504 (beginning-of-line 1))
22882 (forward-char 1))) 23505 (forward-char 1)))
22883 (when (and org-special-ctrl-a (looking-at org-todo-line-regexp) 23506 (when (and org-special-ctrl-a/e (looking-at org-todo-line-regexp)
22884 (= (char-after (match-end 1)) ?\ )) 23507 (= (char-after (match-end 1)) ?\ ))
22885 (goto-char 23508 (goto-char
22886 (cond ((> pos (match-beginning 3)) (match-beginning 3)) 23509 (cond ((> pos (match-beginning 3)) (match-beginning 3))
22887 ((= pos (point)) (match-beginning 3)) 23510 ((= pos (point)) (match-beginning 3))
22888 (t (point))))))) 23511 (t (point)))))))
22889 23512
23513(defun org-end-of-line (&optional arg)
23514 "Go to the end of the line.
23515If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
23516first attempt, and only move to after the tags when the cursor is already
23517beyond the end of the headline."
23518 (interactive "P")
23519 (if (or (not org-special-ctrl-a/e)
23520 (not (org-on-heading-p)))
23521 (end-of-line arg)
23522 (let ((pos (point)))
23523 (beginning-of-line 1)
23524 (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
23525 (if (or (< pos (match-beginning 1))
23526 (= pos (match-end 0)))
23527 (goto-char (match-beginning 1))
23528 (goto-char (match-end 0)))
23529 (end-of-line arg)))))
23530
22890(define-key org-mode-map "\C-a" 'org-beginning-of-line) 23531(define-key org-mode-map "\C-a" 'org-beginning-of-line)
23532(define-key org-mode-map "\C-e" 'org-end-of-line)
22891 23533
22892(defun org-invisible-p () 23534(defun org-invisible-p ()
22893 "Check if point is at a character currently not visible." 23535 "Check if point is at a character currently not visible."
@@ -23099,7 +23741,53 @@ Still experimental, may disappear in the furture."
23099 ;; make tree, check each match with the callback 23741 ;; make tree, check each match with the callback
23100 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) 23742 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
23101 23743
23744(defun org-fill-paragraph-experimental (&optional justify)
23745 "Re-align a table, pass through to fill-paragraph if no table."
23746 (let ((table-p (org-at-table-p))
23747 (table.el-p (org-at-table.el-p)))
23748 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines
23749 (table.el-p t) ; skip table.el tables
23750 (table-p (org-table-align) t) ; align org-mode tables
23751 ((save-excursion
23752 (let ((pos (1+ (point-at-eol))))
23753 (backward-paragraph 1)
23754 (re-search-forward "\\\\\\\\[ \t]*$" pos t)))
23755 (save-excursion
23756 (save-restriction
23757 (narrow-to-region (1+ (match-end 0)) (point-max))
23758 (fill-paragraph nil)
23759 t)))
23760 (t nil)))) ; call paragraph-fill
23761
23762(defun org-property-previous-allowed-value (&optional previous)
23763 "Switch to the next allowed value for this property."
23764 (interactive)
23765 (org-property-next-allowed-value t))
23102 23766
23767(defun org-property-next-allowed-value (&optional previous)
23768 "Switch to the next allowed value for this property."
23769 (interactive)
23770 (unless (org-at-property-p)
23771 (error "Not at a property"))
23772 (let* ((key (match-string 2))
23773 (value (match-string 3))
23774 (allowed (or (org-property-get-allowed-values (point) key)
23775 (and (member value '("[ ]" "[-]" "[X]"))
23776 '("[ ]" "[X]"))))
23777 nval)
23778 (unless allowed
23779 (error "Allowed values for this property have not been defined"))
23780 (if previous (setq allowed (reverse allowed)))
23781 (if (member value allowed)
23782 (setq nval (car (cdr (member value allowed)))))
23783 (setq nval (or nval (car allowed)))
23784 (if (equal nval value)
23785 (error "Only one allowed value for this property"))
23786 (org-at-property-p)
23787 (replace-match (concat " :" key ": " nval))
23788 (org-indent-line-function)
23789 (beginning-of-line 1)
23790 (skip-chars-forward " \t")))
23103 23791
23104;;;; Finish up 23792;;;; Finish up
23105 23793
@@ -23109,3 +23797,4 @@ Still experimental, may disappear in the furture."
23109 23797
23110;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 23798;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
23111;;; org.el ends here 23799;;; org.el ends here
23800
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 5757100468b..034caeee702 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -243,6 +243,21 @@ Normally set to either `plain-tex-mode' or `latex-mode'."
243 :options '("''" "\">" "\"'" ">>" "»") 243 :options '("''" "\">" "\"'" ">>" "»")
244 :group 'tex) 244 :group 'tex)
245 245
246(defcustom tex-fontify-script t
247 "If non-nil, fontify subscript and superscript strings."
248 :type 'boolean
249 :group 'tex)
250(put 'tex-fontify-script 'safe-local-variable 'booleanp)
251
252(defcustom tex-font-script-display '(-0.3 . 0.3)
253 "Display specification for subscript and superscript content.
254The car is used for subscript, the cdr is used for superscripts."
255 :group 'tex
256 :type '(cons (choice (float :tag "Subscript")
257 (const :tag "No lowering" nil))
258 (choice (float :tag "Superscript")
259 (const :tag "No raising" nil))))
260
246(defvar tex-last-temp-file nil 261(defvar tex-last-temp-file nil
247 "Latest temporary file generated by \\[tex-region] and \\[tex-buffer]. 262 "Latest temporary file generated by \\[tex-region] and \\[tex-buffer].
248Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the 263Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the
@@ -593,13 +608,14 @@ An alternative value is \" . \", if you use a font with a narrow period."
593 (setq pos (1- pos) odd (not odd))) 608 (setq pos (1- pos) odd (not odd)))
594 odd)) 609 odd))
595 (if (eq (char-after pos) ?_) 610 (if (eq (char-after pos) ?_)
596 '(face subscript display (raise -0.3)) 611 `(face subscript display (raise ,(car tex-font-script-display)))
597 '(face superscript display (raise +0.3))))) 612 `(face superscript display (raise ,(cdr tex-font-script-display))))))
598 613
599(defun tex-font-lock-match-suscript (limit) 614(defun tex-font-lock-match-suscript (limit)
600 "Match subscript and superscript patterns up to LIMIT." 615 "Match subscript and superscript patterns up to LIMIT."
601 (when (re-search-forward "[_^] *\\([^\n\\{}]\\|\ 616 (when (and tex-fontify-script
602\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t) 617 (re-search-forward "[_^] *\\([^\n\\{}]\\|\
618\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t))
603 (when (match-end 3) 619 (when (match-end 3)
604 (let ((beg (match-beginning 3)) 620 (let ((beg (match-beginning 3))
605 (end (save-restriction 621 (end (save-restriction
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index e4c13d3039a..c6aaa6c8c0b 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -424,13 +424,6 @@ Return non-nil if FILE is unchanged."
424 424
425;;; Completion of versions and revisions. 425;;; Completion of versions and revisions.
426 426
427(defun vc-arch-complete (table string pred action)
428 (assert (not (functionp table)))
429 (cond
430 ((null action) (try-completion string table pred))
431 ((eq action t) (all-completions string table pred))
432 (t (test-completion string table pred))))
433
434(defun vc-arch--version-completion-table (root string) 427(defun vc-arch--version-completion-table (root string)
435 (delq nil 428 (delq nil
436 (mapcar 429 (mapcar
@@ -450,10 +443,9 @@ Return non-nil if FILE is unchanged."
450 (lexical-let ((file file)) 443 (lexical-let ((file file))
451 (lambda (string pred action) 444 (lambda (string pred action)
452 ;; FIXME: complete revision patches as well. 445 ;; FIXME: complete revision patches as well.
453 (let ((root (expand-file-name "{arch}" (vc-arch-root file)))) 446 (let* ((root (expand-file-name "{arch}" (vc-arch-root file)))
454 (vc-arch-complete 447 (table (vc-arch--version-completion-table root string)))
455 (vc-arch--version-completion-table root string) 448 (complete-with-action action table string pred)))))
456 string pred action)))))
457 449
458;;; Trimming revision libraries. 450;;; Trimming revision libraries.
459 451
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 583e02efd5d..22ed10d1286 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -29,8 +29,11 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile 32(eval-when-compile (require 'cl) (require 'vc))
33 (require 'vc)) 33
34;; Clear up the cache to force vc-call to check again and discover
35;; new functions when we reload this file.
36(put 'CVS 'vc-functions nil)
34 37
35;;; 38;;;
36;;; Customization options 39;;; Customization options
@@ -368,99 +371,45 @@ its parents."
368 "-p" 371 "-p"
369 (vc-switches 'CVS 'checkout))) 372 (vc-switches 'CVS 'checkout)))
370 373
371(defun vc-cvs-checkout (file &optional editable rev workfile) 374(defun vc-cvs-checkout (file &optional editable rev)
372 "Retrieve a revision of FILE into a WORKFILE. 375 "Checkout a revision of FILE into the working area.
373EDITABLE non-nil means that the file should be writable. 376EDITABLE non-nil means that the file should be writable.
374REV is the revision to check out into WORKFILE." 377REV is the revision to check out."
375 (let ((filename (or workfile file)) 378 (message "Checking out %s..." file)
376 (file-buffer (get-file-buffer file)) 379 ;; Change buffers to get local value of vc-checkout-switches.
377 switches) 380 (with-current-buffer (or (get-file-buffer file) (current-buffer))
378 (message "Checking out %s..." filename) 381 (if (and (file-exists-p file) (not rev))
379 (save-excursion 382 ;; If no revision was specified, just make the file writable
380 ;; Change buffers to get local value of vc-checkout-switches. 383 ;; if necessary (using `cvs-edit' if requested).
381 (if file-buffer (set-buffer file-buffer)) 384 (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
382 (setq switches (vc-switches 'CVS 'checkout)) 385 (if vc-cvs-use-edit
383 ;; Save this buffer's default-directory 386 (vc-cvs-command nil 0 file "edit")
384 ;; and use save-excursion to make sure it is restored 387 (set-file-modes file (logior (file-modes file) 128))
385 ;; in the same buffer it was saved in. 388 (if (equal file buffer-file-name) (toggle-read-only -1))))
386 (let ((default-directory default-directory)) 389 ;; Check out a particular version (or recreate the file).
387 (save-excursion 390 (vc-file-setprop file 'vc-workfile-version nil)
388 ;; Adjust the default-directory so that the check-out creates 391 (apply 'vc-cvs-command nil 0 file
389 ;; the file in the right place. 392 (and editable "-w")
390 (setq default-directory (file-name-directory filename)) 393 "update"
391 (if workfile 394 (when rev
392 (let ((failed t) 395 (unless (eq rev t)
393 (backup-name (if (string= file workfile) 396 ;; default for verbose checkout: clear the
394 (car (find-backup-file-name filename))))) 397 ;; sticky tag so that the actual update will
395 (when backup-name 398 ;; get the head of the trunk
396 (copy-file filename backup-name 399 (if (string= rev "")
397 'ok-if-already-exists 'keep-date) 400 "-A"
398 (unless (file-writable-p filename) 401 (concat "-r" rev))))
399 (set-file-modes filename 402 (vc-switches 'CVS 'checkout)))
400 (logior (file-modes filename) 128)))) 403 (vc-mode-line file))
401 (unwind-protect 404 (message "Checking out %s...done" file))
402 (progn
403 (let ((coding-system-for-read 'no-conversion)
404 (coding-system-for-write 'no-conversion))
405 (with-temp-file filename
406 (apply 'vc-cvs-command
407 (current-buffer) 0 file
408 "-Q" ; suppress diagnostic output
409 "update"
410 (and (stringp rev)
411 (not (string= rev ""))
412 (concat "-r" rev))
413 "-p"
414 switches)))
415 (setq failed nil))
416 (if failed
417 (if backup-name
418 (rename-file backup-name filename
419 'ok-if-already-exists)
420 (if (file-exists-p filename)
421 (delete-file filename)))
422 (and backup-name
423 (not vc-make-backup-files)
424 (delete-file backup-name)))))
425 (if (and (file-exists-p file) (not rev))
426 ;; If no revision was specified, just make the file writable
427 ;; if necessary (using `cvs-edit' if requested).
428 (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
429 (if vc-cvs-use-edit
430 (vc-cvs-command nil 0 file "edit")
431 (set-file-modes file (logior (file-modes file) 128))
432 (if file-buffer (toggle-read-only -1))))
433 ;; Check out a particular version (or recreate the file).
434 (vc-file-setprop file 'vc-workfile-version nil)
435 (apply 'vc-cvs-command nil 0 file
436 (and editable
437 (or (not (file-exists-p file))
438 (not (eq (vc-cvs-checkout-model file)
439 'implicit)))
440 "-w")
441 "update"
442 (when rev
443 (unless (eq rev t)
444 ;; default for verbose checkout: clear the
445 ;; sticky tag so that the actual update will
446 ;; get the head of the trunk
447 (if (string= rev "")
448 "-A"
449 (concat "-r" rev))))
450 switches))))
451 (vc-mode-line file)
452 (message "Checking out %s...done" filename)))))
453 405
454(defun vc-cvs-delete-file (file) 406(defun vc-cvs-delete-file (file)
455 (vc-cvs-command nil 0 file "remove" "-f") 407 (vc-cvs-command nil 0 file "remove" "-f")
456 (vc-cvs-command nil 0 file "commit" "-mRemoved.")) 408 (vc-cvs-command nil 0 file "commit" "-mRemoved."))
457 409
458(defun vc-cvs-revert (file &optional contents-done) 410(defun vc-cvs-revert (file &optional contents-done)
459 "Revert FILE to the version it was based on." 411 "Revert FILE to the version on which it was based."
460 (unless contents-done 412 (vc-default-revert 'CVS file contents-done)
461 ;; Check out via standard output (caused by the final argument
462 ;; FILE below), so that no sticky tag is set.
463 (vc-cvs-checkout file nil (vc-workfile-version file) file))
464 (unless (eq (vc-checkout-model file) 'implicit) 413 (unless (eq (vc-checkout-model file) 'implicit)
465 (if vc-cvs-use-edit 414 (if vc-cvs-use-edit
466 (vc-cvs-command nil 0 file "unedit") 415 (vc-cvs-command nil 0 file "unedit")
@@ -588,14 +537,36 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
588 (and rev2 (concat "-r" rev2)) 537 (and rev2 (concat "-r" rev2))
589 (vc-switches 'CVS 'diff)))))) 538 (vc-switches 'CVS 'diff))))))
590 539
540(defconst vc-cvs-annotate-first-line-re "^[0-9]")
541
542(defun vc-cvs-annotate-process-filter (process string)
543 (setq string (concat (process-get process 'output) string))
544 (if (not (string-match vc-cvs-annotate-first-line-re string))
545 ;; Still waiting for the first real line.
546 (process-put process 'output string)
547 (let ((vc-filter (process-get process 'vc-filter)))
548 (set-process-filter process vc-filter)
549 (funcall vc-filter process (substring string (match-beginning 0))))))
550
591(defun vc-cvs-annotate-command (file buffer &optional version) 551(defun vc-cvs-annotate-command (file buffer &optional version)
592 "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. 552 "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
593Optional arg VERSION is a version to annotate from." 553Optional arg VERSION is a version to annotate from."
594 (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))) 554 (vc-cvs-command buffer
595 (with-current-buffer buffer 555 (if (and (vc-stay-local-p file) (fboundp 'start-process))
596 (goto-char (point-min)) 556 'async 0)
597 (re-search-forward "^[0-9]") 557 file "annotate"
598 (delete-region (point-min) (1- (point))))) 558 (if version (concat "-r" version)))
559 ;; Strip the leading few lines.
560 (let ((proc (get-buffer-process buffer)))
561 (if proc
562 ;; If running asynchronously, use a process filter.
563 (progn
564 (process-put proc 'vc-filter (process-filter proc))
565 (set-process-filter proc 'vc-cvs-annotate-process-filter))
566 (with-current-buffer buffer
567 (goto-char (point-min))
568 (re-search-forward vc-cvs-annotate-first-line-re)
569 (delete-region (point-min) (1- (point)))))))
599 570
600(defun vc-cvs-annotate-current-time () 571(defun vc-cvs-annotate-current-time ()
601 "Return the current time, based at midnight of the current day, and 572 "Return the current time, based at midnight of the current day, and
@@ -960,7 +931,34 @@ is non-nil."
960 (vc-file-setprop file 'vc-checkout-time 0) 931 (vc-file-setprop file 'vc-checkout-time 0)
961 (if set-state (vc-file-setprop file 'vc-state 'edited))))))))) 932 (if set-state (vc-file-setprop file 'vc-state 'edited)))))))))
962 933
934;; Completion of revision names.
935;; Just so I don't feel like I'm duplicating code from pcl-cvs, I'll use
936;; `cvs log' so I can list all the revision numbers rather than only
937;; tag names.
938
939(defun vc-cvs-revision-table (file)
940 (let ((default-directory (file-name-directory file))
941 (res nil))
942 (with-temp-buffer
943 (vc-cvs-command t nil file "log")
944 (goto-char (point-min))
945 (when (re-search-forward "^symbolic names:\n" nil t)
946 (while (looking-at "^ \\(.*\\): \\(.*\\)")
947 (push (cons (match-string 1) (match-string 2)) res)
948 (forward-line 1)))
949 (while (re-search-forward "^revision \\([0-9.]+\\)" nil t)
950 (push (match-string 1) res))
951 res)))
952
953(defun vc-cvs-revision-completion-table (file)
954 (lexical-let ((file file)
955 table)
956 (setq table (lazy-completion-table
957 table (lambda () (vc-cvs-revision-table file))))
958 table))
959
960
963(provide 'vc-cvs) 961(provide 'vc-cvs)
964 962
965;;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432 963;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432
966;;; vc-cvs.el ends here 964;;; vc-cvs.el ends here
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 89d271431fa..9fbf4db3160 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -62,9 +62,9 @@ interpreted as hostnames."
62 :type 'regexp 62 :type 'regexp
63 :group 'vc) 63 :group 'vc)
64 64
65(defcustom vc-handled-backends '(RCS CVS SVN SCCS HG Arch MCVS) 65(defcustom vc-handled-backends '(RCS CVS BZR SVN SCCS HG Arch MCVS)
66 ;; Arch and MCVS come last because they are per-tree rather than per-dir. 66 ;; Arch and MCVS come last because they are per-tree rather than per-dir.
67 "*List of version control backends for which VC will be used. 67 "List of version control backends for which VC will be used.
68Entries in this list will be tried in order to determine whether a 68Entries in this list will be tried in order to determine whether a
69file is under that sort of version control. 69file is under that sort of version control.
70Removing an entry from the list prevents VC from being activated 70Removing an entry from the list prevents VC from being activated
@@ -78,19 +78,19 @@ An empty list disables VC altogether."
78 (if (file-directory-p "/usr/sccs") 78 (if (file-directory-p "/usr/sccs")
79 '("/usr/sccs") 79 '("/usr/sccs")
80 nil) 80 nil)
81 "*List of extra directories to search for version control commands." 81 "List of extra directories to search for version control commands."
82 :type '(repeat directory) 82 :type '(repeat directory)
83 :group 'vc) 83 :group 'vc)
84 84
85(defcustom vc-make-backup-files nil 85(defcustom vc-make-backup-files nil
86 "*If non-nil, backups of registered files are made as with other files. 86 "If non-nil, backups of registered files are made as with other files.
87If nil (the default), files covered by version control don't get backups." 87If nil (the default), files covered by version control don't get backups."
88 :type 'boolean 88 :type 'boolean
89 :group 'vc 89 :group 'vc
90 :group 'backup) 90 :group 'backup)
91 91
92(defcustom vc-follow-symlinks 'ask 92(defcustom vc-follow-symlinks 'ask
93 "*What to do if visiting a symbolic link to a file under version control. 93 "What to do if visiting a symbolic link to a file under version control.
94Editing such a file through the link bypasses the version control system, 94Editing such a file through the link bypasses the version control system,
95which is dangerous and probably not what you want. 95which is dangerous and probably not what you want.
96 96
@@ -104,26 +104,26 @@ visited and a warning displayed."
104 :group 'vc) 104 :group 'vc)
105 105
106(defcustom vc-display-status t 106(defcustom vc-display-status t
107 "*If non-nil, display revision number and lock status in modeline. 107 "If non-nil, display revision number and lock status in modeline.
108Otherwise, not displayed." 108Otherwise, not displayed."
109 :type 'boolean 109 :type 'boolean
110 :group 'vc) 110 :group 'vc)
111 111
112 112
113(defcustom vc-consult-headers t 113(defcustom vc-consult-headers t
114 "*If non-nil, identify work files by searching for version headers." 114 "If non-nil, identify work files by searching for version headers."
115 :type 'boolean 115 :type 'boolean
116 :group 'vc) 116 :group 'vc)
117 117
118(defcustom vc-keep-workfiles t 118(defcustom vc-keep-workfiles t
119 "*If non-nil, don't delete working files after registering changes. 119 "If non-nil, don't delete working files after registering changes.
120If the back-end is CVS, workfiles are always kept, regardless of the 120If the back-end is CVS, workfiles are always kept, regardless of the
121value of this flag." 121value of this flag."
122 :type 'boolean 122 :type 'boolean
123 :group 'vc) 123 :group 'vc)
124 124
125(defcustom vc-mistrust-permissions nil 125(defcustom vc-mistrust-permissions nil
126 "*If non-nil, don't assume permissions/ownership track version-control status. 126 "If non-nil, don't assume permissions/ownership track version-control status.
127If nil, do rely on the permissions. 127If nil, do rely on the permissions.
128See also variable `vc-consult-headers'." 128See also variable `vc-consult-headers'."
129 :type 'boolean 129 :type 'boolean
@@ -137,7 +137,7 @@ See also variable `vc-consult-headers'."
137 (vc-backend-subdirectory-name file))))) 137 (vc-backend-subdirectory-name file)))))
138 138
139(defcustom vc-stay-local t 139(defcustom vc-stay-local t
140 "*Non-nil means use local operations when possible for remote repositories. 140 "Non-nil means use local operations when possible for remote repositories.
141This avoids slow queries over the network and instead uses heuristics 141This avoids slow queries over the network and instead uses heuristics
142and past information to determine the current status of a file. 142and past information to determine the current status of a file.
143 143
@@ -742,17 +742,27 @@ Format:
742This function assumes that the file is registered." 742This function assumes that the file is registered."
743 (setq backend (symbol-name backend)) 743 (setq backend (symbol-name backend))
744 (let ((state (vc-state file)) 744 (let ((state (vc-state file))
745 (state-echo nil)
745 (rev (vc-workfile-version file))) 746 (rev (vc-workfile-version file)))
746 (cond ((or (eq state 'up-to-date) 747 (propertize
747 (eq state 'needs-patch)) 748 (cond ((or (eq state 'up-to-date)
748 (concat backend "-" rev)) 749 (eq state 'needs-patch))
749 ((stringp state) 750 (setq state-echo "Up to date file")
750 (concat backend ":" state ":" rev)) 751 (concat backend "-" rev))
751 (t 752 ((stringp state)
752 ;; Not just for the 'edited state, but also a fallback 753 (setq state-echo (concat "File locked by" state))
753 ;; for all other states. Think about different symbols 754 (concat backend ":" state ":" rev))
754 ;; for 'needs-patch and 'needs-merge. 755 (t
755 (concat backend ":" rev))))) 756 ;; Not just for the 'edited state, but also a fallback
757 ;; for all other states. Think about different symbols
758 ;; for 'needs-patch and 'needs-merge.
759 (setq state-echo "Edited file")
760 (concat backend ":" rev)))
761 'mouse-face 'mode-line-highlight
762 'local-map (let ((map (make-sparse-keymap)))
763 (define-key map [mode-line down-mouse-1] 'vc-menu-map) map)
764 'help-echo (concat state-echo " under the " backend
765 " version control system\nmouse-1: VC Menu"))))
756 766
757(defun vc-follow-link () 767(defun vc-follow-link ()
758 "If current buffer visits a symbolic link, visit the real file. 768 "If current buffer visits a symbolic link, visit the real file.
@@ -783,7 +793,7 @@ current, and kill the buffer that visits the link."
783 (when buffer-file-name 793 (when buffer-file-name
784 (vc-file-clearprops buffer-file-name) 794 (vc-file-clearprops buffer-file-name)
785 (cond 795 (cond
786 ((vc-backend buffer-file-name) 796 ((with-demoted-errors (vc-backend buffer-file-name))
787 ;; Compute the state and put it in the modeline. 797 ;; Compute the state and put it in the modeline.
788 (vc-mode-line buffer-file-name) 798 (vc-mode-line buffer-file-name)
789 (unless vc-make-backup-files 799 (unless vc-make-backup-files
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index a660deccba0..8da11029d93 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -149,14 +149,19 @@ You should set this to t when using a non-system shell.\n\n"))))
149 (if default-enable-multibyte-characters 149 (if default-enable-multibyte-characters
150 '(undecided-dos . undecided-unix) 150 '(undecided-dos . undecided-unix)
151 '(raw-text-dos . raw-text-unix))) 151 '(raw-text-dos . raw-text-unix)))
152 (or (w32-using-nt) 152 ;; Make cmdproxy default to using DOS line endings for input,
153 ;; On Windows 9x, make cmdproxy default to using DOS line endings 153 ;; because some Windows programs (including command.com) require it.
154 ;; for input, because command.com requires this. 154 (add-to-list 'process-coding-system-alist
155 (setq process-coding-system-alist 155 `("[cC][mM][dD][pP][rR][oO][xX][yY]"
156 `(("[cC][mM][dD][pP][rR][oO][xX][yY]" 156 . ,(if default-enable-multibyte-characters
157 . ,(if default-enable-multibyte-characters 157 '(undecided-dos . undecided-dos)
158 '(undecided-dos . undecided-dos) 158 '(raw-text-dos . raw-text-dos))))
159 '(raw-text-dos . raw-text-dos))))))) 159 ;; plink needs DOS input when entering the password.
160 (add-to-list 'process-coding-system-alist
161 `("[pP][lL][iI][nN][kK]"
162 . ,(if default-enable-multibyte-characters
163 '(undecided-dos . undecided-dos)
164 '(raw-text-dos . raw-text-dos)))))
160 165
161(add-hook 'before-init-hook 'set-default-process-coding-system) 166(add-hook 'before-init-hook 'set-default-process-coding-system)
162 167
diff --git a/lisp/window.el b/lisp/window.el
index 921d84d6e7d..216e89249c6 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -645,10 +645,7 @@ header-line."
645 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. 645 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
646 (- (max (min desired-height max-height) 646 (- (max (min desired-height max-height)
647 (or min-height window-min-height)) 647 (or min-height window-min-height))
648 window-height)) 648 window-height)))
649 ;; We do our own height checking, so avoid any restrictions due to
650 ;; window-min-height.
651 (window-min-height 1))
652 649
653 ;; Don't try to redisplay with the cursor at the end 650 ;; Don't try to redisplay with the cursor at the end
654 ;; on its own line--that would force a scroll and spoil things. 651 ;; on its own line--that would force a scroll and spoil things.
diff --git a/lispref/ChangeLog b/lispref/ChangeLog
index 5c25f0945a9..5102e723566 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,6 +1,23 @@
12007-07-14 Richard Stallman <rms@gnu.org>
2
3 * control.texi (Handling Errors): Document `debug' in handler list.
4
52007-07-10 Richard Stallman <rms@gnu.org>
6
7 * display.texi (Defining Faces): Explain C-M-x feature for defface.
8
92007-07-09 Richard Stallman <rms@gnu.org>
10
11 * files.texi (Magic File Names): Rewrite previous change.
12
132007-07-08 Michael Albinus <michael.albinus@gmx.de>
14
15 * files.texi (Magic File Names): Introduce optional parameter
16 CONNECTED for `file-remote-p'.
17
12007-07-07 Michael Albinus <michael.albinus@gmx.de> 182007-07-07 Michael Albinus <michael.albinus@gmx.de>
2 19
3 * process.texi (Asynchronous Processes): 20 * processes.texi (Asynchronous Processes):
4 * files.texi (Magic File Names): Add `start-file-process'. 21 * files.texi (Magic File Names): Add `start-file-process'.
5 22
62007-06-27 Richard Stallman <rms@gnu.org> 232007-06-27 Richard Stallman <rms@gnu.org>
diff --git a/lispref/control.texi b/lispref/control.texi
index 4c469a10368..e99a6329f3e 100644
--- a/lispref/control.texi
+++ b/lispref/control.texi
@@ -893,6 +893,12 @@ establishing an error handler, with the special form
893This deletes the file named @var{filename}, catching any error and 893This deletes the file named @var{filename}, catching any error and
894returning @code{nil} if an error occurs. 894returning @code{nil} if an error occurs.
895 895
896 The @code{condition-case} construct is often used to trap errors that
897are predictable, such as failure to open a file in a call to
898@code{insert-file-contents}. It is also used to trap errors that are
899totally unpredictable, such as when the program evaluates an expression
900read from the user.
901
896 The second argument of @code{condition-case} is called the 902 The second argument of @code{condition-case} is called the
897@dfn{protected form}. (In the example above, the protected form is a 903@dfn{protected form}. (In the example above, the protected form is a
898call to @code{delete-file}.) The error handlers go into effect when 904call to @code{delete-file}.) The error handlers go into effect when
@@ -920,15 +926,33 @@ the two gets to handle it.
920 If an error is handled by some @code{condition-case} form, this 926 If an error is handled by some @code{condition-case} form, this
921ordinarily prevents the debugger from being run, even if 927ordinarily prevents the debugger from being run, even if
922@code{debug-on-error} says this error should invoke the debugger. 928@code{debug-on-error} says this error should invoke the debugger.
923@xref{Error Debugging}. If you want to be able to debug errors that are
924caught by a @code{condition-case}, set the variable
925@code{debug-on-signal} to a non-@code{nil} value.
926 929
927 When an error is handled, control returns to the handler. Before this 930 If you want to be able to debug errors that are caught by a
928happens, Emacs unbinds all variable bindings made by binding constructs 931@code{condition-case}, set the variable @code{debug-on-signal} to a
929that are being exited and executes the cleanups of all 932non-@code{nil} value. You can also specify that a particular handler
930@code{unwind-protect} forms that are exited. Once control arrives at 933should let the debugger run first, by writing @code{debug} among the
931the handler, the body of the handler is executed. 934conditions, like this:
935
936@example
937@group
938(condition-case nil
939 (delete-file filename)
940 ((debug error) nil))
941@end group
942@end example
943
944@noindent
945The effect of @code{debug} here is only to prevent
946@code{condition-case} from suppressing the call to the debugger. Any
947given error will invoke the debugger only if @code{debug-on-error} and
948the other usual filtering mechanisms say it should. @xref{Error Debugging}.
949
950 Once Emacs decides that a certain handler handles the error, it
951returns control to that handler. To do so, Emacs unbinds all variable
952bindings made by binding constructs that are being exited, and
953executes the cleanups of all @code{unwind-protect} forms that are
954being exited. Once control arrives at the handler, the body of the
955handler executes normally.
932 956
933 After execution of the handler body, execution returns from the 957 After execution of the handler body, execution returns from the
934@code{condition-case} form. Because the protected form is exited 958@code{condition-case} form. Because the protected form is exited
@@ -937,12 +961,6 @@ execution at the point of the error, nor can it examine variable
937bindings that were made within the protected form. All it can do is 961bindings that were made within the protected form. All it can do is
938clean up and proceed. 962clean up and proceed.
939 963
940 The @code{condition-case} construct is often used to trap errors that
941are predictable, such as failure to open a file in a call to
942@code{insert-file-contents}. It is also used to trap errors that are
943totally unpredictable, such as when the program evaluates an expression
944read from the user.
945
946 Error signaling and handling have some resemblance to @code{throw} and 964 Error signaling and handling have some resemblance to @code{throw} and
947@code{catch} (@pxref{Catch and Throw}), but they are entirely separate 965@code{catch} (@pxref{Catch and Throw}), but they are entirely separate
948facilities. An error cannot be caught by a @code{catch}, and a 966facilities. An error cannot be caught by a @code{catch}, and a
@@ -960,7 +978,8 @@ error occurs during @var{protected-form}.
960 978
961Each of the @var{handlers} is a list of the form @code{(@var{conditions} 979Each of the @var{handlers} is a list of the form @code{(@var{conditions}
962@var{body}@dots{})}. Here @var{conditions} is an error condition name 980@var{body}@dots{})}. Here @var{conditions} is an error condition name
963to be handled, or a list of condition names; @var{body} is one or more 981to be handled, or a list of condition names (which can include @code{debug}
982to allow the debugger to run before the handler); @var{body} is one or more
964Lisp expressions to be executed when this handler handles an error. 983Lisp expressions to be executed when this handler handles an error.
965Here are examples of handlers: 984Here are examples of handlers:
966 985
diff --git a/lispref/display.texi b/lispref/display.texi
index 664ad1d2c15..f4d7a5dbcdb 100644
--- a/lispref/display.texi
+++ b/lispref/display.texi
@@ -1760,6 +1760,11 @@ When @code{defface} executes, it defines the face according to
1760@var{spec}, then uses any customizations that were read from the 1760@var{spec}, then uses any customizations that were read from the
1761init file (@pxref{Init File}) to override that specification. 1761init file (@pxref{Init File}) to override that specification.
1762 1762
1763When you evaluate a @code{defcustom} form with @kbd{C-M-x} in Emacs
1764Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
1765overrides any customizations of the face. This way, the face reflects
1766exactly what the @code{defcustom} says.
1767
1763The purpose of @var{spec} is to specify how the face should appear on 1768The purpose of @var{spec} is to specify how the face should appear on
1764different kinds of terminals. It should be an alist whose elements 1769different kinds of terminals. It should be an alist whose elements
1765have the form @code{(@var{display} @var{atts})}. Each element's 1770have the form @code{(@var{display} @var{atts})}. Each element's
diff --git a/lispref/files.texi b/lispref/files.texi
index 5af77fafc31..343a6bc5e39 100644
--- a/lispref/files.texi
+++ b/lispref/files.texi
@@ -2768,7 +2768,7 @@ nothing and returns @code{nil}. Otherwise it returns the file name
2768of the local copy file. 2768of the local copy file.
2769@end defun 2769@end defun
2770 2770
2771@defun file-remote-p filename 2771@defun file-remote-p filename &optional connected
2772This function tests whether @var{filename} is a remote file. If 2772This function tests whether @var{filename} is a remote file. If
2773@var{filename} is local (not remote), the return value is @code{nil}. 2773@var{filename} is local (not remote), the return value is @code{nil}.
2774If @var{filename} is indeed remote, the return value is a string that 2774If @var{filename} is indeed remote, the return value is a string that
@@ -2777,7 +2777,7 @@ identifies the remote system.
2777This identifier string can include a host name and a user name, as 2777This identifier string can include a host name and a user name, as
2778well as characters designating the method used to access the remote 2778well as characters designating the method used to access the remote
2779system. For example, the remote identifier string for the filename 2779system. For example, the remote identifier string for the filename
2780@code{/ssh:user@@host:/some/file} is @code{/ssh:user@@host:}. 2780@code{/sudo::/some/file} is @code{/sudo:root@@localhost:}.
2781 2781
2782If @code{file-remote-p} returns the same identifier for two different 2782If @code{file-remote-p} returns the same identifier for two different
2783filenames, that means they are stored on the same file system and can 2783filenames, that means they are stored on the same file system and can
@@ -2785,6 +2785,11 @@ be accessed locally with respect to each other. This means, for
2785example, that it is possible to start a remote process accessing both 2785example, that it is possible to start a remote process accessing both
2786files at the same time. Implementors of file handlers need to ensure 2786files at the same time. Implementors of file handlers need to ensure
2787this principle is valid. 2787this principle is valid.
2788
2789If @var{connected} is non-@code{nil}, this function returns @code{nil}
2790even if @var{filename} is remote, if Emacs has no network connection
2791to its host. This is useful when you want to avoid the delay of
2792making connections when they don't exist.
2788@end defun 2793@end defun
2789 2794
2790@defun unhandled-file-name-directory filename 2795@defun unhandled-file-name-directory filename
diff --git a/man/ChangeLog b/man/ChangeLog
index ad2d3b889f2..ad39b9fce15 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,7 +1,52 @@
12007-07-13 Eli Zaretskii <eliz@gnu.org>
2
3 * Makefile.in (../info/emacs-mime): Use --enable-encoding.
4
5 * makefile.w32-in ($(infodir)/emacs-mime): Ditto.
6
7 * emacs-mime.texi: Add @documentencoding directive.
8
92007-07-12 Nick Roberts <nickrob@snap.net.nz>
10
11 * tramp.texi (Remote processes): Add an anchor to the subsection
12 "Running a debugger on a remote host".
13
14 * building.texi (Starting GUD): Add xref to this anchor.
15
162007-07-12 Michael Albinus <michael.albinus@gmx.de>
17
18 * tramp.texi (Remote processes): Don't call it "experimental" any
19 longer. Add subsection about running a debugger on a remote host.
20
212007-07-10 Carsten Dominik <dominik@science.uva.nl>
22
23 * org.texi (Properties and columns): Chapter rewritten.
24
252007-07-08 Michael Albinus <michael.albinus@gmx.de>
26
27 * tramp.texi:
28 * trampver.texi: Migrate to Tramp 2.1.
29
12007-07-02 Carsten Dominik <dominik@science.uva.nl> 302007-07-02 Carsten Dominik <dominik@science.uva.nl>
2 31
3 * org.texi (Properties): New chapter. 32 * org.texi (Properties): New chapter.
4 33
342007-07-02 Reiner Steib <Reiner.Steib@gmx.de>
35
36 * gnus-faq.texi ([3.2]): Fix locating of environment variables in the
37 Control Panel.
38
39 * gnus.texi (Misc Article): Add index entry for
40 gnus-single-article-buffer.
41
422007-06-27 Andreas Seltenreich <andreas@gate450.dyndns.org>
43
44 * gnus.texi (Starting Up): Fix typo.
45
462007-06-25 Katsumi Yamaoka <yamaoka@jpl.org>
47
48 * gnus.texi (Asynchronous Fetching): Fix typo.
49
52007-06-24 Karl Berry <karl@gnu.org> 502007-06-24 Karl Berry <karl@gnu.org>
6 51
7 * emacs.texi: new Back-Cover Text. 52 * emacs.texi: new Back-Cover Text.
diff --git a/man/Makefile.in b/man/Makefile.in
index 9810bf27fa5..94ace126537 100644
--- a/man/Makefile.in
+++ b/man/Makefile.in
@@ -217,7 +217,7 @@ sieve.dvi: sieve.texi
217 $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi 217 $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi
218 218
219../info/emacs-mime: emacs-mime.texi 219../info/emacs-mime: emacs-mime.texi
220 cd $(srcdir); $(MAKEINFO) emacs-mime.texi 220 cd $(srcdir); $(MAKEINFO) --enable-encoding emacs-mime.texi
221emacs-mime.dvi: emacs-mime.texi 221emacs-mime.dvi: emacs-mime.texi
222 $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi 222 $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi
223 223
diff --git a/man/building.texi b/man/building.texi
index 402b433204e..82ee57e8592 100644
--- a/man/building.texi
+++ b/man/building.texi
@@ -527,6 +527,10 @@ debugger supports. However, shell wildcards and variables are not
527allowed. GUD assumes that the first argument not starting with a 527allowed. GUD assumes that the first argument not starting with a
528@samp{-} is the executable file name. 528@samp{-} is the executable file name.
529 529
530Tramp provides a facility to debug programs on remote hosts.
531@xref{Running a debugger on a remote host, Running a debugger on a remote host,, tramp, The Tramp Manual}.
532@c Running a debugger on a remote host
533
530@node Debugger Operation 534@node Debugger Operation
531@subsection Debugger Operation 535@subsection Debugger Operation
532 536
diff --git a/man/emacs-mime.texi b/man/emacs-mime.texi
index 56f130b67fb..0f3c141c792 100644
--- a/man/emacs-mime.texi
+++ b/man/emacs-mime.texi
@@ -32,6 +32,9 @@ license to the document, as described in section 6 of the license.
32@end quotation 32@end quotation
33@end copying 33@end copying
34 34
35@c Node ``Interface Functions'' uses Latin-1 characters
36@documentencoding ISO-8859-1
37
35@dircategory Emacs 38@dircategory Emacs
36@direntry 39@direntry
37* Emacs MIME: (emacs-mime). Emacs MIME de/composition library. 40* Emacs MIME: (emacs-mime). Emacs MIME de/composition library.
diff --git a/man/gnus-faq.texi b/man/gnus-faq.texi
index 093cb4c289b..6bfb3477627 100644
--- a/man/gnus-faq.texi
+++ b/man/gnus-faq.texi
@@ -427,12 +427,11 @@ SET HOME=C:\myhome
427@end example 427@end example
428@noindent 428@noindent
429 429
430in your autoexec.bat and reboot. Under NT, 2000 and XP, 430in your autoexec.bat and reboot. Under NT, 2000 and XP, hit
431hit Winkey+Pause/Break to enter system options (if it 431Winkey+Pause/Break to enter system options (if it doesn't work, go to
432doesn't work, go to Control Panel -> System). There you'll 432Control Panel -> System -> Advanced). There you'll find the possibility
433find the possibility to set environment variables, create 433to set environment variables. Create a new one with name HOME and value
434a new one with name HOME and value C:\myhome, a reboot is 434C:\myhome. Rebooting is not necessary.
435not necessary.
436 435
437Now to create ~/.gnus.el, say 436Now to create ~/.gnus.el, say
438@samp{C-x C-f ~/.gnus.el RET C-x C-s}. 437@samp{C-x C-f ~/.gnus.el RET C-x C-s}.
diff --git a/man/gnus.texi b/man/gnus.texi
index 85167d53432..fe26aa5f662 100644
--- a/man/gnus.texi
+++ b/man/gnus.texi
@@ -947,8 +947,8 @@ Emacs for Heathens
947@chapter Starting Gnus 947@chapter Starting Gnus
948@cindex starting up 948@cindex starting up
949 949
950If you are haven't used Emacs much before using Gnus, read @ref{Emacs 950If you haven't used Emacs much before using Gnus, read @ref{Emacs for
951for Heathens} first. 951Heathens} first.
952 952
953@kindex M-x gnus 953@kindex M-x gnus
954@findex gnus 954@findex gnus
@@ -7173,12 +7173,12 @@ pre-fetch all the articles it can without bound. If it is
7173@code{nil}, no pre-fetching will be done. 7173@code{nil}, no pre-fetching will be done.
7174 7174
7175@vindex gnus-async-prefetch-article-p 7175@vindex gnus-async-prefetch-article-p
7176@findex gnus-async-read-p 7176@findex gnus-async-unread-p
7177There are probably some articles that you don't want to pre-fetch---read 7177There are probably some articles that you don't want to pre-fetch---read
7178articles, for instance. The @code{gnus-async-prefetch-article-p} 7178articles, for instance. The @code{gnus-async-prefetch-article-p}
7179variable controls whether an article is to be pre-fetched. This 7179variable controls whether an article is to be pre-fetched. This
7180function should return non-@code{nil} when the article in question is 7180function should return non-@code{nil} when the article in question is
7181to be pre-fetched. The default is @code{gnus-async-read-p}, which 7181to be pre-fetched. The default is @code{gnus-async-unread-p}, which
7182returns @code{nil} on read articles. The function is called with an 7182returns @code{nil} on read articles. The function is called with an
7183article data structure as the only parameter. 7183article data structure as the only parameter.
7184 7184
@@ -11504,6 +11504,7 @@ region.
11504 11504
11505@item gnus-single-article-buffer 11505@item gnus-single-article-buffer
11506@vindex gnus-single-article-buffer 11506@vindex gnus-single-article-buffer
11507@cindex article buffers, several
11507If non-@code{nil}, use the same article buffer for all the groups. 11508If non-@code{nil}, use the same article buffer for all the groups.
11508(This is the default.) If @code{nil}, each group will have its own 11509(This is the default.) If @code{nil}, each group will have its own
11509article buffer. 11510article buffer.
@@ -13509,14 +13510,18 @@ Header lines longer than the value of
13509@code{nnmail-split-header-length-limit} are excluded from the split 13510@code{nnmail-split-header-length-limit} are excluded from the split
13510function. 13511function.
13511 13512
13512@vindex nnmail-mail-splitting-charset
13513@vindex nnmail-mail-splitting-decodes 13513@vindex nnmail-mail-splitting-decodes
13514By default, splitting @acronym{MIME}-decodes headers so you 13514@vindex nnmail-mail-splitting-charset
13515can match on non-@acronym{ASCII} strings. The 13515By default, splitting does not decode headers, so you can not match on
13516@code{nnmail-mail-splitting-charset} variable specifies the default 13516non-@acronym{ASCII} strings. But it is useful if you want to match
13517charset for decoding. The behavior can be turned off completely by 13517articles based on the raw header data. To enable it, set the
13518binding @code{nnmail-mail-splitting-decodes} to @code{nil}, which is 13518@code{nnmail-mail-splitting-decodes} variable to a non-@code{nil} value.
13519useful if you want to match articles based on the raw header data. 13519In addition, the value of the @code{nnmail-mail-splitting-charset}
13520variable is used for decoding non-@acronym{MIME} encoded string when
13521@code{nnmail-mail-splitting-decodes} is non-@code{nil}. The default
13522value is @code{nil} which means not to decode non-@acronym{MIME} encoded
13523string. A suitable value for you will be @code{undecided} or be the
13524charset used normally in mails you are interested in.
13520 13525
13521@vindex nnmail-resplit-incoming 13526@vindex nnmail-resplit-incoming
13522By default, splitting is performed on all incoming messages. If you 13527By default, splitting is performed on all incoming messages. If you
diff --git a/man/makefile.w32-in b/man/makefile.w32-in
index 0112040ee51..2e559a62906 100644
--- a/man/makefile.w32-in
+++ b/man/makefile.w32-in
@@ -217,7 +217,7 @@ message.dvi: message.texi
217 $(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi 217 $(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi
218# 218#
219$(infodir)/emacs-mime: emacs-mime.texi 219$(infodir)/emacs-mime: emacs-mime.texi
220 $(MAKEINFO) emacs-mime.texi 220 $(MAKEINFO) --enable-encoding emacs-mime.texi
221emacs-mime.dvi: emacs-mime.texi 221emacs-mime.dvi: emacs-mime.texi
222 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi 222 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi
223# 223#
diff --git a/man/org.texi b/man/org.texi
index c82df74148b..6be2a165ff4 100644
--- a/man/org.texi
+++ b/man/org.texi
@@ -3,7 +3,7 @@
3@setfilename ../info/org 3@setfilename ../info/org
4@settitle Org Mode Manual 4@settitle Org Mode Manual
5 5
6@set VERSION 5.01 6@set VERSION 5.03
7@set DATE July 2007 7@set DATE July 2007
8 8
9@dircategory Emacs 9@dircategory Emacs
@@ -81,7 +81,7 @@ Software Foundation raise funds for GNU development.''
81* Hyperlinks:: Notes in context 81* Hyperlinks:: Notes in context
82* TODO items:: Every tree branch can be a TODO item 82* TODO items:: Every tree branch can be a TODO item
83* Tags:: Tagging headlines and matching sets of tags 83* Tags:: Tagging headlines and matching sets of tags
84* Properties:: 84* Properties and columns::
85* Timestamps:: Assign date and time to items 85* Timestamps:: Assign date and time to items
86* Agenda views:: Collecting information into views 86* Agenda views:: Collecting information into views
87* Embedded LaTeX:: LaTeX fragments and formulas 87* Embedded LaTeX:: LaTeX fragments and formulas
@@ -113,7 +113,8 @@ Document Structure
113* Archiving:: Move done task trees to a different place 113* Archiving:: Move done task trees to a different place
114* Sparse trees:: Matches embedded in context 114* Sparse trees:: Matches embedded in context
115* Plain lists:: Additional structure within an entry 115* Plain lists:: Additional structure within an entry
116* Drawers:: 116* Drawers:: Tucking stuff away
117* orgstruct-mode:: Structure editing outside Org-mode
117 118
118Archiving 119Archiving
119 120
@@ -181,7 +182,7 @@ Tags
181* Setting tags:: How to assign tags to a headline 182* Setting tags:: How to assign tags to a headline
182* Tag searches:: Searching for combinations of tags 183* Tag searches:: Searching for combinations of tags
183 184
184Properties 185Properties and Columns
185 186
186* Property syntax:: How properties are spelled out 187* Property syntax:: How properties are spelled out
187* Special properties:: Access to other Org-mode features 188* Special properties:: Access to other Org-mode features
@@ -194,6 +195,11 @@ Column View
194* Defining columns:: The COLUMNS format property 195* Defining columns:: The COLUMNS format property
195* Using column view:: How to create and use column view 196* Using column view:: How to create and use column view
196 197
198Defining Columns
199
200* Scope of column definitions::
201* Column attributes::
202
197Timestamps 203Timestamps
198 204
199* Time stamps:: Assigning a time to a tree entry 205* Time stamps:: Assigning a time to a tree entry
@@ -379,7 +385,7 @@ tags etc are created dynamically when you need them.
379Org-mode keeps simple things simple. When first fired up, it should 385Org-mode keeps simple things simple. When first fired up, it should
380feel like a straightforward, easy to use outliner. Complexity is not 386feel like a straightforward, easy to use outliner. Complexity is not
381imposed, but a large amount of functionality is available when you need 387imposed, but a large amount of functionality is available when you need
382it. Org-mode can be used on different levels and in different ways, for 388it. Org-mode is a toolbox and can be used in different ways, for
383example as: 389example as:
384 390
385@example 391@example
@@ -389,6 +395,7 @@ example as:
389@r{@bullet{} TODO list editor} 395@r{@bullet{} TODO list editor}
390@r{@bullet{} full agenda and planner with deadlines and work scheduling} 396@r{@bullet{} full agenda and planner with deadlines and work scheduling}
391@r{@bullet{} environment to implement David Allen's GTD system} 397@r{@bullet{} environment to implement David Allen's GTD system}
398@r{@bullet{} a basic database application}
392@r{@bullet{} simple hypertext system, with HTML export} 399@r{@bullet{} simple hypertext system, with HTML export}
393@r{@bullet{} publishing tool to create a set of interlinked webpages} 400@r{@bullet{} publishing tool to create a set of interlinked webpages}
394@end example 401@end example
@@ -396,7 +403,9 @@ example as:
396Org-mode's automatic, context sensitive table editor with spreadsheet 403Org-mode's automatic, context sensitive table editor with spreadsheet
397capabilities can be integrated into any major mode by activating the 404capabilities can be integrated into any major mode by activating the
398minor Orgtbl-mode. Using a translation step, it can be used to maintain 405minor Orgtbl-mode. Using a translation step, it can be used to maintain
399tables in arbitrary file types, for example in LaTeX. 406tables in arbitrary file types, for example in LaTeX. The structure
407editing and list creation capabilities can be used outside Org-mode with
408the minor Orgstruct-mode.
400 409
401@cindex FAQ 410@cindex FAQ
402There is a website for Org-mode which provides links to the newest 411There is a website for Org-mode which provides links to the newest
@@ -468,9 +477,10 @@ make install-info
468 477
469@iftex 478@iftex
470@b{Important:} @i{If you use copy-and-paste to copy lisp code from the 479@b{Important:} @i{If you use copy-and-paste to copy lisp code from the
471PDF documentation to your .emacs file, the single quote character comes 480PDF documentation as viewed by Acrobat reader to your .emacs file, the
472out incorrectly and the code will not work. You need to fix the single 481single quote character comes out incorrectly and the code will not work.
473quotes by hand, or copy from Info documentation.} 482You need to fix the single quotes by hand, or copy from Info
483documentation.}
474@end iftex 484@end iftex
475 485
476Add the following lines to your @file{.emacs} file. The last two lines 486Add the following lines to your @file{.emacs} file. The last two lines
@@ -580,7 +590,8 @@ edit the structure of the document.
580* Archiving:: Move done task trees to a different place 590* Archiving:: Move done task trees to a different place
581* Sparse trees:: Matches embedded in context 591* Sparse trees:: Matches embedded in context
582* Plain lists:: Additional structure within an entry 592* Plain lists:: Additional structure within an entry
583* Drawers:: 593* Drawers:: Tucking stuff away
594* orgstruct-mode:: Structure editing outside Org-mode
584@end menu 595@end menu
585 596
586@node Outlines, Headlines, Document structure, Document structure 597@node Outlines, Headlines, Document structure, Document structure
@@ -605,8 +616,8 @@ key.
605 616
606Headlines define the structure of an outline tree. The headlines in 617Headlines define the structure of an outline tree. The headlines in
607Org-mode start with one or more stars, on the left margin@footnote{See 618Org-mode start with one or more stars, on the left margin@footnote{See
608the variable @code{org-special-ctrl-a} to configure special behavior of 619the variable @code{org-special-ctrl-a/e} to configure special behavior
609@kbd{C-a} in headlines.}. For example: 620of @kbd{C-a} and @kbd{C-e} in headlines.}. For example:
610 621
611@example 622@example
612* Top level headline 623* Top level headline
@@ -1121,14 +1132,15 @@ bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}).
1121With prefix arg, select the nth bullet from this list. 1132With prefix arg, select the nth bullet from this list.
1122@end table 1133@end table
1123 1134
1124@node Drawers, , Plain lists, Document structure 1135@node Drawers, orgstruct-mode, Plain lists, Document structure
1125@section Drawers 1136@section Drawers
1126@cindex drawers 1137@cindex drawers
1138@cindex visibility cycling, drawers
1127 1139
1128Sometimes you want to keep information associated with an entry, but you 1140Sometimes you want to keep information associated with an entry, but you
1129normally don't want to see it, except when explicitly asking for it. 1141normally don't want to see it. For this, Org-mode has @emph{drawers}.
1130For this, Org-mode has @emph{drawers}. Drawers need to be configured 1142Drawers need to be configured with the variable @code{org-drawers}, and
1131with the variable @code{org-drawers}, and look like this: 1143look like this:
1132 1144
1133@example 1145@example
1134** This is a headline 1146** This is a headline
@@ -1143,7 +1155,30 @@ Visibility cycling (@pxref{Visibility cycling}) on the headline will
1143hide and show the entry, but keep the drawer collapsed to a single line. 1155hide and show the entry, but keep the drawer collapsed to a single line.
1144In order to look inside the drawer, you need to move the cursor to the 1156In order to look inside the drawer, you need to move the cursor to the
1145drawer line and press @key{TAB} there. Org-mode uses a drawer for 1157drawer line and press @key{TAB} there. Org-mode uses a drawer for
1146storing properties (@pxref{Properties}). 1158storing properties (@pxref{Properties and columns}).
1159
1160@node orgstruct-mode, , Drawers, Document structure
1161@section The Orgstruct minor mode
1162@cindex orgstruct-mode
1163@cindex minor mode for structure editing
1164
1165If you like the intuitive way the Org-mode structure editing and list
1166formatting works, you might want to use these commands in other modes
1167like text-mode or mail-mode as well. The minor mode Orgstruct-mode
1168makes this possible. You can always toggle the mode with @kbd{M-x
1169orgstruct-mode}. To turn it on by default, for example in mail mode,
1170use
1171
1172@lisp
1173(add-hook 'mail-mode-hook 'turn-on-orgstruct)
1174@end lisp
1175
1176When this mode is active and the cursor is on a line that looks to
1177Org-mode like a headline of the first line of a list item, most
1178structure editing commands will work, even if the same keys normally
1179have different functionality in the major mode you are using. If the
1180cursor is not in one of those special lines, Orgstruct-mode lurks
1181silently in the shadow.
1147 1182
1148@node Tables, Hyperlinks, Document structure, Top 1183@node Tables, Hyperlinks, Document structure, Top
1149@chapter Tables 1184@chapter Tables
@@ -1611,15 +1646,15 @@ line like
1611@end example 1646@end example
1612 1647
1613@noindent 1648@noindent
1614Also properties (@pxref{Properties}) can be used as constants in table 1649Also properties (@pxref{Properties and columns}) can be used as
1615formulas: For a property @samp{:XYZ:} use the name @samp{$PROP_XYZ}, and 1650constants in table formulas: For a property @samp{:XYZ:} use the name
1616the property will be searched in the current outline entry and in the 1651@samp{$PROP_XYZ}, and the property will be searched in the current
1617hierarchy above it. If you have the @file{constants.el} package, it 1652outline entry and in the hierarchy above it. If you have the
1618will also be used to resolve constants, including natural constants like 1653@file{constants.el} package, it will also be used to resolve constants,
1619@samp{$h} for Planck's constant, and units like @samp{$km} for 1654including natural constants like @samp{$h} for Planck's constant, and
1620kilometers@footnote{@file{Constant.el} can supply the values of 1655units like @samp{$km} for kilometers@footnote{@file{Constant.el} can
1621constants in two different unit systems, @code{SI} and @code{cgs}. 1656supply the values of constants in two different unit systems, @code{SI}
1622Which one is used depends on the value of the variable 1657and @code{cgs}. Which one is used depends on the value of the variable
1623@code{constants-unit-system}. You can use the @code{#+STARTUP} options 1658@code{constants-unit-system}. You can use the @code{#+STARTUP} options
1624@code{constSI} and @code{constcgs} to set this value for the current 1659@code{constSI} and @code{constcgs} to set this value for the current
1625buffer.}. Column names and parameters can be specified in special table 1660buffer.}. Column names and parameters can be specified in special table
@@ -2998,7 +3033,8 @@ percentage of checkboxes checked (in the above example, this would be
2998@table @kbd 3033@table @kbd
2999@kindex C-c C-c 3034@kindex C-c C-c
3000@item C-c C-c 3035@item C-c C-c
3001Toggle checkbox at point. 3036Toggle checkbox at point. With prefix argument, set it to @samp{[-]},
3037which is considered to be an intermediate state.
3002@kindex C-c C-x C-b 3038@kindex C-c C-x C-b
3003@item C-c C-x C-b 3039@item C-c C-x C-b
3004Toggle checkbox at point. 3040Toggle checkbox at point.
@@ -3030,7 +3066,7 @@ back into synch. Or simply toggle any checkbox twice with @kbd{C-c C-c}.
3030@end table 3066@end table
3031 3067
3032 3068
3033@node Tags, Properties, TODO items, Top 3069@node Tags, Properties and columns, TODO items, Top
3034@chapter Tags 3070@chapter Tags
3035@cindex tags 3071@cindex tags
3036@cindex headline tagging 3072@cindex headline tagging
@@ -3286,8 +3322,8 @@ instead of any TAG an expression like @samp{LEVEL=3}. For example, a
3286search @samp{+LEVEL=3+BOSS/-DONE} lists all level three headlines that 3322search @samp{+LEVEL=3+BOSS/-DONE} lists all level three headlines that
3287have the tag BOSS and are @emph{not} marked with the todo keyword DONE. 3323have the tag BOSS and are @emph{not} marked with the todo keyword DONE.
3288 3324
3289@node Properties, Timestamps, Tags, Top 3325@node Properties and columns, Timestamps, Tags, Top
3290@chapter Properties 3326@chapter Properties and Columns
3291@cindex properties 3327@cindex properties
3292 3328
3293Properties are a set of key-value pairs associated with an entry. There 3329Properties are a set of key-value pairs associated with an entry. There
@@ -3298,7 +3334,8 @@ tags like @code{:release_1:}, @code{:release_2:}, it can be more
3298efficient to use a property @code{RELEASE} with a value @code{1.0} or 3334efficient to use a property @code{RELEASE} with a value @code{1.0} or
3299@code{2.0}. Second, you can use properties to implement (very basic) 3335@code{2.0}. Second, you can use properties to implement (very basic)
3300database capabilities in an Org-mode buffer, for example to create a 3336database capabilities in an Org-mode buffer, for example to create a
3301list of Music CD's you own. 3337list of Music CD's you own. You can edit and view properties
3338conveniently in column view (@pxref{Column view}).
3302 3339
3303@menu 3340@menu
3304* Property syntax:: How properties are spelled out 3341* Property syntax:: How properties are spelled out
@@ -3308,8 +3345,10 @@ list of Music CD's you own.
3308* Property API:: Properties for Lisp programmers 3345* Property API:: Properties for Lisp programmers
3309@end menu 3346@end menu
3310 3347
3311@node Property syntax, Special properties, Properties, Properties 3348@node Property syntax, Special properties, Properties and columns, Properties and columns
3312@section Property Syntax 3349@section Property Syntax
3350@cindex property syntax
3351@cindex drawer, for properties
3313 3352
3314Properties are key-value pairs. They need to be inserted into a special 3353Properties are key-value pairs. They need to be inserted into a special
3315drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property 3354drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property
@@ -3324,26 +3363,65 @@ first, and the value after it. Here is an example:
3324 :Title: Goldberg Variations 3363 :Title: Goldberg Variations
3325 :Composer: J.S. Bach 3364 :Composer: J.S. Bach
3326 :Artist: Glen Gould 3365 :Artist: Glen Gould
3327 :END: 3366 :Publisher: Deutsche Grammphon
3367 :NDisks: 1
3368 :END:
3369@end example
3370
3371You may define the allowed values for a particular property @samp{XYZ}
3372by setting a property @samp{XYZ_ALL}. This special property is
3373@emph{inherited}, so if you set it in a level 1 entry, it will apply to
3374the entire tree. When allowed values are defined, setting the
3375corresponding property becomes easier and is less prone to typing
3376errors. For the example with the CD collection, we can predefine
3377publishers and the number of disks in a box like this:
3378
3379@example
3380* CD collection
3381 :PROPERTIES:
3382 :NDisks_ALL: 1 2 3 4
3383 :Publisher_ALL: "Deutsche Grammophon" Phillips EMI
3384 :END:
3328@end example 3385@end example
3329 3386
3330@noindent 3387@noindent
3331The following commands help to insert properties: 3388The following commands help to work with properties:
3332 3389
3333@table @kbd 3390@table @kbd
3334@kindex M-@key{TAB} 3391@kindex M-@key{TAB}
3335@item M-@key{TAB} 3392@item M-@key{TAB}
3336After an initial colon in a line, complete property keys. All keys used 3393After an initial colon in a line, complete property keys. All keys used
3337in the current file will be offered as possible completions. 3394in the current file will be offered as possible completions.
3395@item M-x org-insert-property-drawer
3396Insert a property drawer into the current entry. The drawer will be
3397inserted early in the entry, but after the lines with planning
3398information like deadlines.
3399@kindex C-c C-c
3400@item C-c C-c
3401With the cursor in a property drawer, this executes property commands.
3402@item C-c C-c s
3403Set a property in the current entry. Both the property and the value
3404can be inserted using completion.
3405@kindex S-@key{right}
3406@kindex S-@key{left}
3407@item S-@key{left}/@key{right}
3408Switch property at point to the next/previous allowed value.
3409@item C-c C-c d
3410Remove a property from the current entry.
3411@item C-c C-c D
3412Globally remove a property, from all entries in the current file.
3338@end table 3413@end table
3339 3414
3340 3415@node Special properties, Property searches, Property syntax, Properties and columns
3341
3342@node Special properties, Property searches, Property syntax, Properties
3343@section Special Properties 3416@section Special Properties
3417@cindex properties, special
3344 3418
3345Several properties are special, because they can be used to access other 3419Special properties provide alternative access method to Org-mode
3346features of Org-mode like the TODO status: 3420features discussed in the previous chapters, like the TODO state or the
3421priority of an entry. This interface exists so that you can include
3422these states into columns view (@pxref{Column view}). The following
3423property names are special and should not be used as keys in the
3424properties drawer:
3347 3425
3348@example 3426@example
3349TODO @r{The TODO keyword of the entry.} 3427TODO @r{The TODO keyword of the entry.}
@@ -3354,8 +3432,9 @@ DEADLINE @r{The deadline time string, without the angular brackets.}
3354SCHEDULED @r{The scheduling time stamp, without the angular brackets.} 3432SCHEDULED @r{The scheduling time stamp, without the angular brackets.}
3355@end example 3433@end example
3356 3434
3357@node Property searches, Column view, Special properties, Properties 3435@node Property searches, Column view, Special properties, Properties and columns
3358@section Property searches 3436@section Property searches
3437@cindex properties, searching
3359 3438
3360To create sparse trees and special lists with selection based on 3439To create sparse trees and special lists with selection based on
3361properties, the same commands are used as for tag searches (@pxref{Tag 3440properties, the same commands are used as for tag searches (@pxref{Tag
@@ -3371,23 +3450,22 @@ also have a priority value @samp{A}, a @samp{:coffee:} property with the
3371value @samp{unlimited}, and a @samp{:with:} property that is matched by 3450value @samp{unlimited}, and a @samp{:with:} property that is matched by
3372the regular expression @samp{Sarah\|Denny}. 3451the regular expression @samp{Sarah\|Denny}.
3373 3452
3374@node Column view, Property API, Property searches, Properties 3453@node Column view, Property API, Property searches, Properties and columns
3375@section Column View 3454@section Column View
3376 3455
3377If different items in a document have similar properties, it can be nice 3456A great way to view and edit properties in an outline tree is
3378to view and edit those properties in a table-like format, in 3457@emph{column view}. In column view, each outline item is turned into a
3379@emph{column view}. Org-mode implements columns by overlaying a tabular 3458table row. Columns in this table provide access to properties of the
3380structure over the headline of an item. So the column view does not use 3459entries. Org-mode implements columns by overlaying a tabular structure
3381a special buffer, it happens in exactly the same buffer where the 3460over the headline of each item. While the headlines have been turned
3382outline is, and only temporarily changes the look of this buffer - not 3461into a table row, you can still change the visibility of the outline
3383the content. This has the advantage that you can still change the 3462tree. For example, you get a compact table by switching to CONTENTS
3384visibility of the outline tree. For example, you get a compact table by 3463view (@kbd{S-@key{TAB} S-@key{TAB}}, or simply @kbd{c} while column view
3385switching to CONTENTS view, but you can still open, read, and edit the 3464is active), but you can still open, read, and edit the entry below each
3386entry below each headline. Or, you can switch to column view after 3465headline. Or, you can switch to column view after executing a sparse
3387executing a sparse tree command and in this way get a table only for the 3466tree command and in this way get a table only for the selected items.
3388selected items. Column view also works in agenda buffers (@pxref{Agenda 3467Column view also works in agenda buffers (@pxref{Agenda views}) where
3389views}) where queries have collected selected items, possibly from a 3468queries have collected selected items, possibly from a number of files.
3390number of files.
3391 3469
3392@menu 3470@menu
3393* Defining columns:: The COLUMNS format property 3471* Defining columns:: The COLUMNS format property
@@ -3396,81 +3474,122 @@ number of files.
3396 3474
3397@node Defining columns, Using column view, Column view, Column view 3475@node Defining columns, Using column view, Column view, Column view
3398@subsection Defining Columns 3476@subsection Defining Columns
3477@cindex column view, for properties
3478@cindex properties, column view
3399 3479
3400Setting up a column view first requires defining the columns. A column 3480Setting up a column view first requires defining the columns. This is
3401definition is a property itself and looks like this: 3481done by defining a column format line.
3402 3482
3403@example 3483@menu
3404:COLUMNS: %25ITEM %TAGS %PRIORITY %TODO 3484* Scope of column definitions:: Where defined, where valid?
3405@end example 3485* Column attributes:: Appearance and content of a column
3486@end menu
3406 3487
3407This definition means that column 1 should be the first 25 characters of 3488@node Scope of column definitions, Column attributes, Defining columns, Defining columns
3408the item itself, i.e. of the headline. You probably always should start 3489@subsubsection Scope of column definitions
3409the column definition with the ITEM specifier - just select a useful
3410width for it. The other specifiers create columns for the local tags,
3411for the priority and for the TODO state. When no width is given after
3412the @samp{%} character, the column will be exactly as wide as it need to
3413be in order to fully display all values.
3414 3490
3415If a @code{COLUMNS} property is present in an entry, it defines 3491To define a column format for an entire file, use a line like
3416columns for the entry itself, and for the entire subtree below it.
3417Since the column definition is part of the hierarchical structure of the
3418document, you can define columns on level 1 that are general enough for
3419all sublevels, and more specific columns further down, when you edit a deeper
3420part of the tree. Here is an example:
3421 3492
3422@example 3493@example
3423* People 3494#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
3424 :PROPERTIES: 3495@end example
3425 :COLUMNS: %25ITEM %Name 3496
3426 :END: 3497To specify a format that only applies to a specific tree, add a COLUMNS
3427** Family 3498property to the top node of that tree, for example
3428 :PROPERTIES: 3499@example
3429 :COLUMNS: %25ITEM %Name %3Age 3500** Top node for columns view
3430 :END:
3431*** Sam
3432 Info about Sam, including a property list with Name and Age.
3433*** Sarah
3434 Info about Sarah, including a property list with Name and Age.
3435** Office
3436 :PROPERTIES: 3501 :PROPERTIES:
3437 :COLUMNS: %25ITEM %Name %Function %Salary 3502 :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
3438 :END: 3503 :END:
3439*** Boss
3440 Info about the Boss, including a property list with Name,
3441 Function and Salary (if only we knew....).
3442@end example 3504@end example
3443 3505
3444Now we have defined three different sets of columns. If you switch to 3506If a @code{COLUMNS} property is present in an entry, it defines columns
3445column view in the @emph{Family} section, you will get a different table 3507for the entry itself, and for the entire subtree below it. Since the
3446than if you do it in the @emph{Office} section. However, if you switch 3508column definition is part of the hierarchical structure of the document,
3447to column view with the cursor on the @emph{People} section, the table 3509you can define columns on level 1 that are general enough for all
3448will cover all entries, but contain only the @emph{Name} column. 3510sublevels, and more specific columns further down, when you edit a
3511deeper part of the tree.
3512
3513@node Column attributes, , Scope of column definitions, Defining columns
3514@subsubsection Column attributes
3515A column definition sets the attributes of a column. The general
3516definition looks like this:
3449 3517
3450If no COLUMNS property applies to a given location, Org-mode uses a 3518@example
3451default format specified in the variable 3519 %[width]property[(title)][@{summary-type@}]
3452@code{org-default-columns-format}. This format in particular also 3520@end example
3453applies when column view is invoked with the cursor before the first 3521
3454headline. You can set the default format on a per-file basis with a 3522@noindent
3455line (don't forget to press @kbd{C-c C-c} to activate any changes to 3523Except for the percent sign and the property name, all items are
3456this line). 3524optional. The individual parts have the following meaning:
3457 3525
3458@example 3526@example
3459#+COLUMNS: %25ITEM ....." 3527width @r{An integer specifying the width of the column in characters.}
3528 @r{If omitted, the width will be determined automatically.}
3529property @r{The property that should be edited in this column.}
3530(title) @r{The header text for the column. If omitted, the}
3531 @r{property name is used.}
3532@{summary-type@} @r{The summary type. If specified, the column values for}
3533 @r{parent nodes are computed from the children.}
3534 @r{Supported summary types are:}
3535 @{+@} @r{Sum numbers in this column.}
3536 @{:@} @r{Sum times, HH:MM:SS, plain numbers are hours.}
3537 @{X@} @r{Checkbox status, [X] if all children are [X].}
3460@end example 3538@end example
3461 3539
3540@noindent
3541Here is an example for a complete columns definition, along with allowed
3542values.
3543
3544@example
3545:COLUMNS: %20ITEM %9Approved(Approved?)@{X@} %Owner %11Status %10Time_Spent@{:@}
3546:Owner_ALL: Tammy Mark Karl Lisa Don
3547:Status_ALL: "In progress" "Not started yet" "Finished" ""
3548:Approved_ALL: "[ ]" "[X]"
3549@end example
3550
3551The first column, @samp{%25ITEM}, means the first 25 characters of the
3552item itself, i.e. of the headline. You probably always should start the
3553column definition with the ITEM specifier. The other specifiers create
3554columns @samp{Owner} with a list of names as allowed values, for
3555@samp{Status} with four different possible values, and for a checkbox
3556field @samp{Approved}. When no width is given after the @samp{%}
3557character, the column will be exactly as wide as it needs to be in order
3558to fully display all values. The @samp{Approved} column does have a
3559modified title (@samp{Approved?}, with a question mark). Summaries will
3560be created for the @samp{Time_Spent} column by adding time duration
3561expressions like HH:MM, and for the @samp{Approved} column, by providing
3562an @samp{[X]} status if all children have been checked.
3563
3462@node Using column view, , Defining columns, Column view 3564@node Using column view, , Defining columns, Column view
3463@subsection Using Column View 3565@subsection Using Column View
3464 3566
3465@table @kbd 3567@table @kbd
3568@tsubheading{Turning column view on and off}
3466@kindex C-c C-x C-c 3569@kindex C-c C-x C-c
3467@item C-c C-x C-c 3570@item C-c C-x C-c
3468Create the column view for the local environment. This command searches 3571Create the column view for the local environment. This command searches
3469the hierarchy, up from point, for a @code{COLUMNS} property that defines 3572the hierarchy, up from point, for a @code{COLUMNS} property that defines
3470a format. When one is found, the column view table is established for 3573a format. When one is found, the column view table is established for
3471the entire subtree. 3574the entire tree, starting from the entry that contains the @code{COLUMNS}
3575property. If none is found, the format is taken from the @code{#+COLUMNS}
3576line or from the variable @code{org-columns-default-format}, and column
3577view is established for the current entry and its subtree.
3578@kindex q
3579@item q
3580Exit column view.
3581@tsubheading{Editing values}
3472@item @key{left} @key{right} @key{up} @key{down} 3582@item @key{left} @key{right} @key{up} @key{down}
3473Move through the column view from field to field. 3583Move through the column view from field to field.
3584@kindex S-@key{left}
3585@kindex S-@key{right}
3586@item S-@key{left}/@key{right}
3587Switch to the next/previous allowed value of the field. For this, you
3588have to have specified allowed values for a property.
3589@kindex n
3590@kindex p
3591@itemx n / p
3592Same as @kbd{S-@key{left}/@key{right}}
3474@kindex e 3593@kindex e
3475@item e 3594@item e
3476Edit the property at point. For the special properties, this will 3595Edit the property at point. For the special properties, this will
@@ -3481,20 +3600,36 @@ or fast selection interface will pop up.
3481@item v 3600@item v
3482View the full value of this property. This is useful if the width of 3601View the full value of this property. This is useful if the width of
3483the column is smaller than that of the value. 3602the column is smaller than that of the value.
3484@kindex q 3603@kindex a
3485@item q 3604@item a
3486Exit column view. 3605Edit the list of allowed values for this property. If the list is found
3606in the hierarchy, the modified values is stored there. If no list is
3607found, the new value is stored in the first entry that is part of the
3608current column view.
3609@tsubheading{Modifying the table structure}
3610@kindex <
3611@kindex >
3612@item < / >
3613Make the column narrower/wider by one character.
3614@kindex S-M-@key{right}
3615@item S-M-@key{right}
3616Insert a new column, to the right of the current column.
3617@kindex S-M-@key{left}
3618@item S-M-@key{left}
3619Delete the current column.
3487@end table 3620@end table
3488 3621
3489@node Property API, , Column view, Properties 3622@node Property API, , Column view, Properties and columns
3490@section The Property API 3623@section The Property API
3624@cindex properties, API
3625@cindex API, for properties
3491 3626
3492There is a full API for accessing and changing properties. This API can 3627There is a full API for accessing and changing properties. This API can
3493be used by Emacs Lisp programs to work with properties and to implement 3628be used by Emacs Lisp programs to work with properties and to implement
3494features based on them. For more information see @ref{Using the 3629features based on them. For more information see @ref{Using the
3495property API}. 3630property API}.
3496 3631
3497@node Timestamps, Agenda views, Properties, Top 3632@node Timestamps, Agenda views, Properties and columns, Top
3498@chapter Timestamps 3633@chapter Timestamps
3499@cindex time stamps 3634@cindex time stamps
3500@cindex date stamps 3635@cindex date stamps
@@ -4355,7 +4490,7 @@ file in a @emph{time-sorted view}. The main purpose of this command is
4355to give an overview over events in a project. 4490to give an overview over events in a project.
4356 4491
4357@table @kbd 4492@table @kbd
4358@kindex C-a a L 4493@kindex C-c a L
4359@item C-c a L 4494@item C-c a L
4360Show a time-sorted view of the org file, with all time-stamped items. 4495Show a time-sorted view of the org file, with all time-stamped items.
4361When called with a @kbd{C-u} prefix, all unfinished TODO entries 4496When called with a @kbd{C-u} prefix, all unfinished TODO entries
@@ -4604,7 +4739,9 @@ Delete other windows.
4604@kindex m 4739@kindex m
4605@kindex y 4740@kindex y
4606@item d w m y 4741@item d w m y
4607Switch to day/week/month/year view. 4742Switch to day/week/month/year view. When switching to day or week view,
4743this setting becomes the default for subseqent agenda commands. Since
4744month and year views are slow to create, the do not become the default.
4608@c 4745@c
4609@kindex D 4746@kindex D
4610@item D 4747@item D
@@ -5947,16 +6084,15 @@ skip: @r{turn on/off skipping the text before the first heading}
5947@chapter Publishing 6084@chapter Publishing
5948@cindex publishing 6085@cindex publishing
5949 6086
5950Org-mode includes@footnote{@file{org-publish.el} is not yet part of 6087Org-mode includes@footnote{@file{org-publish.el} is not distributed with
5951Emacs, so if you are using @file{org.el} as it comes with Emacs, you 6088Emacs 21, if you are still using Emacs 21, you need you need to download
5952need to download this file separately. Also make sure org.el is at 6089this file separately.} a publishing management system that allows you to
5953least version 4.27.} a publishing management system 6090configure automatic HTML conversion of @emph{projects} composed of
5954that allows you to configure automatic HTML conversion of 6091interlinked org files. This system is called @emph{org-publish}. You
5955@emph{projects} composed of interlinked org files. This system is 6092can also configure org-publish to automatically upload your exported
5956called @emph{org-publish}. You can also configure org-publish to 6093HTML pages and related attachments, such as images and source code
5957automatically upload your exported HTML pages and related attachments, 6094files, to a web server. Org-publish turns org-mode into a web-site
5958such as images and source code files, to a web server. Org-publish turns 6095authoring tool.
5959org-mode into a web-site authoring tool.
5960 6096
5961Org-publish has been contributed to Org-mode by David O'Toole. 6097Org-publish has been contributed to Org-mode by David O'Toole.
5962 6098
@@ -6118,7 +6254,7 @@ respective variable for details.
6118 6254
6119When a property is given a value in org-publish-project-alist, its 6255When a property is given a value in org-publish-project-alist, its
6120setting overrides the value of the corresponding user variable (if any) 6256setting overrides the value of the corresponding user variable (if any)
6121during publishing. options set within a file (@pxref{Export 6257during publishing. Options set within a file (@pxref{Export
6122options}), however, override everything. 6258options}), however, override everything.
6123 6259
6124@node Publishing links, Project page index, Publishing options, Configuration 6260@node Publishing links, Project page index, Publishing options, Configuration
@@ -6445,8 +6581,8 @@ Logging TODO state changes and clock intervals (variable
6445logging @r{record a timestamp when an item is marked DONE} 6581logging @r{record a timestamp when an item is marked DONE}
6446nologging @r{don't record when items are marked DONE} 6582nologging @r{don't record when items are marked DONE}
6447lognotedone @r{record timestamp and a note when DONE} 6583lognotedone @r{record timestamp and a note when DONE}
6448lognotestate @r{record timestamp, note when TODO state changes} 6584lognotestate @r{record timestamp and a note when TODO state changes}
6449logrepeat @r{record a not when re-instating a repeating item} 6585logrepeat @r{record a note when re-instating a repeating item}
6450nologrepeat @r{do not record when re-instating repeating item} 6586nologrepeat @r{do not record when re-instating repeating item}
6451lognoteclock-out @r{record timestamp and a note when clocking out} 6587lognoteclock-out @r{record timestamp and a note when clocking out}
6452@end example 6588@end example
@@ -6531,6 +6667,9 @@ default location.
6531If the cursor is on a @code{<<<target>>>}, update radio targets and 6667If the cursor is on a @code{<<<target>>>}, update radio targets and
6532corresponding links in this buffer. 6668corresponding links in this buffer.
6533@item 6669@item
6670If the cursor is in a property line or at the start or end of a property
6671drawer, offer property commands.
6672@item
6534If the cursor is in a plain list item with a checkbox, toggle the status 6673If the cursor is in a plain list item with a checkbox, toggle the status
6535of the checkbox. 6674of the checkbox.
6536@item 6675@item
@@ -7289,6 +7428,7 @@ MATCH is being ignored."
7289@node Using the property API, , Special agenda views, Extensions and Hacking 7428@node Using the property API, , Special agenda views, Extensions and Hacking
7290@section Using the property API 7429@section Using the property API
7291@cindex API, for properties 7430@cindex API, for properties
7431@cindex properties, API
7292 7432
7293Here is a description of the functions that can be used to work with 7433Here is a description of the functions that can be used to work with
7294properties. 7434properties.
diff --git a/man/texinfo.tex b/man/texinfo.tex
index 017eeac5d6d..fe6285b3bc5 100644
--- a/man/texinfo.tex
+++ b/man/texinfo.tex
@@ -3,7 +3,7 @@
3% Load plain if necessary, i.e., if running under initex. 3% Load plain if necessary, i.e., if running under initex.
4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi 4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
5% 5%
6\def\texinfoversion{2007-06-16.10} 6\def\texinfoversion{2007-07-09.21}
7% 7%
8% Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 8% Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -7434,22 +7434,41 @@ end
7434 7434
7435% @documentlanguage is usually given very early, just after 7435% @documentlanguage is usually given very early, just after
7436% @setfilename. If done too late, it may not override everything 7436% @setfilename. If done too late, it may not override everything
7437% properly. Single argument is the language abbreviation. 7437% properly. Single argument is the language (de) or locale (de_DE)
7438% It would be nice if we could set up a hyphenation file here. 7438% abbreviation. It would be nice if we could set up a hyphenation file.
7439% 7439%
7440\parseargdef\documentlanguage{% 7440{
7441 \catcode`\_ = \active
7442 \globaldefs=1
7443\parseargdef\documentlanguage{\begingroup
7444 \let_=\normalunderscore % normal _ character for filenames
7441 \tex % read txi-??.tex file in plain TeX. 7445 \tex % read txi-??.tex file in plain TeX.
7442 % Read the file if it exists. 7446 % Read the file by the name they passed if it exists.
7443 \openin 1 txi-#1.tex 7447 \openin 1 txi-#1.tex
7444 \ifeof 1 7448 \ifeof 1
7445 \errhelp = \nolanghelp 7449 \documentlanguagetrywithoutunderscore{#1_\finish}%
7446 \errmessage{Cannot read language file txi-#1.tex}%
7447 \else 7450 \else
7448 \input txi-#1.tex 7451 \input txi-#1.tex
7449 \fi 7452 \fi
7450 \closein 1 7453 \closein 1
7451 \endgroup 7454 \endgroup
7455\endgroup}
7452} 7456}
7457%
7458% If they passed de_DE, and txi-de_DE.tex doesn't exist,
7459% try txi-de.tex.
7460%
7461\def\documentlanguagetrywithoutunderscore#1_#2\finish{%
7462 \openin 1 txi-#1.tex
7463 \ifeof 1
7464 \errhelp = \nolanghelp
7465 \errmessage{Cannot read language file txi-#1.tex}%
7466 \else
7467 \input txi-#1.tex
7468 \fi
7469 \closein 1
7470}
7471%
7453\newhelp\nolanghelp{The given language definition file cannot be found or 7472\newhelp\nolanghelp{The given language definition file cannot be found or
7454is empty. Maybe you need to install it? In the current directory 7473is empty. Maybe you need to install it? In the current directory
7455should work if nowhere else does.} 7474should work if nowhere else does.}
@@ -8316,6 +8335,8 @@ should work if nowhere else does.}
8316 \ifpdf 8335 \ifpdf
8317 \pdfpageheight #7\relax 8336 \pdfpageheight #7\relax
8318 \pdfpagewidth #8\relax 8337 \pdfpagewidth #8\relax
8338 \pdfhorigin = 1 true in
8339 \pdfvorigin = 1 true in
8319 \fi 8340 \fi
8320 % 8341 %
8321 \setleading{\textleading} 8342 \setleading{\textleading}
diff --git a/man/tramp.texi b/man/tramp.texi
index 67b0647787c..950b4055912 100644
--- a/man/tramp.texi
+++ b/man/tramp.texi
@@ -18,15 +18,27 @@
18@include trampver.texi 18@include trampver.texi
19 19
20@c Macros for formatting a filename. 20@c Macros for formatting a filename.
21@c trampfn is for a full filename, trampfnmhp means method, host, localname 21@c trampfn is for a full filename, trampfnmhl means method, host, localname
22@c were given, and so on. 22@c were given, and so on.
23@macro trampfn(method, user, host, localname) 23@macro trampfn {method, user, host, localname}
24@value{prefix}@value{method}@value{user}@@@value{host}@value{postfix}@value{localname} 24@value{prefix}\method\@value{postfixhop}\user\@@\host\@value{postfix}\localname\
25@end macro
26
27@macro trampfnmhl {method, host, localname}
28@value{prefix}\method\@value{postfixhop}\host\@value{postfix}\localname\
29@end macro
30
31@macro trampfnuhl {user, host, localname}
32@value{prefix}\user\@@\host\@value{postfix}\localname\
33@end macro
34
35@macro trampfnhl {host, localname}
36@value{prefix}\host\@value{postfix}\localname\
25@end macro 37@end macro
26 38
27@copying 39@copying
28Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 40Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
29Free Software Foundation, Inc. 412007 Free Software Foundation, Inc.
30 42
31@quotation 43@quotation
32Permission is granted to copy, distribute and/or modify this document 44Permission is granted to copy, distribute and/or modify this document
@@ -157,6 +169,7 @@ For the developer:
157 169
158* Version Control:: The inner workings of remote version control. 170* Version Control:: The inner workings of remote version control.
159* Files directories and localnames:: How file names, directories and localnames are mangled and managed. 171* Files directories and localnames:: How file names, directories and localnames are mangled and managed.
172* Traces and Profiles:: How to Customize Traces.
160* Issues:: Debatable Issues and What Was Decided. 173* Issues:: Debatable Issues and What Was Decided.
161 174
162* GNU Free Documentation License:: The license for this documentation. 175* GNU Free Documentation License:: The license for this documentation.
@@ -178,11 +191,17 @@ Configuring @value{tramp} for use
178* Connection types:: Types of connections made to remote machines. 191* Connection types:: Types of connections made to remote machines.
179* Inline methods:: Inline methods. 192* Inline methods:: Inline methods.
180* External transfer methods:: External transfer methods. 193* External transfer methods:: External transfer methods.
181* Multi-hop Methods:: Connecting to a remote host using multiple hops. 194@ifset emacsgw
195* Gateway methods:: Gateway methods.
196@end ifset
182* Default Method:: Selecting a default method. 197* Default Method:: Selecting a default method.
198* Default User:: Selecting a default user.
199* Default Host:: Selecting a default host.
200* Multi-hops:: Connecting to a remote host using multiple hops.
183* Customizing Methods:: Using Non-Standard Methods. 201* Customizing Methods:: Using Non-Standard Methods.
184* Customizing Completion:: Selecting config files for user/host name completion. 202* Customizing Completion:: Selecting config files for user/host name completion.
185* Password caching:: Reusing passwords for several connections. 203* Password caching:: Reusing passwords for several connections.
204* Connection caching:: Reusing connection related information.
186* Remote Programs:: How @value{tramp} finds and uses programs on the remote machine. 205* Remote Programs:: How @value{tramp} finds and uses programs on the remote machine.
187* Remote shell setup:: Remote shell setup hints. 206* Remote shell setup:: Remote shell setup hints.
188* Windows setup hints:: Issues with Cygwin ssh. 207* Windows setup hints:: Issues with Cygwin ssh.
@@ -191,10 +210,9 @@ Configuring @value{tramp} for use
191Using @value{tramp} 210Using @value{tramp}
192 211
193* Filename Syntax:: @value{tramp} filename conventions. 212* Filename Syntax:: @value{tramp} filename conventions.
194* Multi-hop filename syntax:: Multi-hop filename conventions. 213* Alternative Syntax:: URL-like filename syntax.
195* Filename completion:: Filename completion. 214* Filename completion:: Filename completion.
196* Dired:: Dired. 215* Remote processes:: Integration with other @value{emacsname} packages.
197* Compilation:: Compile remote files.
198 216
199The inner workings of remote version control 217The inner workings of remote version control
200 218
@@ -220,10 +238,10 @@ How file names, directories and localnames are mangled and managed
220@chapter An overview of @value{tramp} 238@chapter An overview of @value{tramp}
221@cindex overview 239@cindex overview
222 240
223After the installation of @value{tramp} into your @value{emacsname}, 241After the installation of @value{tramp} into your @value{emacsname}, you
224you will be able to access files on remote machines as though they 242will be able to access files on remote machines as though they were
225were local. Access to the remote file system for editing files, 243local. Access to the remote file system for editing files, version
226version control, and @code{dired} are transparently enabled. 244control, and @code{dired} are transparently enabled.
227 245
228Your access to the remote machine can be with the @command{rsh}, 246Your access to the remote machine can be with the @command{rsh},
229@command{rlogin}, @command{telnet} programs or with any similar 247@command{rlogin}, @command{telnet} programs or with any similar
@@ -380,7 +398,7 @@ behind the scenes when you open a file with @value{tramp}.
380 398
381@value{tramp} is freely available on the Internet and the latest 399@value{tramp} is freely available on the Internet and the latest
382release may be downloaded from 400release may be downloaded from
383@uref{ftp://ftp.gnu.org/gnu/tramp/}. This release includes the full 401@uref{ftp://ftp.gnu.org/gnu/tramp/}. This release includes the full
384documentation and code for @value{tramp}, suitable for installation. 402documentation and code for @value{tramp}, suitable for installation.
385But GNU Emacs (22 or later) includes @value{tramp} already, and there 403But GNU Emacs (22 or later) includes @value{tramp} already, and there
386is a @value{tramp} package for XEmacs, as well. So maybe it is easier 404is a @value{tramp} package for XEmacs, as well. So maybe it is easier
@@ -389,7 +407,7 @@ on@dots{...}
389 407
390For the especially brave, @value{tramp} is available from CVS. The CVS 408For the especially brave, @value{tramp} is available from CVS. The CVS
391version is the latest version of the code and may contain incomplete 409version is the latest version of the code and may contain incomplete
392features or new issues. Use these versions at your own risk. 410features or new issues. Use these versions at your own risk.
393 411
394Instructions for obtaining the latest development version of @value{tramp} 412Instructions for obtaining the latest development version of @value{tramp}
395from CVS can be found by going to the Savannah project page at the 413from CVS can be found by going to the Savannah project page at the
@@ -410,7 +428,7 @@ Or follow the example session below:
410 428
411@noindent 429@noindent
412You should now have a directory @file{~/@value{emacsdir}/tramp} 430You should now have a directory @file{~/@value{emacsdir}/tramp}
413containing the latest version of @value{tramp}. You can fetch the latest 431containing the latest version of @value{tramp}. You can fetch the latest
414updates from the repository by issuing the command: 432updates from the repository by issuing the command:
415 433
416@example 434@example
@@ -429,6 +447,11 @@ script:
429] @strong{autoconf} 447] @strong{autoconf}
430@end example 448@end example
431 449
450People who have no direct CVS access (maybe because sitting behind a
451blocking firewall), can try the
452@uref{http://savannah.gnu.org/cvs-backup/tramp-sources.tar.gz, Nightly
453CVS Tree Tarball} instead of.
454
432 455
433@node History 456@node History
434@chapter History of @value{tramp} 457@chapter History of @value{tramp}
@@ -445,7 +468,19 @@ file contents were added. Support for VC was added.
445 468
446The most recent addition of major features were the multi-hop methods 469The most recent addition of major features were the multi-hop methods
447added in April 2000 and the unification of @value{tramp} and Ange-FTP 470added in April 2000 and the unification of @value{tramp} and Ange-FTP
448filenames in July 2002. 471filenames in July 2002. In July 2004, multi-hop methods have been
472replaced by proxy hosts. Running commands on remote hosts was
473introduced in December 2005.
474@ifset emacsgw
475Support of gateways exists since April 2007.
476@end ifset
477
478In December 2001, @value{tramp} has been added to the XEmacs package
479repository. Being part of the GNU Emacs repository happened in June
4802002, the first release including @value{tramp} was GNU Emacs 22.1.
481
482@value{tramp} is also a GNU/Linux Debian package since February 2001.
483
449 484
450@c Installation chapter is necessary only in case of standalone 485@c Installation chapter is necessary only in case of standalone
451@c installation. Text taken from trampinst.texi. 486@c installation. Text taken from trampinst.texi.
@@ -462,7 +497,7 @@ filenames in July 2002.
462installed. It is initially configured to use the @command{scp} 497installed. It is initially configured to use the @command{scp}
463program to connect to the remote host. So in the easiest case, you 498program to connect to the remote host. So in the easiest case, you
464just type @kbd{C-x C-f} and then enter the filename 499just type @kbd{C-x C-f} and then enter the filename
465@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}@var{/path/to.file}}. 500@file{@trampfnuhl{user, machine, /path/to.file}}.
466 501
467On some hosts, there are problems with opening a connection. These are 502On some hosts, there are problems with opening a connection. These are
468related to the behavior of the remote shell. See @xref{Remote shell 503related to the behavior of the remote shell. See @xref{Remote shell
@@ -482,14 +517,20 @@ Method}.
482* Connection types:: Types of connections made to remote machines. 517* Connection types:: Types of connections made to remote machines.
483* Inline methods:: Inline methods. 518* Inline methods:: Inline methods.
484* External transfer methods:: External transfer methods. 519* External transfer methods:: External transfer methods.
485* Multi-hop Methods:: Connecting to a remote host using multiple hops. 520@ifset emacsgw
521* Gateway methods:: Gateway methods.
522@end ifset
486* Default Method:: Selecting a default method. 523* Default Method:: Selecting a default method.
487 Here we also try to help those who 524 Here we also try to help those who
488 don't have the foggiest which method 525 don't have the foggiest which method
489 is right for them. 526 is right for them.
527* Default User:: Selecting a default user.
528* Default Host:: Selecting a default host.
529* Multi-hops:: Connecting to a remote host using multiple hops.
490* Customizing Methods:: Using Non-Standard Methods. 530* Customizing Methods:: Using Non-Standard Methods.
491* Customizing Completion:: Selecting config files for user/host name completion. 531* Customizing Completion:: Selecting config files for user/host name completion.
492* Password caching:: Reusing passwords for several connections. 532* Password caching:: Reusing passwords for several connections.
533* Connection caching:: Reusing connection related information.
493* Remote Programs:: How @value{tramp} finds and uses programs on the remote machine. 534* Remote Programs:: How @value{tramp} finds and uses programs on the remote machine.
494* Remote shell setup:: Remote shell setup hints. 535* Remote shell setup:: Remote shell setup hints.
495* Windows setup hints:: Issues with Cygwin ssh. 536* Windows setup hints:: Issues with Cygwin ssh.
@@ -508,7 +549,7 @@ remote shell access program such as @command{rsh}, @command{ssh} or
508 549
509This connection is used to perform many of the operations that @value{tramp} 550This connection is used to perform many of the operations that @value{tramp}
510requires to make the remote file system transparently accessible from 551requires to make the remote file system transparently accessible from
511the local machine. It is only when visiting files that the methods 552the local machine. It is only when visiting files that the methods
512differ. 553differ.
513 554
514@cindex inline methods 555@cindex inline methods
@@ -519,7 +560,7 @@ differ.
519@cindex methods, external transfer 560@cindex methods, external transfer
520@cindex methods, out-of-band 561@cindex methods, out-of-band
521Loading or saving a remote file requires that the content of the file 562Loading or saving a remote file requires that the content of the file
522be transfered between the two machines. The content of the file can be 563be transfered between the two machines. The content of the file can be
523transfered over the same connection used to log in to the remote 564transfered over the same connection used to log in to the remote
524machine or the file can be transfered through another connection using 565machine or the file can be transfered through another connection using
525a remote copy program such as @command{rcp}, @command{scp} or 566a remote copy program such as @command{rcp}, @command{scp} or
@@ -539,16 +580,10 @@ startup may drown out the improvement in file transfer times.
539 580
540External transfer methods should be configured such a way that they 581External transfer methods should be configured such a way that they
541don't require a password (with @command{ssh-agent}, or such alike). 582don't require a password (with @command{ssh-agent}, or such alike).
542If it isn't possible, you should consider @ref{Password caching}, 583Modern @command{scp} implementations offer options to reuse existing
543otherwise you will be prompted for a password every copy action. 584@command{ssh} connections, see method @command{scpc}. If it isn't
544 585possible, you should consider @ref{Password caching}, otherwise you
545@cindex multi-hop methods 586will be prompted for a password every copy action.
546@cindex methods, multi-hop
547A variant of the inline methods are the @dfn{multi-hop methods}.
548These methods allow you to connect a remote host using a number `hops',
549each of which connects to a different host. This is useful if you are
550in a secured network where you need to go through a bastion host to
551connect to the outside world.
552 587
553 588
554@node Inline methods 589@node Inline methods
@@ -635,6 +670,8 @@ as the @option{rsh} method.
635 670
636This method does not connect to a remote host at all, rather it uses 671This method does not connect to a remote host at all, rather it uses
637the @command{su} program to allow you to edit files as another user. 672the @command{su} program to allow you to edit files as another user.
673With other words, a specified host name in the file name is silently
674ignored.
638 675
639 676
640@item @option{sudo} 677@item @option{sudo}
@@ -682,7 +719,7 @@ This supports the @samp{-p} kludge.
682 719
683@item @option{krlogin} 720@item @option{krlogin}
684@cindex method krlogin 721@cindex method krlogin
685@cindex km krlogin 722@cindex krlogin method
686@cindex Kerberos (with krlogin method) 723@cindex Kerberos (with krlogin method)
687 724
688This method is also similar to @option{ssh}. It only uses the 725This method is also similar to @option{ssh}. It only uses the
@@ -697,18 +734,43 @@ This method is mostly interesting for Windows users using the PuTTY
697implementation of SSH. It uses @samp{plink -ssh} to log in to the 734implementation of SSH. It uses @samp{plink -ssh} to log in to the
698remote host. 735remote host.
699 736
700Additionally, the method @option{plink1} is provided, which calls 737This supports the @samp{-P} kludge.
701@samp{plink -1 -ssh} in order to use SSH protocol version 1 738
702explicitly. 739Additionally, the methods @option{plink1} and @option{plink2} are
740provided, which call @samp{plink -1 -ssh} or @samp{plink -2 -ssh} in
741order to use SSH protocol version 1 or 2 explicitly.
703 742
704CCC: Do we have to connect to the remote host once from the command 743CCC: Do we have to connect to the remote host once from the command
705line to accept the SSH key? Maybe this can be made automatic? 744line to accept the SSH key? Maybe this can be made automatic?
706 745
707CCC: Does @command{plink} support the @samp{-p} option? @value{tramp} will 746CCC: Say something about the first shell command failing. This might
708support that, anyway. 747be due to a wrong setting of @code{tramp-rsh-end-of-line}.
709 748
710@end table
711 749
750@item @option{plinkx}
751@cindex method plinkx
752@cindex plinkx method
753
754Another method using PuTTY on Windows. Instead of host names, it
755expects PuTTY session names, calling @samp{plink -load @var{session}
756-t"}. User names are relevant only in case the corresponding session
757hasn't defined a user name. Different port numbers must be defined in
758the session.
759
760
761@item @option{fish}
762@cindex method fish
763@cindex fish method
764
765This is an experimental implementation of the fish protocol, known from
766the GNU Midnight Commander or the KDE Konqueror. @value{tramp} expects
767the fish server implementation from the KDE kioslave. That means, the
768file @file{~/.fishsrv.pl} is expected to reside on the remote host.
769
770The implementation lacks good performance. The code is offered anyway,
771maybe somebody can improve the performance.
772
773@end table
712 774
713 775
714@node External transfer methods 776@node External transfer methods
@@ -725,21 +787,10 @@ transfers to an external transfer utility.
725This saves the overhead of encoding and decoding that multiplexing the 787This saves the overhead of encoding and decoding that multiplexing the
726transfer through the one connection has with the inline methods. 788transfer through the one connection has with the inline methods.
727 789
728If you want to use an external transfer method you should be able to 790Since external transfer methods need their own overhead opening a new
729execute the transfer utility to copy files to and from the remote 791channel, all files which are smaller than @var{tramp-copy-size-limit}
730machine without any interaction. 792are still transferred with the corresponding inline method. It should
731 793provide a fair trade-off between both approaches.
732@cindex ssh-agent
733This means that you will need to use @command{ssh-agent} if you use the
734@command{scp} program for transfers, or maybe your version of
735@command{scp} accepts a password on the command line.@footnote{PuTTY's
736@command{pscp} allows you to specify the password on the command line.}
737If you use @command{rsync} via @command{ssh} then the same rule must
738apply to that connection.
739
740If you cannot get an external method to run without asking for a
741password you should consider @ref{Password caching}.
742
743 794
744@table @asis 795@table @asis
745@item @option{rcp} --- @command{rsh} and @command{rcp} 796@item @option{rcp} --- @command{rsh} and @command{rcp}
@@ -767,7 +818,7 @@ Using @command{ssh} to connect to the remote host and @command{scp} to
767transfer files between the machines is the best method for securely 818transfer files between the machines is the best method for securely
768connecting to a remote machine and accessing files. 819connecting to a remote machine and accessing files.
769 820
770The performance of this option is also quite good. It may be slower than 821The performance of this option is also quite good. It may be slower than
771the inline methods when you often open and close small files however. 822the inline methods when you often open and close small files however.
772The cost of the cryptographic handshake at the start of an @command{scp} 823The cost of the cryptographic handshake at the start of an @command{scp}
773session can begin to absorb the advantage that the lack of encoding and 824session can begin to absorb the advantage that the lack of encoding and
@@ -787,7 +838,24 @@ know what these are, you do not need these options.
787All the @command{ssh} based methods support the kludgy @samp{-p} 838All the @command{ssh} based methods support the kludgy @samp{-p}
788feature where you can specify a port number to connect to in the host 839feature where you can specify a port number to connect to in the host
789name. For example, the host name @file{host#42} tells @value{tramp} to 840name. For example, the host name @file{host#42} tells @value{tramp} to
790specify @samp{-p 42} in the argument list for @command{ssh}. 841specify @samp{-p 42} in the argument list for @command{ssh}, and to
842specify @samp{-P 42} in the argument list for @command{scp}.
843
844
845@item @option{sftp} --- @command{ssh} and @command{sftp}
846@cindex method sftp
847@cindex sftp method
848@cindex sftp (with sftp method)
849@cindex ssh (with sftp method)
850
851That is mostly the same method as @option{scp}, but using
852@command{sftp} as transfer command. So the same remarks are valid.
853
854This command does not work like @value{ftppackagename}, where
855@command{ftp} is called interactively, and all commands are send from
856within this session. Instead of, @command{ssh} is used for login.
857
858This method supports the @samp{-p} hack.
791 859
792 860
793@item @option{rsync} --- @command{ssh} and @command{rsync} 861@item @option{rsync} --- @command{ssh} and @command{rsync}
@@ -805,7 +873,7 @@ transferring files that exist on both hosts, this advantage is lost if
805the file exists only on one side of the connection. 873the file exists only on one side of the connection.
806 874
807The @command{rsync} based method may be considerably faster than the 875The @command{rsync} based method may be considerably faster than the
808@command{rcp} based methods when writing to the remote system. Reading 876@command{rcp} based methods when writing to the remote system. Reading
809files to the local machine is no faster than with a direct copy. 877files to the local machine is no faster than with a direct copy.
810 878
811This method supports the @samp{-p} hack. 879This method supports the @samp{-p} hack.
@@ -866,7 +934,22 @@ This method is similar to @option{scp}, but it uses the
866@command{pscp} for transferring the files. These programs are part 934@command{pscp} for transferring the files. These programs are part
867of PuTTY, an SSH implementation for Windows. 935of PuTTY, an SSH implementation for Windows.
868 936
869CCC: Does @command{plink} support the @samp{-p} hack? 937This method supports the @samp{-P} hack.
938
939
940@item @option{psftp} --- @command{plink} and @command{psftp}
941@cindex method psftp
942@cindex psftp method
943@cindex psftp (with psftp method)
944@cindex plink (with psftp method)
945@cindex PuTTY (with psftp method)
946
947As you would expect, this method is similar to @option{sftp}, but it
948uses the @command{plink} command to connect to the remote host, and it
949uses @command{psftp} for transferring the files. These programs are
950part of PuTTY, an SSH implementation for Windows.
951
952This method supports the @samp{-P} hack.
870 953
871 954
872@item @option{fcp} --- @command{fsh} and @command{fcp} 955@item @option{fcp} --- @command{fsh} and @command{fcp}
@@ -901,7 +984,7 @@ anyway.
901@cindex method ftp 984@cindex method ftp
902@cindex ftp method 985@cindex ftp method
903 986
904This is not a native @value{tramp} method. Instead of, it forwards all 987This is not a native @value{tramp} method. Instead of, it forwards all
905requests to @value{ftppackagename}. 988requests to @value{ftppackagename}.
906@ifset xemacs 989@ifset xemacs
907This works only for unified filenames, see @ref{Issues}. 990This works only for unified filenames, see @ref{Issues}.
@@ -935,8 +1018,15 @@ specify a user name which looks like @code{user%domain} (the real user
935name, then a percent sign, then the domain name). So, to connect to 1018name, then a percent sign, then the domain name). So, to connect to
936the machine @code{melancholia} as user @code{daniel} of the domain 1019the machine @code{melancholia} as user @code{daniel} of the domain
937@code{BIZARRE}, and edit @file{.emacs} in the home directory (share 1020@code{BIZARRE}, and edit @file{.emacs} in the home directory (share
938@code{daniel$}) I would specify the filename 1021@code{daniel$}) I would specify the filename @file{@trampfn{smb,
939@file{@value{prefix}smb@value{postfixsinglehop}daniel%BIZARRE@@melancholia@value{postfix}/daniel$$/.emacs}. 1022daniel%BIZARRE, melancholia, /daniel$$/.emacs}}.
1023
1024Depending on the Windows domain configuration, a Windows user might be
1025considered as domain user per default. In order to connect as local
1026user, the WINS name of that machine must be given as domain name.
1027Usually, it is the machine name in capital letters. In the example
1028above, the local user @code{daniel} would be specified as
1029@file{@trampfn{smb, daniel%MELANCHOLIA, melancholia, /daniel$$/.emacs}}.
940 1030
941The domain name as well as the user name are optional. If no user 1031The domain name as well as the user name are optional. If no user
942name is specified at all, the anonymous user (without password 1032name is specified at all, the anonymous user (without password
@@ -953,97 +1043,56 @@ name.
953 1043
954@end table 1044@end table
955 1045
956@node Multi-hop Methods
957@section Connecting to a remote host using multiple hops
958@cindex multi-hop methods
959@cindex methods, multi-hop
960 1046
961Sometimes, the methods described before are not sufficient. Sometimes, 1047@ifset emacsgw
962it is not possible to connect to a remote host using a simple command. 1048@node Gateway methods
963For example, if you are in a secured network, you might have to log in 1049@section Gateway methods
964to a `bastion host' first before you can connect to the outside world. 1050@cindex methods, gateway
965Of course, the target host may also require a bastion host. The format 1051@cindex gateway methods
966of multi-hop filenames is slightly different than the format of normal
967@value{tramp} methods.
968
969@cindex method multi
970@cindex multi method
971A multi-hop file name specifies a method, a number of hops, and a
972localname (path name on the remote system). The method name is always
973@option{multi}.
974
975Each hop consists of a @dfn{hop method} specification, a user name and
976a host name. The hop method can be an inline method only. The
977following hop methods are (currently) available:
978
979@table @option
980@item telnet
981@cindex hop method telnet
982@cindex telnet hop method
983
984Uses the well-known @command{telnet} program to connect to the host.
985Whereas user name and host name are supplied in the file name, the
986user is queried for the password.
987
988@item rsh
989@cindex hop method rsh
990@cindex rsh hop method
991
992This uses @command{rsh} to connect to the host. You do not need to
993enter a password unless @command{rsh} explicitly asks for it.
994
995The variant @option{remsh} uses the @command{remsh} command. It
996should be applied on machines where @command{remsh} is used instead of
997@command{rsh}.
998
999@item ssh
1000@cindex hop method ssh
1001@cindex ssh hop method
1002
1003This uses @command{ssh} to connect to the host. You might have to enter
1004a password or a pass phrase.
1005
1006@item su
1007@cindex hop method su
1008@cindex su hop method
1009
1010This method does not actually contact a different host, but it allows
1011you to become a different user on the host you're currently on. This
1012might be useful if you want to edit files as root, but the remote host
1013does not allow remote root logins. In this case you can use
1014@option{telnet}, @option{rsh} or @option{ssh} to connect to the
1015remote host as a non-root user, then use an @option{su} hop to become
1016root. But @option{su} need not be the last hop in a sequence, you could
1017also use it somewhere in the middle, if the need arises.
1018
1019Even though you @emph{must} specify both user and host with an
1020@option{su} hop, the host name is ignored and only the user name is
1021used.
1022
1023@item sudo
1024@cindex hop method sudo
1025@cindex sudo hop method
1026
1027This is similar to the @option{su} hop, except that it uses
1028@command{sudo} rather than @command{su} to become a different user.
1029 1052
1030@end table 1053Gateway methods are not methods to access a remote host directly.
1054These methods are intended to pass firewalls or proxy servers.
1055Therefore, they can be used for proxy host declarations
1056(@pxref{Multi-hops}) only.
1031 1057
1032Some people might wish to use port forwarding with @command{ssh} or 1058A gateway method must come always along with a method who supports
1033maybe they have to use a nonstandard port. This can be accomplished 1059port setting (referred to as @samp{-p} kludge). This is because
1034by putting a stanza in @file{~/.ssh/config} for the account which 1060@value{tramp} targets the accompanied method to
1035specifies a different port number for a certain host name. But it can 1061@file{localhost#random_port}, from where the firewall or proxy server
1036also be accomplished within @value{tramp}, by adding a multi-hop method. 1062is accessed to.
1037For example:
1038 1063
1039@lisp 1064Gateway methods support user name and password declarations. These
1040(add-to-list 1065are used to authenticate towards the corresponding firewall or proxy
1041 'tramp-multi-connection-function-alist 1066server. They can be passed only if your friendly administrator has
1042 '("sshf" tramp-multi-connect-rlogin "ssh %h -l %u -p 4400%n")) 1067granted your access.
1043@end lisp 1068
1069@table @asis
1070@item @option{tunnel}
1071@cindex method tunnel
1072@cindex tunnel method
1073
1074This method implements an HTTP tunnel via the @command{CONNECT}
1075command (see RFC 2616, 2817). Any HTTP 1.1 compliant (proxy) server
1076shall support this command.
1077
1078As authentication method, only @option{Basic Authentication} (see RFC
10792617) is implemented so far. If no port number is given in the
1080declaration, port @option{8080} is used for the proxy server.
1044 1081
1045Now you can use an @option{sshf} hop which connects to port 4400 instead of 1082
1046the standard port. 1083@item @option{socks}
1084@cindex method socks
1085@cindex socks method
1086
1087The @command{socks} method provides access to SOCKSv5 servers (see
1088RFC 1928). @option{Username/Password Authentication} according to RFC
10891929 is supported.
1090
1091The default port number of the socks server is @option{1080}, if not
1092specified otherwise.
1093
1094@end table
1095@end ifset
1047 1096
1048 1097
1049@node Default Method 1098@node Default Method
@@ -1085,7 +1134,6 @@ methods, giving better performance.
1085 1134
1086@xref{Inline methods}. 1135@xref{Inline methods}.
1087@xref{External transfer methods}. 1136@xref{External transfer methods}.
1088@xref{Multi-hop Methods}.
1089 1137
1090Another consideration with the selection of transfer methods is the 1138Another consideration with the selection of transfer methods is the
1091environment you will use them in and, especially when used over the 1139environment you will use them in and, especially when used over the
@@ -1098,7 +1146,7 @@ read from other machines.
1098 1146
1099If you need to connect to remote systems that are accessible from the 1147If you need to connect to remote systems that are accessible from the
1100Internet, you should give serious thought to using @option{ssh} based 1148Internet, you should give serious thought to using @option{ssh} based
1101methods to connect. These provide a much higher level of security, 1149methods to connect. These provide a much higher level of security,
1102making it a non-trivial exercise for someone to obtain your password 1150making it a non-trivial exercise for someone to obtain your password
1103or read the content of the files you are editing. 1151or read the content of the files you are editing.
1104 1152
@@ -1119,9 +1167,9 @@ to edit mostly small files.
1119 1167
1120I guess that these days, most people can access a remote machine by 1168I guess that these days, most people can access a remote machine by
1121using @command{ssh}. So I suggest that you use the @option{ssh} 1169using @command{ssh}. So I suggest that you use the @option{ssh}
1122method. So, type @kbd{C-x C-f 1170method. So, type @kbd{C-x C-f @trampfn{ssh, root, otherhost,
1123@value{prefix}ssh@value{postfixsinglehop}root@@otherhost@value{postfix}/etc/motd 1171/etc/motd} @key{RET}} to edit the @file{/etc/motd} file on the other
1124@key{RET}} to edit the @file{/etc/motd} file on the other host. 1172host.
1125 1173
1126If you can't use @option{ssh} to log in to the remote host, then 1174If you can't use @option{ssh} to log in to the remote host, then
1127select a method that uses a program that works. For instance, Windows 1175select a method that uses a program that works. For instance, Windows
@@ -1132,9 +1180,9 @@ implementation of @command{ssh}. Or you use Kerberos and thus like
1132For the special case of editing files on the local host as another 1180For the special case of editing files on the local host as another
1133user, see the @option{su} or @option{sudo} methods. They offer 1181user, see the @option{su} or @option{sudo} methods. They offer
1134shortened syntax for the @samp{root} account, like 1182shortened syntax for the @samp{root} account, like
1135@file{@value{prefix}su@value{postfixsinglehop}@value{postfix}/etc/motd}. 1183@file{@trampfnmhl{su, , /etc/motd}}.
1136 1184
1137People who edit large files may want to consider @option{scp} instead 1185People who edit large files may want to consider @option{scpc} instead
1138of @option{ssh}, or @option{pscp} instead of @option{plink}. These 1186of @option{ssh}, or @option{pscp} instead of @option{plink}. These
1139out-of-band methods are faster than inline methods for large files. 1187out-of-band methods are faster than inline methods for large files.
1140Note, however, that out-of-band methods suffer from some limitations. 1188Note, however, that out-of-band methods suffer from some limitations.
@@ -1143,6 +1191,205 @@ from using an out-of-band method! Maybe even for large files, inline
1143methods are fast enough. 1191methods are fast enough.
1144 1192
1145 1193
1194@node Default User
1195@section Selecting a default user
1196@cindex default user
1197
1198The user part of a @value{tramp} file name can be omitted. Usually,
1199it is replaced by the user name you are logged in. Often, this is not
1200what you want. A typical use of @value{tramp} might be to edit some
1201files with root permissions on the local host. This case, you should
1202set the variable @code{tramp-default-user} to reflect that choice.
1203For example:
1204
1205@lisp
1206(setq tramp-default-user "root")
1207@end lisp
1208
1209@code{tramp-default-user} is regarded as obsolete, and will be removed
1210soon.
1211
1212@vindex tramp-default-user-alist
1213You can also specify different users for certain method/host
1214combinations, via the variable @code{tramp-default-user-alist}. For
1215example, if you always have to use the user @samp{john} in the domain
1216@samp{somewhere.else}, you can specify the following:
1217
1218@lisp
1219(add-to-list 'tramp-default-user-alist
1220 '("ssh" ".*\\.somewhere\\.else\\'" "john"))
1221@end lisp
1222
1223@noindent
1224See the documentation for the variable
1225@code{tramp-default-user-alist} for more details.
1226
1227One trap to fall in must be known. If @value{tramp} finds a default
1228user, this user will be passed always to the connection command as
1229parameter (for example @samp{ssh here.somewhere.else -l john}. If you
1230have specified another user for your command in its configuration
1231files, @value{tramp} cannot know it, and the remote access will fail.
1232If you have specified in the given example in @file{~/.ssh/config} the
1233lines
1234
1235@example
1236Host here.somewhere.else
1237 User lily
1238@end example
1239
1240@noindent
1241than you must discard selecting a default user by @value{tramp}. This
1242will be done by setting it to @code{nil} (or @samp{lily}, likewise):
1243
1244@lisp
1245(add-to-list 'tramp-default-user-alist
1246 '("ssh" "\\`here\\.somewhere\\.else\\'" nil))
1247@end lisp
1248
1249The last entry in @code{tramp-default-user-alist} could be your
1250default user you'll apply predominantly. You shall @emph{append} it
1251to that list at the end:
1252
1253@lisp
1254(add-to-list 'tramp-default-user-alist '(nil nil "jonas") t)
1255@end lisp
1256
1257
1258@node Default Host
1259@section Selecting a default host
1260@cindex default host
1261
1262@vindex tramp-default-host
1263Finally, it is even possible to omit the host name part of a
1264@value{tramp} file name. This case, the value of the variable
1265@code{tramp-default-host} is used. Per default, it is initialized
1266with the host name your local @value{emacsname} is running.
1267
1268If you, for example, use @value{tramp} mainly to contact the host
1269@samp{target} as user @samp{john}, you can specify:
1270
1271@lisp
1272(setq tramp-default-user "john"
1273 tramp-default-host "target")
1274@end lisp
1275
1276Then the simple file name @samp{@trampfnmhl{ssh,,}} will connect you
1277to John's home directory on target.
1278@ifset emacs
1279Note, however, that the most simplification @samp{@trampfnmhl{,,}}
1280won't work, because @samp{/:} is the prefix for quoted file names.
1281@end ifset
1282
1283
1284@node Multi-hops
1285@section Connecting to a remote host using multiple hops
1286@cindex multi-hop
1287@cindex proxy hosts
1288
1289Sometimes, the methods described before are not sufficient. Sometimes,
1290it is not possible to connect to a remote host using a simple command.
1291For example, if you are in a secured network, you might have to log in
1292to a `bastion host' first before you can connect to the outside world.
1293Of course, the target host may also require a bastion host.
1294
1295@vindex tramp-default-proxies-alist
1296In order to specify such multiple hops, it is possible to define a proxy
1297host to pass through, via the variable
1298@code{tramp-default-proxies-alist}. This variable keeps a list of
1299triples (@var{host} @var{user} @var{proxy}).
1300
1301 The first matching item specifies the proxy host to be passed for a
1302file name located on a remote target matching @var{user}@@@var{host}.
1303@var{host} and @var{user} are regular expressions or @code{nil}, which
1304is interpreted as a regular expression which always matches.
1305
1306@var{proxy} must be a Tramp filename which localname part is ignored.
1307Method and user name on @var{proxy} are optional, which is interpreted
1308with the default values.
1309@ifset emacsgw
1310The method must be an inline or gateway method (@pxref{Inline
1311methods}, @pxref{Gateway methods}).
1312@end ifset
1313@ifclear emacsgw
1314The method must be an inline method (@pxref{Inline methods}).
1315@end ifclear
1316If @var{proxy} is @code{nil}, no additional hop is required reaching
1317@var{user}@@@var{host}.
1318
1319If you, for example, must pass the host @samp{bastion.your.domain} as
1320user @samp{bird} for any remote host which is not located in your local
1321domain, you can set
1322
1323@lisp
1324(add-to-list 'tramp-default-proxies-alist
1325 '("\\." nil "@trampfn{ssh, bird, bastion.your.domain,}"))
1326(add-to-list 'tramp-default-proxies-alist
1327 '("\\.your\\.domain\\'" nil nil))
1328@end lisp
1329
1330Please note the order of the code. @code{add-to-list} adds elements at the
1331beginning of a list. Therefore, most relevant rules must be added last.
1332
1333Proxy hosts can be cascaded. If there is another host called
1334@samp{jump.your.domain}, which is the only one in your local domain who
1335is allowed connecting @samp{bastion.your.domain}, you can add another
1336rule:
1337
1338@lisp
1339(add-to-list 'tramp-default-proxies-alist
1340 '("\\`bastion\\.your\\.domain\\'"
1341 "\\`bird\\'"
1342 "@trampfnmhl{ssh, jump.your.domain,}"))
1343@end lisp
1344
1345@var{proxy} can contain the patterns @code{%h} or @code{%u}. These
1346patterns are replaced by the strings matching @var{host} or
1347@var{user}, respectively.
1348
1349If you, for example, wants to work as @samp{root} on hosts in the
1350domain @samp{your.domain}, but login as @samp{root} is disabled for
1351non-local access, you might add the following rule:
1352
1353@lisp
1354(add-to-list 'tramp-default-proxies-alist
1355 '("\\.your\\.domain\\'" "\\`root\\'" "@trampfnmhl{ssh, %h,}"))
1356@end lisp
1357
1358Opening @file{@trampfnmhl{sudo, randomhost.your.domain,}} would
1359connect first @samp{randomhost.your.domain} via @code{ssh} under your
1360account name, and perform @code{sudo -u root} on that host afterwards.
1361It is important to know that the given method is applied on the host
1362which has been reached so far. @code{sudo -u root}, applied on your
1363local host, wouldn't be useful here.
1364
1365This is the recommended configuration to work as @samp{root} on remote
1366Ubuntu hosts.
1367
1368@ifset emacsgw
1369Finally, @code{tramp-default-proxies-alist} can be used to pass
1370firewalls or proxy servers. Imagine your local network has a host
1371@samp{proxy.your.domain} which is used on port 3128 as HTTP proxy to
1372the outer world. Your friendly administrator has granted you access
1373under your user name to @samp{host.other.domain} on that proxy
1374server.@footnote{HTTP tunnels are intended for secure SSL/TLS
1375communication. Therefore, many proxy server restrict the tunnels to
1376related target ports. You might need to run your ssh server on your
1377target host @samp{host.other.domain} on such a port, like 443 (https).
1378See @uref{http://savannah.gnu.org/maintenance/CvsFromBehindFirewall}
1379for discussion of ethical issues.} You would need to add the
1380following rule:
1381
1382@lisp
1383(add-to-list 'tramp-default-proxies-alist
1384 '("\\`host\\.other\\.domain\\'" nil
1385 "@trampfnmhl{tunnel, proxy.your.domain#3128,}"))
1386@end lisp
1387
1388Gateway methods can be declared as first hop only in a multiple hop
1389chain.
1390@end ifset
1391
1392
1146@node Customizing Methods 1393@node Customizing Methods
1147@section Using Non-Standard Methods 1394@section Using Non-Standard Methods
1148@cindex customizing methods 1395@cindex customizing methods
@@ -1263,8 +1510,8 @@ you might provide such a function as well. This function must meet
1263the following conventions: 1510the following conventions:
1264 1511
1265@defun my-tramp-parse file 1512@defun my-tramp-parse file
1266@var{file} must be either a file name on your host, or @code{nil}. The 1513@var{file} must be either a file name on your host, or @code{nil}.
1267function must return a list of (@var{user} @var{host}), which are 1514The function must return a list of (@var{user} @var{host}), which are
1268taken as candidates for user and host name completion. 1515taken as candidates for user and host name completion.
1269 1516
1270Example: 1517Example:
@@ -1309,16 +1556,44 @@ can be disabled totally by customizing the variable
1309@code{password-cache} (setting it to @code{nil}). 1556@code{password-cache} (setting it to @code{nil}).
1310 1557
1311Implementation Note: password caching is based on the package 1558Implementation Note: password caching is based on the package
1312password.el in No Gnus. For the time being, it is activated only when 1559@file{password.el} in No Gnus. For the time being, it is activated
1313this package is seen in the @code{load-path} while loading @value{tramp}. 1560only when this package is seen in the @code{load-path} while loading
1561@value{tramp}.
1314@ifset installchapter 1562@ifset installchapter
1315If you don't use No Gnus, you can take password.el from the @value{tramp} 1563If you don't use No Gnus, you can take @file{password.el} from the
1316@file{contrib} directory, see @ref{Installation parameters}. 1564@value{tramp} @file{contrib} directory, see @ref{Installation
1565parameters}.
1317@end ifset 1566@end ifset
1318It will be activated mandatory once No Gnus has found its way into 1567It will be activated mandatory once No Gnus has found its way into
1319@value{emacsname}. 1568@value{emacsname}.
1320 1569
1321 1570
1571@node Connection caching
1572@section Reusing connection related information.
1573@cindex caching
1574
1575@vindex tramp-persistency-file-name
1576In order to reduce initial connection time, @value{tramp} stores
1577connection related information persistently. The variable
1578@code{tramp-persistency-file-name} keeps the file name where these
1579information are written. Its default value is
1580@ifset emacs
1581@file{~/.emacs.d/tramp}.
1582@end ifset
1583@ifset xemacs
1584@file{~/.xemacs/tramp}.
1585@end ifset
1586It is recommended to choose a local file name.
1587
1588@value{tramp} reads this file during startup, and writes it when
1589exiting @value{emacsname}. You can simply remove this file if
1590@value{tramp} shall be urged to recompute these information next
1591@value{emacsname} startup time.
1592
1593Using such persistent information can be disabled by setting
1594@code{tramp-persistency-file-name} to @code{nil}.
1595
1596
1322@node Remote Programs 1597@node Remote Programs
1323@section How @value{tramp} finds and uses programs on the remote machine. 1598@section How @value{tramp} finds and uses programs on the remote machine.
1324 1599
@@ -1327,25 +1602,32 @@ function, including @command{ls}, @command{test}, @command{find} and
1327@command{cat}. 1602@command{cat}.
1328 1603
1329In addition to these required tools, there are various tools that may be 1604In addition to these required tools, there are various tools that may be
1330required based on the connection method. See @ref{Inline methods} and 1605required based on the connection method. See @ref{Inline methods} and
1331@ref{External transfer methods} for details on these. 1606@ref{External transfer methods} for details on these.
1332 1607
1333Certain other tools, such as @command{perl} (or @command{perl5}) and 1608Certain other tools, such as @command{perl} (or @command{perl5}) and
1334@command{grep} will be used if they can be found. When they are 1609@command{grep} will be used if they can be found. When they are
1335available, they are used to improve the performance and accuracy of 1610available, they are used to improve the performance and accuracy of
1336remote file access. 1611remote file access.
1337 1612
1338@vindex tramp-remote-path 1613@vindex tramp-remote-path
1339When @value{tramp} connects to the remote machine, it searches for the 1614When @value{tramp} connects to the remote machine, it searches for the
1340programs that it can use. The variable @var{tramp-remote-path} controls 1615programs that it can use. The variable @code{tramp-remote-path}
1341the directories searched on the remote machine. 1616controls the directories searched on the remote machine.
1342 1617
1343By default, this is set to a reasonable set of defaults for most 1618By default, this is set to a reasonable set of defaults for most
1344machines. It is possible, however, that your local (or remote ;) system 1619machines. The symbol @code{tramp-default-remote-path} is a place
1620holder, it is replaced by the list of directories received via the
1621command @command{getconf PATH} on your remote machine. For example,
1622on GNU Debian this is @file{/bin:/usr/bin}, whereas on Solaris this is
1623@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin}. It is
1624recommended to apply this symbol on top of @code{tramp-remote-path}.
1625
1626It is possible, however, that your local (or remote ;) system
1345administrator has put the tools you want in some obscure local 1627administrator has put the tools you want in some obscure local
1346directory. 1628directory.
1347 1629
1348In this case, you can still use them with @value{tramp}. You simply need to 1630In this case, you can still use them with @value{tramp}. You simply need to
1349add code to your @file{.emacs} to add the directory to the remote path. 1631add code to your @file{.emacs} to add the directory to the remote path.
1350This will then be searched by @value{tramp} when you connect and the software 1632This will then be searched by @value{tramp} when you connect and the software
1351found. 1633found.
@@ -1433,20 +1715,37 @@ circumstances.
1433 1715
1434Some people invoke the @command{tset} program from their shell startup 1716Some people invoke the @command{tset} program from their shell startup
1435scripts which asks the user about the terminal type of the shell. 1717scripts which asks the user about the terminal type of the shell.
1436Maybe some shells ask other questions when they are started. @value{tramp} 1718Maybe some shells ask other questions when they are started.
1437does not know how to answer these questions. There are two approaches 1719@value{tramp} does not know how to answer these questions. There are
1438for dealing with this problem. One approach is to take care that the 1720two approaches for dealing with this problem. One approach is to take
1439shell does not ask any questions when invoked from @value{tramp}. You can 1721care that the shell does not ask any questions when invoked from
1440do this by checking the @code{TERM} environment variable, it will be 1722@value{tramp}. You can do this by checking the @code{TERM}
1441set to @code{dumb} when connecting. 1723environment variable, it will be set to @code{dumb} when connecting.
1442 1724
1443@vindex tramp-terminal-type 1725@vindex tramp-terminal-type
1444The variable @code{tramp-terminal-type} can be used to change this value 1726The variable @code{tramp-terminal-type} can be used to change this value
1445to @code{dumb}. 1727to @code{dumb}.
1446 1728
1729@vindex tramp-actions-before-shell
1447The other approach is to teach @value{tramp} about these questions. See 1730The other approach is to teach @value{tramp} about these questions. See
1448the variables @code{tramp-actions-before-shell} and 1731the variable @code{tramp-actions-before-shell}. Example:
1449@code{tramp-multi-actions} (for multi-hop connections). 1732
1733@lisp
1734(defconst my-tramp-prompt-regexp
1735 (concat (regexp-opt '("Enter the birth date of your mother:") t)
1736 "\\s-*")
1737 "Regular expression matching my login prompt question.")
1738
1739(defun my-tramp-action (proc vec)
1740 "Enter \"19000101\" in order to give a correct answer."
1741 (save-window-excursion
1742 (with-current-buffer (tramp-get-connection-buffer vec)
1743 (tramp-message vec 6 "\n%s" (buffer-string))
1744 (tramp-send-string vec "19000101"))))
1745
1746(add-to-list 'tramp-actions-before-shell
1747 '(my-tramp-prompt-regexp my-tramp-action))
1748@end lisp
1450 1749
1451 1750
1452@item Environment variables named like users in @file{.profile} 1751@item Environment variables named like users in @file{.profile}
@@ -1484,10 +1783,10 @@ of the single character tilde, strange things will happen.
1484 1783
1485What can you do about this? 1784What can you do about this?
1486 1785
1487Well, one possibility is to make sure that everything in @file{~/.shrc} 1786Well, one possibility is to make sure that everything in
1488and @file{~/.profile} on all remote hosts is Bourne-compatible. In the 1787@file{~/.shrc} and @file{~/.profile} on all remote hosts is
1489above example, instead of @command{export FOO=bar}, you might use 1788Bourne-compatible. In the above example, instead of @command{export
1490@command{FOO=bar; export FOO} instead. 1789FOO=bar}, you might use @command{FOO=bar; export FOO} instead.
1491 1790
1492The other possibility is to put your non-Bourne shell setup into some 1791The other possibility is to put your non-Bourne shell setup into some
1493other files. For example, bash reads the file @file{~/.bash_profile} 1792other files. For example, bash reads the file @file{~/.bash_profile}
@@ -1528,13 +1827,13 @@ variable
1528@ifset xemacs 1827@ifset xemacs
1529@code{bkup-backup-directory-info}. 1828@code{bkup-backup-directory-info}.
1530@end ifset 1829@end ifset
1531In connection with @value{tramp}, this can have unexpected side effects. 1830In connection with @value{tramp}, this can have unexpected side
1532Suppose that you specify that all backups should go to the directory 1831effects. Suppose that you specify that all backups should go to the
1533@file{~/.emacs.d/backups/}, and then you edit the file 1832directory @file{~/.emacs.d/backups/}, and then you edit the file
1534@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}/etc/secretfile}. 1833@file{@trampfn{su, root, localhost, /etc/secretfile}}. The effect is
1535The effect is that the backup file will be owned by you and not by 1834that the backup file will be owned by you and not by root, thus
1536root, thus possibly enabling others to see it even if they were not 1835possibly enabling others to see it even if they were not intended to
1537intended to see it. 1836see it.
1538 1837
1539When 1838When
1540@ifset emacs 1839@ifset emacs
@@ -1608,14 +1907,15 @@ Example:
1608@end ifset 1907@end ifset
1609 1908
1610@noindent 1909@noindent
1611The backup file name of 1910The backup file name of @file{@trampfn{su, root, localhost,
1612@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}/etc/secretfile} 1911/etc/secretfile}} would be
1613would be
1614@ifset emacs 1912@ifset emacs
1615@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~} 1913@file{@trampfn{su, root, localhost,
1914~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}
1616@end ifset 1915@end ifset
1617@ifset xemacs 1916@ifset xemacs
1618@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~} 1917@file{@trampfn{su, root, localhost,
1918~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}
1619@end ifset 1919@end ifset
1620 1920
1621The same problem can happen with auto-saving files. 1921The same problem can happen with auto-saving files.
@@ -1669,8 +1969,8 @@ can find information about setting up Cygwin in their FAQ at
1669If you wish to use the @option{scpx} connection method, then you might 1969If you wish to use the @option{scpx} connection method, then you might
1670have the problem that @value{emacsname} calls @command{scp} with a 1970have the problem that @value{emacsname} calls @command{scp} with a
1671Windows filename such as @code{c:/foo}. The Cygwin version of 1971Windows filename such as @code{c:/foo}. The Cygwin version of
1672@command{scp} does not know about Windows filenames and interprets this 1972@command{scp} does not know about Windows filenames and interprets
1673as a remote filename on the host @code{c}. 1973this as a remote filename on the host @code{c}.
1674 1974
1675One possible workaround is to write a wrapper script for @option{scp} 1975One possible workaround is to write a wrapper script for @option{scp}
1676which converts the Windows filename to a Cygwinized filename. 1976which converts the Windows filename to a Cygwinized filename.
@@ -1696,9 +1996,9 @@ know anything at all about Windows@dots{}
1696@chapter Using @value{tramp} 1996@chapter Using @value{tramp}
1697@cindex using @value{tramp} 1997@cindex using @value{tramp}
1698 1998
1699Once you have installed @value{tramp} it will operate fairly transparently. You 1999Once you have installed @value{tramp} it will operate fairly
1700will be able to access files on any remote machine that you can log in 2000transparently. You will be able to access files on any remote machine
1701to as though they were local. 2001that you can log in to as though they were local.
1702 2002
1703Files are specified to @value{tramp} using a formalized syntax specifying the 2003Files are specified to @value{tramp} using a formalized syntax specifying the
1704details of the system to connect to. This is similar to the syntax used 2004details of the system to connect to. This is similar to the syntax used
@@ -1717,10 +2017,9 @@ minute you have already forgotten that you hit that key!
1717 2017
1718@menu 2018@menu
1719* Filename Syntax:: @value{tramp} filename conventions. 2019* Filename Syntax:: @value{tramp} filename conventions.
1720* Multi-hop filename syntax:: Multi-hop filename conventions. 2020* Alternative Syntax:: URL-like filename syntax.
1721* Filename completion:: Filename completion. 2021* Filename completion:: Filename completion.
1722* Dired:: Dired. 2022* Remote processes:: Integration with other @value{emacsname} packages.
1723* Compilation:: Compile remote files.
1724@end menu 2023@end menu
1725 2024
1726 2025
@@ -1729,123 +2028,107 @@ minute you have already forgotten that you hit that key!
1729@cindex filename syntax 2028@cindex filename syntax
1730@cindex filename examples 2029@cindex filename examples
1731 2030
1732To access the file @var{localname} on the remote machine @var{machine} you 2031To access the file @var{localname} on the remote machine @var{machine}
1733would specify the filename 2032you would specify the filename @file{@trampfnhl{@var{machine},
1734@file{@value{prefix}@var{machine}@value{postfix}@var{localname}}. 2033@var{localname}}}. This will connect to @var{machine} and transfer
1735This will connect to @var{machine} and transfer the file using the 2034the file using the default method. @xref{Default Method}.
1736default method. @xref{Default Method}.
1737 2035
1738Some examples of @value{tramp} filenames are shown below. 2036Some examples of @value{tramp} filenames are shown below.
1739 2037
1740@table @file 2038@table @file
1741@item @value{prefix}melancholia@value{postfix}.emacs 2039@item @trampfnhl{melancholia, .emacs}
1742Edit the file @file{.emacs} in your home directory on the machine 2040Edit the file @file{.emacs} in your home directory on the machine
1743@code{melancholia}. 2041@code{melancholia}.
1744 2042
1745@item @value{prefix}melancholia.danann.net@value{postfix}.emacs 2043@item @trampfnhl{melancholia.danann.net, .emacs}
1746This edits the same file, using the fully qualified domain name of 2044This edits the same file, using the fully qualified domain name of
1747the machine. 2045the machine.
1748 2046
1749@item @value{prefix}melancholia@value{postfix}~/.emacs 2047@item @trampfnhl{melancholia, ~/.emacs}
1750This also edits the same file --- the @file{~} is expanded to your 2048This also edits the same file --- the @file{~} is expanded to your
1751home directory on the remote machine, just like it is locally. 2049home directory on the remote machine, just like it is locally.
1752 2050
1753@item @value{prefix}melancholia@value{postfix}~daniel/.emacs 2051@item @trampfnhl{melancholia, ~daniel/.emacs}
1754This edits the file @file{.emacs} in the home directory of the user 2052This edits the file @file{.emacs} in the home directory of the user
1755@code{daniel} on the machine @code{melancholia}. The @file{~<user>} 2053@code{daniel} on the machine @code{melancholia}. The @file{~<user>}
1756construct is expanded to the home directory of that user on the remote 2054construct is expanded to the home directory of that user on the remote
1757machine. 2055machine.
1758 2056
1759@item @value{prefix}melancholia@value{postfix}/etc/squid.conf 2057@item @trampfnhl{melancholia, /etc/squid.conf}
1760This edits the file @file{/etc/squid.conf} on the machine 2058This edits the file @file{/etc/squid.conf} on the machine
1761@code{melancholia}. 2059@code{melancholia}.
1762 2060
1763@end table 2061@end table
1764 2062
1765Unless you specify a different name to use, @value{tramp} will use the 2063Unless you specify a different name to use, @value{tramp} will use the
1766current local user name as the remote user name to log in with. If you 2064current local user name as the remote user name to log in with. If you
1767need to log in as a different user, you can specify the user name as 2065need to log in as a different user, you can specify the user name as
1768part of the filename. 2066part of the filename.
1769 2067
1770To log in to the remote machine as a specific user, you use the syntax 2068To log in to the remote machine as a specific user, you use the syntax
1771@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}/@var{path/to.file}}. 2069@file{@trampfnuhl{@var{user}, @var{machine}, @var{path/to.file}}}.
1772That means that connecting to @code{melancholia} as @code{daniel} and 2070That means that connecting to @code{melancholia} as @code{daniel} and
1773editing @file{.emacs} in your home directory you would specify 2071editing @file{.emacs} in your home directory you would specify
1774@file{@value{prefix}daniel@@melancholia@value{postfix}.emacs}. 2072@file{@trampfnuhl{daniel, melancholia, .emacs}}.
1775 2073
1776It is also possible to specify other file transfer methods 2074It is also possible to specify other file transfer methods
1777(@pxref{Default Method}) as part of the filename. 2075(@pxref{Default Method}) as part of the filename.
1778@ifset emacs 2076@ifset emacs
1779This is done by putting the method before the user and host name, as 2077This is done by putting the method before the user and host name, as
1780in 2078in @file{@value{prefix}@var{method}@value{postfixhop}} (Note the
1781@file{@value{prefix}@var{method}@value{postfixsinglehop}} 2079trailing colon).
1782(Note the trailing colon).
1783@end ifset 2080@end ifset
1784@ifset xemacs 2081@ifset xemacs
1785This is done by replacing the initial 2082This is done by replacing the initial @file{@value{prefix}} with
1786@file{@value{prefix}} with 2083@file{@value{prefix}<method>@value{postfixhop}}. (Note the trailing
1787@file{@value{prefix}<method>@value{postfixsinglehop}}. 2084slash!).
1788(Note the trailing slash!).
1789@end ifset 2085@end ifset
1790The user, machine and file specification remain the same. 2086The user, machine and file specification remain the same.
1791 2087
1792So, to connect to the machine @code{melancholia} as @code{daniel}, 2088So, to connect to the machine @code{melancholia} as @code{daniel},
1793using the @option{ssh} method to transfer files, and edit @file{.emacs} 2089using the @option{ssh} method to transfer files, and edit
1794in my home directory I would specify the filename 2090@file{.emacs} in my home directory I would specify the filename
1795@file{@value{prefix}ssh@value{postfixsinglehop}daniel@@melancholia@value{postfix}.emacs}. 2091@file{@trampfn{ssh, daniel, melancholia, .emacs}}.
1796 2092
1797 2093
1798@node Multi-hop filename syntax 2094@node Alternative Syntax
1799@section Multi-hop filename conventions 2095@section URL-like filename syntax
1800@cindex filename syntax for multi-hop files 2096@cindex filename syntax
1801@cindex multi-hop filename syntax 2097@cindex filename examples
1802 2098
1803The syntax of multi-hop file names is necessarily slightly different 2099Additionally to the syntax described in the previous chapter, it is
1804than the syntax of other @value{tramp} file names. Here's an example 2100possible to use a URL-like syntax for @value{tramp}. This can be
1805multi-hop file name: 2101switched on by customizing the variable @code{tramp-syntax}. Please
2102note that this feature is experimental for the time being.
1806 2103
1807@example 2104The variable @code{tramp-syntax} must be set before requiring @value{tramp}:
1808@value{prefix}multi@value{postfixsinglehop}rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host@value{postfix}/path/to.file
1809@end example
1810
1811This is quite a mouthful. So let's go through it step by step. The
1812file name consists of three parts.
1813@ifset emacs
1814The parts are separated by colons
1815@end ifset
1816@ifset xemacs
1817The parts are separated by slashes and square brackets.
1818@end ifset
1819The first part is @file{@value{prefix}multi}, the method
1820specification. The second part is
1821@file{rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host}
1822and specifies the hops. The final part is @file{/path/to.file} and
1823specifies the file name on the remote host.
1824 2105
1825The first part and the final part should be clear. See @ref{Multi-hop 2106@lisp
1826Methods}, for a list of alternatives for the method specification. 2107(setq tramp-syntax 'url)
2108(require 'tramp)
2109@end lisp
1827 2110
1828The second part can be subdivided again into components, so-called 2111Then, a @value{tramp} filename would look like this:
1829hops. In the above file name, there are two hops, 2112@file{/@var{method}://@var{user}@@@var{machine}:@var{port}/@var{path/to.file}}.
1830@file{rsh@value{postfixmultihop}out@@gate} and 2113@file{/@var{method}://} is mandatory, all other parts are optional.
1831@file{telnet@value{postfixmultihop}kai@@real.host}. 2114@file{:@var{port}} is useful for methods only who support this.
1832 2115
1833Each hop can @emph{again} be subdivided into (three) components, the 2116The last example from the previous section would look like this:
1834@dfn{hop method}, the @dfn{user name} and the @dfn{host name}. The 2117@file{/ssh://daniel@@melancholia/.emacs}.
1835meaning of the second and third component should be clear, and the hop
1836method says what program to use to perform that hop.
1837 2118
1838The first hop, @file{rsh@value{postfixmultihop}out@@gate}, 2119For the time being, @code{tramp-syntax} can have the following values:
1839says to use @command{rsh} to log in as user @code{out} to the host
1840@code{gate}. Starting at that host, the second hop,
1841@file{telnet@value{postfixmultihop}kai@@real.host}, says to
1842use @command{telnet} to log in as user @code{kai} to host
1843@code{real.host}.
1844 2120
1845@xref{Multi-hop Methods}, for a list of possible hop method values. 2121@itemize @w{}
1846The variable @code{tramp-multi-connection-function-alist} contains the 2122@ifset emacs
1847list of possible hop methods and information on how to execute them, 2123@item @code{ftp} -- That is the default syntax
1848should you want to add your own. 2124@item @code{url} -- URL-like syntax
2125@end ifset
2126@ifset xemacs
2127@item @code{sep} -- That is the default syntax
2128@item @code{url} -- URL-like syntax
2129@item @code{ftp} -- EFS-like syntax
2130@end ifset
2131@end itemize
1849 2132
1850 2133
1851@node Filename completion 2134@node Filename completion
@@ -1853,10 +2136,20 @@ should you want to add your own.
1853@cindex filename completion 2136@cindex filename completion
1854 2137
1855Filename completion works with @value{tramp} for completion of method 2138Filename completion works with @value{tramp} for completion of method
1856names, of user names and of machine names (except multi-hop methods) 2139names, of user names and of machine names as well as for completion of
1857as well as for completion of file names on remote machines. 2140file names on remote machines.
1858@ifset emacs 2141@ifset emacs
1859In order to enable this, Partial Completion mode must be set on. 2142In order to enable this, Partial Completion mode must be set
2143on@footnote{If you don't use Partial Completion mode, but want to
2144keep full completion, load @value{tramp} like this in your
2145@file{.emacs}:
2146
2147@lisp
2148;; Preserve Tramp's completion features.
2149(let ((partial-completion-mode t))
2150 (require 'tramp))
2151@end lisp
2152}.
1860@ifinfo 2153@ifinfo
1861@xref{Completion Options, , , @value{emacsdir}}. 2154@xref{Completion Options, , , @value{emacsdir}}.
1862@end ifinfo 2155@end ifinfo
@@ -1867,85 +2160,184 @@ If you, for example, type @kbd{C-x C-f @value{prefix}t
1867 2160
1868@example 2161@example
1869@ifset emacs 2162@ifset emacs
1870@value{prefixsinglehop}telnet@value{postfixsinglehop} tmp/ 2163@value{prefixhop}telnet@value{postfixhop} tmp/
1871@value{prefixsinglehop}toto@value{postfix} 2164@value{prefixhop}toto@value{postfix}
1872@end ifset 2165@end ifset
1873@ifset xemacs 2166@ifset xemacs
1874@value{prefixsinglehop}telnet@value{postfixsinglehop} @value{prefixsinglehop}toto@value{postfix} 2167@value{prefixhop}telnet@value{postfixhop} @value{prefixhop}toto@value{postfix}
1875@end ifset 2168@end ifset
1876@end example 2169@end example
1877 2170
1878@samp{@value{prefixsinglehop}telnet@value{postfixsinglehop}} 2171@samp{@value{prefixhop}telnet@value{postfixhop}}
1879is a possible completion for the respective method, 2172is a possible completion for the respective method,
1880@ifset emacs 2173@ifset emacs
1881@samp{tmp/} stands for the directory @file{/tmp} on your local 2174@samp{tmp/} stands for the directory @file{/tmp} on your local
1882machine, 2175machine,
1883@end ifset 2176@end ifset
1884and @samp{@value{prefixsinglehop}toto@value{postfix}} 2177and @samp{@value{prefixhop}toto@value{postfix}}
1885might be a host @value{tramp} has detected in your @file{~/.ssh/known_hosts} 2178might be a host @value{tramp} has detected in your @file{~/.ssh/known_hosts}
1886file (given you're using default method @option{ssh}). 2179file (given you're using default method @option{ssh}).
1887 2180
1888If you go on to type @kbd{e @key{TAB}}, the minibuffer is completed to 2181If you go on to type @kbd{e @key{TAB}}, the minibuffer is completed to
1889@samp{@value{prefix}telnet@value{postfixsinglehop}}. 2182@samp{@value{prefix}telnet@value{postfixhop}}.
1890Next @kbd{@key{TAB}} brings you all machine names @value{tramp} detects in 2183Next @kbd{@key{TAB}} brings you all machine names @value{tramp} detects in
1891your @file{/etc/hosts} file, let's say 2184your @file{/etc/hosts} file, let's say
1892 2185
1893@example 2186@example
1894@value{prefixsinglehop}telnet@value{postfixsinglehop}127.0.0.1@value{postfix} @value{prefixsinglehop}telnet@value{postfixsinglehop}192.168.0.1@value{postfix} 2187@trampfnmhl{telnet,127.0.0.1,} @trampfnmhl{telnet,192.168.0.1,}
1895@value{prefixsinglehop}telnet@value{postfixsinglehop}localhost@value{postfix} @value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia.danann.net@value{postfix} 2188@trampfnmhl{telnet,localhost,} @trampfnmhl{telnet,melancholia.danann.net,}
1896@value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia@value{postfix} 2189@trampfnmhl{telnet,melancholia,}
1897@end example 2190@end example
1898 2191
1899Now you can choose the desired machine, and you can continue to 2192Now you can choose the desired machine, and you can continue to
1900complete file names on that machine. 2193complete file names on that machine.
1901 2194
1902As filename completion needs to fetch the listing of files from the
1903remote machine, this feature is sometimes fairly slow. As @value{tramp}
1904does not yet cache the results of directory listing, there is no gain
1905in performance the second time you complete filenames.
1906
1907If the configuration files (@pxref{Customizing Completion}), which 2195If the configuration files (@pxref{Customizing Completion}), which
1908@value{tramp} uses for analysis of completion, offer user names, those user 2196@value{tramp} uses for analysis of completion, offer user names, those user
1909names will be taken into account as well. 2197names will be taken into account as well.
1910 2198
2199Remote machines, which have been visited in the past and kept
2200persistently (@pxref{Connection caching}), will be offered too.
1911 2201
1912@node Dired 2202Once the remote machine identification is completed, it comes to
1913@section Dired 2203filename completion on the remote host. This works pretty much like
1914@cindex dired 2204for files on the local host, with the exception that minibuffer
2205killing via a double-slash works only on the filename part, except
2206that filename part starts with @file{//}.
2207@ifinfo
2208@xref{Minibuffer File, , , @value{emacsdir}}.
2209@end ifinfo
1915 2210
1916@value{tramp} works transparently with dired, enabling you to use this powerful 2211@ifset emacs
1917file management tool to manage files on any machine you have access to 2212As example, @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin//etc}
1918over the Internet. 2213@key{TAB}} would result in
2214@file{@trampfnmhl{telnet,melancholia,/etc}}, whereas
2215@kbd{@trampfnmhl{telnet,melancholia,//etc} @key{TAB}} reduces the
2216minibuffer contents to @file{/etc}. A triple-slash stands for the
2217default behaviour,
2218i.e. @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin///etc}
2219@key{TAB}} expands directly to @file{/etc}.
2220@end ifset
1919 2221
1920If you need to browse a directory tree, Dired is a better choice, at 2222@ifset xemacs
1921present, than filename completion. Dired has its own cache mechanism 2223As example, @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin//}}
1922and will only fetch the directory listing once. 2224would result in @file{@trampfnmhl{telnet,melancholia,/}}, whereas
2225@kbd{@trampfnmhl{telnet,melancholia,//}} expands the minibuffer
2226contents to @file{/}.
2227@end ifset
1923 2228
1924 2229
1925@node Compilation 2230@node Remote processes
1926@section Compile remote files 2231@section Integration with other @value{emacsname} packages.
1927@cindex compile 2232@cindex compile
1928@cindex recompile 2233@cindex recompile
1929 2234
1930@value{tramp} provides commands for compilation of files on remote 2235@value{tramp} supports running processes on a remote host. This
1931machines. In order to get them loaded, you need to require 2236allows to exploit @value{emacsname} packages without modification for
1932@file{tramp-util.el}: 2237remote file names. It does not work for the @option{ftp} and
2238@option{smb} methods.
2239
2240Remote processes are started when a corresponding command is executed
2241from a buffer belonging to a remote file or directory. Up to now, the
2242packages @file{compile.el} (commands like @code{compile} and
2243@code{grep}) and @file{gud.el} (@code{gdb} or @code{perldb}) have been
2244integrated. Integration of further packages is planned, any help for
2245this is welcome!
2246
2247When your program is not found in the default search path
2248@value{tramp} sets on the remote machine, you should either use an
2249absolute path, or extend @code{tramp-remote-path} (see @ref{Remote
2250Programs}):
2251
2252@lisp
2253(add-to-list 'tramp-remote-path "~/bin")
2254(add-to-list 'tramp-remote-path "/appli/pub/bin")
2255@end lisp
2256
2257The environment for your program can be adapted by customizing
2258@code{tramp-remote-process-environment}. This variable is a list of
2259strings. It is structured like @code{process-environment}. Each
2260element is a string of the form ENVVARNAME=VALUE. An entry
2261ENVVARNAME= disables the corresponding environment variable, which
2262might have been set in your init file like @file{~/.profile}.
2263
2264@noindent
2265Adding an entry can be performed via @code{add-to-list}:
1933 2266
1934@lisp 2267@lisp
1935(require 'tramp-util) 2268(add-to-list 'tramp-remote-process-environment "JAVA_HOME=/opt/java")
1936@end lisp 2269@end lisp
1937 2270
1938Afterwards, you can use the commands @code{tramp-compile} and 2271Changing or removing an existing entry is not encouraged. The default
1939@code{tramp-recompile} instead of @code{compile} and @code{recompile}, 2272values are chosen for proper @value{tramp} work. Nevertheless, if for
1940respectively; @inforef{Compilation, ,@value{emacsdir}}. This does not 2273example a paranoid system administrator disallows changing the
1941work for the @option{ftp} and @option{smb} methods. 2274@var{$HISTORY} environment variable, you can customize
2275@code{tramp-remote-process-environment}, or you can apply the
2276following code in your @file{.emacs}:
2277
2278@lisp
2279(let ((process-environment tramp-remote-process-environment))
2280 (setenv "HISTORY" nil)
2281 (setq tramp-remote-process-environment process-environment))
2282@end lisp
2283
2284If you use other @value{emacsname} packages which do not run
2285out-of-the-box on a remote host, please let us know. We will try to
2286integrate them as well. @xref{Bug Reports}.
2287
2288
2289@subsection Running eshell on a remote host
2290@cindex eshell
1942 2291
1943The corresponding key bindings and menu entries calling these commands 2292@value{tramp} is integrated into @file{eshell.el}. That is, you can
1944are redefined automatically for buffers associated with remote files. 2293open an interactive shell on your remote host, and run commands there.
2294After you have started @code{eshell}, you could perform commands like
2295this:
1945 2296
1946After finishing the compilation, you can use the usual commands like 2297@example
1947@code{previous-error}, @code{next-error} and @code{first-error} for 2298@b{~ $} cd @trampfnmhl{sudo, , /etc} @key{RET}
1948navigation in the @file{*Compilation*} buffer. 2299@b{@trampfn{sudo, root, host, /etc} $} hostname @key{RET}
2300host
2301@b{@trampfn{sudo, root, host, /etc} $} id @key{RET}
2302uid=0(root) gid=0(root) groups=0(root)
2303@b{@trampfn{sudo, root, host, /etc} $} find-file shadow @key{RET}
2304#<buffer shadow>
2305@b{@trampfn{sudo, root, host, /etc} $}
2306@end example
2307
2308
2309@anchor{Running a debugger on a remote host}
2310@subsection Running a debugger on a remote host
2311@cindex gud
2312@cindex gdb
2313@cindex perldb
2314
2315@file{gud.el} offers an unified interface to several symbolic
2316debuggers
2317@ifset emacs
2318@ifinfo
2319(@ref{Debuggers, , , @value{emacsdir}}).
2320@end ifinfo
2321@end ifset
2322With @value{tramp}, it is possible to debug programs on
2323remote hosts. You can call @code{gdb} with a remote file name:
2324
2325@example
2326@kbd{M-x gdb @key{RET}}
2327@b{Run gdb (like this):} gdb --annotate=3 @trampfnmhl{ssh, host, ~/myprog} @key{RET}
2328@end example
2329
2330The file name can also be relative to a remote default directory.
2331Given you are in a buffer that belongs to the remote directory
2332@trampfnmhl{ssh, host, /home/user}, you could call
2333
2334@example
2335@kbd{M-x perldb @key{RET}}
2336@b{Run perldb (like this):} perl -d myprog.pl @key{RET}
2337@end example
2338
2339It is not possible to use just the absolute local part of a remote
2340file name, like @kbd{perl -d /home/user/myprog.pl}, though.
1949 2341
1950 2342
1951@node Bug Reports 2343@node Bug Reports
@@ -1953,7 +2345,7 @@ navigation in the @file{*Compilation*} buffer.
1953@cindex bug reports 2345@cindex bug reports
1954 2346
1955Bugs and problems with @value{tramp} are actively worked on by the 2347Bugs and problems with @value{tramp} are actively worked on by the
1956development team. Feature requests and suggestions are also more than 2348development team. Feature requests and suggestions are also more than
1957welcome. 2349welcome.
1958 2350
1959The @value{tramp} mailing list is a great place to get information on 2351The @value{tramp} mailing list is a great place to get information on
@@ -1964,16 +2356,16 @@ non-subscribers can post but messages will be delayed, possibly up to
1964your message. 2356your message.
1965 2357
1966The mailing list is at @email{tramp-devel@@gnu.org}. Messages sent to 2358The mailing list is at @email{tramp-devel@@gnu.org}. Messages sent to
1967this address go to all the subscribers. This is @emph{not} the address 2359this address go to all the subscribers. This is @emph{not} the address
1968to send subscription requests to. 2360to send subscription requests to.
1969 2361
1970Subscribing to the list is performed via 2362Subscribing to the list is performed via
1971@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/, 2363@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/,
1972the @value{tramp} Mail Subscription Page}. 2364the @value{tramp} Mail Subscription Page}.
1973 2365
1974To report a bug in @value{tramp}, you should execute @kbd{M-x tramp-bug}. This 2366To report a bug in @value{tramp}, you should execute @kbd{M-x
1975will automatically generate a buffer with the details of your system and 2367tramp-bug}. This will automatically generate a buffer with the details
1976@value{tramp} version. 2368of your system and @value{tramp} version.
1977 2369
1978When submitting a bug report, please try to describe in excruciating 2370When submitting a bug report, please try to describe in excruciating
1979detail the steps required to reproduce the problem, the setup of the 2371detail the steps required to reproduce the problem, the setup of the
@@ -1982,8 +2374,20 @@ check that your problem is not described already in @xref{Frequently
1982Asked Questions}. 2374Asked Questions}.
1983 2375
1984If you can identify a minimal test case that reproduces the problem, 2376If you can identify a minimal test case that reproduces the problem,
1985include that with your bug report. This will make it much easier for the 2377include that with your bug report. This will make it much easier for
1986development team to analyze and correct the problem. 2378the development team to analyze and correct the problem.
2379
2380Before reporting the bug, you should set the verbosity level to 6
2381(@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file and
2382repeat the bug. Then, include the contents of the @file{*tramp/foo*}
2383and @file{*debug tramp/foo*} buffers in your bug report. A verbosity
2384level greater than 6 will produce a very huge debug buffer, which is
2385mostly not necessary for the analysis.
2386
2387Please be aware that, with a verbosity level of 6 or greater, the
2388contents of files and directories will be included in the debug
2389buffer. Passwords you've typed will never be included there.
2390
1987 2391
1988@node Frequently Asked Questions 2392@node Frequently Asked Questions
1989@chapter Frequently Asked Questions 2393@chapter Frequently Asked Questions
@@ -2009,10 +2413,9 @@ There is also a Savannah project page.
2009@item 2413@item
2010Which systems does it work on? 2414Which systems does it work on?
2011 2415
2012The package has been used successfully on GNU Emacs 20, GNU Emacs 21 2416The package has been used successfully on GNU Emacs 21, GNU Emacs 22
2013and GNU Emacs 22, as well as XEmacs 21. XEmacs 20 is more 2417and XEmacs 21 (starting with 21.4). Gateway methods are supported for
2014problematic, see the notes in @file{tramp.el}. I don't think anybody 2418GNU Emacs 22 only.
2015has really tried it on GNU Emacs 19.
2016 2419
2017The package was intended to work on Unix, and it really expects a 2420The package was intended to work on Unix, and it really expects a
2018Unix-like system on the remote end (except the @option{smb} method), 2421Unix-like system on the remote end (except the @option{smb} method),
@@ -2023,13 +2426,41 @@ There is some informations on @value{tramp} on NT at the following URL;
2023many thanks to Joe Stoy for providing the information: 2426many thanks to Joe Stoy for providing the information:
2024@uref{ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/} 2427@uref{ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/}
2025 2428
2026@c The link is broken. I've contacted Tom for clarification. Michael. 2429@c The link is broken. I've contacted Tom for clarification. Michael.
2027@ignore 2430@ignore
2028The above mostly contains patches to old ssh versions; Tom Roche has a 2431The above mostly contains patches to old ssh versions; Tom Roche has a
2029Web page with instructions: 2432Web page with instructions:
2030@uref{http://www4.ncsu.edu/~tlroche/plinkTramp.html} 2433@uref{http://www4.ncsu.edu/~tlroche/plinkTramp.html}
2031@end ignore 2434@end ignore
2032 2435
2436@item
2437How could I speed up @value{tramp}?
2438
2439In the backstage, @value{tramp} needs a lot of operations on the
2440remote host. The time for transferring data from and to the remote
2441host as well as the time needed to perform the operations there count.
2442In order to speed up @value{tramp}, one could either try to avoid some
2443of the operations, or one could try to improve their performance.
2444
2445Use an external transfer method, like @option{scpc}.
2446
2447Use caching. This is already enabled by default. Information about
2448the remote host as well as the remote files are cached for reuse. Th
2449information about remote hosts is kept in the file specified in
2450@code{tramp-persistency-file-name}. Keep this file.
2451
2452Disable version control. If you access remote files which are not
2453under version control, a lot of check operations can be avoided by
2454disabling VC. This can be achieved by
2455
2456@lisp
2457(setq vc-handled-backends nil)
2458@end lisp
2459
2460Disable excessive traces. The default trace level of @value{tramp},
2461defined in the variable @code{tramp-verbose}, is 3. You should
2462increase this level only temporarily, hunting bugs.
2463
2033 2464
2034@item 2465@item
2035@value{tramp} does not connect to the remote host 2466@value{tramp} does not connect to the remote host
@@ -2048,6 +2479,17 @@ contains unknown characters like escape sequences for coloring. This
2048should be avoided on the remote side. @xref{Remote shell setup}. for 2479should be avoided on the remote side. @xref{Remote shell setup}. for
2049setting the regular expression detecting the prompt. 2480setting the regular expression detecting the prompt.
2050 2481
2482You can check your settings after an unsuccessful connection by
2483switching to the @value{tramp} connection buffer @file{*tramp/foo*},
2484setting the cursor at the top of the buffer, and applying the expression
2485
2486@example
2487@kbd{M-: (re-search-forward (concat tramp-shell-prompt-pattern "$"))}
2488@end example
2489
2490If it fails, or the cursor is not moved at the end of the buffer, your
2491prompt is not recognised correctly.
2492
2051A special problem is the zsh, which uses left-hand side and right-hand 2493A special problem is the zsh, which uses left-hand side and right-hand
2052side prompts in parallel. Therefore, it is necessary to disable the 2494side prompts in parallel. Therefore, it is necessary to disable the
2053zsh line editor on the remote host. You shall add to @file{~/.zshrc} 2495zsh line editor on the remote host. You shall add to @file{~/.zshrc}
@@ -2057,15 +2499,34 @@ the following command:
2057[ $TERM = "dumb" ] && unsetopt zle && PS1='$ ' 2499[ $TERM = "dumb" ] && unsetopt zle && PS1='$ '
2058@end example 2500@end example
2059 2501
2502
2060@item 2503@item
2061@value{tramp} doesn't transfer strings with more than 500 characters 2504@value{tramp} doesn't transfer strings with more than 500 characters
2062correctly 2505correctly
2063 2506
2064On some few systems, the implementation of @code{process-send-string} 2507On some few systems, the implementation of @code{process-send-string}
2065seems to be broken for longer strings. This case, you should 2508seems to be broken for longer strings. It is reported for HP-UX,
2066customize the variable @code{tramp-chunksize} to 500. For a 2509FreeBSD and Tru64 Unix, for example. This case, you should customize
2067description how to determine whether this is necessary see the 2510the variable @code{tramp-chunksize} to 500. For a description how to
2068documentation of @code{tramp-chunksize}. 2511determine whether this is necessary see the documentation of
2512@code{tramp-chunksize}.
2513
2514Additionally, it will be useful to set @code{file-precious-flag} to
2515@code{t} for @value{tramp} files. Then the file contents will be
2516written into a temporary file first, which is checked for correct
2517checksum.
2518@ifinfo
2519@pxref{Saving Buffers, , , elisp}
2520@end ifinfo
2521
2522@lisp
2523(add-hook
2524 'find-file-hooks
2525 '(lambda ()
2526 (when (file-remote-p default-directory)
2527 (set (make-local-variable 'file-precious-flag) t))))
2528@end lisp
2529
2069@end itemize 2530@end itemize
2070 2531
2071 2532
@@ -2117,11 +2578,13 @@ remote host.
2117 " make tramp beep after writing a file." 2578 " make tramp beep after writing a file."
2118 (interactive) 2579 (interactive)
2119 (beep)) 2580 (beep))
2581
2120(defadvice tramp-handle-do-copy-or-rename-file 2582(defadvice tramp-handle-do-copy-or-rename-file
2121 (after tramp-copy-beep-advice activate) 2583 (after tramp-copy-beep-advice activate)
2122 " make tramp beep after copying a file." 2584 " make tramp beep after copying a file."
2123 (interactive) 2585 (interactive)
2124 (beep)) 2586 (beep))
2587
2125(defadvice tramp-handle-insert-file-contents 2588(defadvice tramp-handle-insert-file-contents
2126 (after tramp-copy-beep-advice activate) 2589 (after tramp-copy-beep-advice activate)
2127 " make tramp beep after copying a file." 2590 " make tramp beep after copying a file."
@@ -2130,6 +2593,60 @@ remote host.
2130@end lisp 2593@end lisp
2131 2594
2132 2595
2596@ifset emacs
2597@item
2598I'ld like to see a host indication in the mode line when I'm remote
2599
2600The following code has been tested with @value{emacsname} 22. You
2601should put it into your @file{~/.emacs}:
2602
2603@lisp
2604(defconst my-mode-line-buffer-identification
2605 (list
2606 '(:eval
2607 (let ((host-name
2608 (if (file-remote-p default-directory)
2609 (tramp-file-name-host
2610 (tramp-dissect-file-name default-directory))
2611 (system-name))))
2612 (if (string-match "^[^0-9][^.]*\\(\\..*\\)" host-name)
2613 (substring host-name 0 (match-beginning 1))
2614 host-name)))
2615 ": %12b"))
2616
2617(setq-default
2618 mode-line-buffer-identification
2619 my-mode-line-buffer-identification)
2620
2621(add-hook
2622 'dired-mode-hook
2623 '(lambda ()
2624 (setq
2625 mode-line-buffer-identification
2626 my-mode-line-buffer-identification)))
2627@end lisp
2628@end ifset
2629
2630
2631@ifset emacs
2632@item
2633My remote host does not understand default directory listing options
2634
2635@value{emacsname} computes the @command{dired} options depending on
2636the local host you are working. If your @command{ls} command on the
2637remote host does not understand those options, you can change them
2638like this:
2639
2640@lisp
2641(add-hook
2642 'dired-before-readin-hook
2643 '(lambda ()
2644 (when (file-remote-p default-directory)
2645 (setq dired-actual-switches "-al"))))
2646@end lisp
2647@end ifset
2648
2649
2133@item 2650@item
2134There's this @file{~/.sh_history} file on the remote host which keeps 2651There's this @file{~/.sh_history} file on the remote host which keeps
2135growing and growing. What's that? 2652growing and growing. What's that?
@@ -2152,6 +2669,218 @@ fi
2152@end example 2669@end example
2153 2670
2154 2671
2672@item There are longish file names to type. How to shorten this?
2673
2674Let's say you need regularly access to @file{@trampfn{ssh, news,
2675news.my.domain, /opt/news/etc}}, which is boring to type again and
2676again. The following approaches can be mixed:
2677
2678@enumerate
2679
2680@item Use default values for method and user name:
2681
2682You can define default methods and user names for hosts,
2683(@pxref{Default Method}, @pxref{Default User}):
2684
2685@lisp
2686(setq tramp-default-method "ssh"
2687 tramp-default-user "news")
2688@end lisp
2689
2690The file name left to type would be
2691@kbd{C-x C-f @trampfnhl{news.my.domain, /opt/news/etc}}.
2692
2693Note, that there are some useful settings already. Accessing your
2694local host as @samp{root} user, is possible just by @kbd{C-x C-f
2695@trampfnmhl{su,,}}.
2696
2697@item Use configuration possibilities of your method:
2698
2699Several connection methods (i.e. the programs used) offer powerful
2700configuration possibilities (@pxref{Customizing Completion}). In the
2701given case, this could be @file{~/.ssh/config}:
2702
2703@example
2704Host xy
2705 HostName news.my.domain
2706 User news
2707@end example
2708
2709The file name left to type would be @kbd{C-x C-f @trampfnmhl{ssh, xy,
2710/opt/news/etc}}. Depending on files in your directories, it is even
2711possible to complete the hostname with @kbd{C-x C-f
2712@value{prefix}ssh@value{postfixhop}x @key{TAB}}.
2713
2714@item Use environment variables:
2715
2716File names typed in the minibuffer can be expanded by environment
2717variables. You can set them outside @value{emacsname}, or even with
2718Lisp:
2719
2720@lisp
2721(setenv "xy" "@trampfn{ssh, news, news.my.domain, /opt/news/etc/}")
2722@end lisp
2723
2724Then you need simply to type @kbd{C-x C-f $xy @key{RET}}, and here you
2725are. The disadvantage is, that you cannot edit the file name, because
2726environment variables are not expanded during editing in the
2727minibuffer.
2728
2729@item Define own keys:
2730
2731You can define your own key sequences in @value{emacsname}, which can
2732be used instead of @kbd{C-x C-f}:
2733
2734@lisp
2735(global-set-key
2736 [(control x) (control y)]
2737 (lambda ()
2738 (interactive)
2739 (find-file
2740 (read-file-name
2741 "Find Tramp file: "
2742 "@trampfn{ssh, news, news.my.domain, /opt/news/etc/}"))))
2743@end lisp
2744
2745Simply typing @kbd{C-x C-y} would initialize the minibuffer for
2746editing with your beloved file name.
2747
2748See also @uref{http://www.emacswiki.org/cgi-bin/wiki/TrampMode, the
2749Emacs Wiki} for a more comprehensive example.
2750
2751@item Define own abbreviation (1):
2752
2753It is possible to define an own abbreviation list for expanding file
2754names:
2755
2756@lisp
2757(add-to-list
2758 'directory-abbrev-alist
2759 '("^/xy" . "@trampfn{ssh, news, news.my.domain, /opt/news/etc/}"))
2760@end lisp
2761
2762This shortens the file openening command to @kbd{C-x C-f /xy
2763@key{RET}}. The disadvantage is, again, that you cannot edit the file
2764name, because the expansion happens after entering the file name only.
2765
2766@item Define own abbreviation (2):
2767
2768The @code{abbrev-mode} gives more flexibility for editing the
2769minibuffer:
2770
2771@lisp
2772(define-abbrev-table 'my-tramp-abbrev-table
2773 '(("xy" "@trampfn{ssh, news, news.my.domain, /opt/news/etc/}")))
2774
2775(add-hook
2776 'minibuffer-setup-hook
2777 '(lambda ()
2778 (abbrev-mode 1)
2779 (setq local-abbrev-table my-tramp-abbrev-table)))
2780
2781(defadvice minibuffer-complete
2782 (before my-minibuffer-complete activate)
2783 (expand-abbrev))
2784
2785;; If you use partial-completion-mode
2786(defadvice PC-do-completion
2787 (before my-PC-do-completion activate)
2788 (expand-abbrev))
2789@end lisp
2790
2791After entering @kbd{C-x C-f xy @key{TAB}}, the minibuffer is
2792expanded, and you can continue editing.
2793
2794@item Use bookmarks:
2795
2796Bookmarks can be used to visit Tramp files or directories.
2797@ifinfo
2798@pxref{Bookmarks, , , @value{emacsdir}}
2799@end ifinfo
2800
2801When you have opened @file{@trampfn{ssh, news, news.my.domain,
2802/opt/news/etc/}}, you should save the bookmark via
2803@ifset emacs
2804@kbd{@key{menu-bar} @key{edit} @key{bookmarks} @key{set}}.
2805@end ifset
2806@ifset xemacs
2807@kbd{@key{menu-bar} @key{view} @key{bookmarks} @key{set}}.
2808@end ifset
2809
2810Later on, you can always navigate to that bookmark via
2811@ifset emacs
2812@kbd{@key{menu-bar} @key{edit} @key{bookmarks} @key{jump}}.
2813@end ifset
2814@ifset xemacs
2815@kbd{@key{menu-bar} @key{view} @key{bookmarks} @key{jump}}.
2816@end ifset
2817
2818@item Use recent files:
2819
2820@ifset emacs
2821@file{recentf}
2822@end ifset
2823@ifset xemacs
2824@file{recent-files}
2825@end ifset
2826remembers visited places.
2827@ifinfo
2828@ifset emacs
2829@pxref{File Conveniences, , , @value{emacsdir}}
2830@end ifset
2831@ifset xemacs
2832@pxref{recent-files, , , edit-utils}
2833@end ifset
2834@end ifinfo
2835
2836You could keep remote file names in the recent list without checking
2837their readability through a remote access:
2838
2839@lisp
2840@ifset emacs
2841(require 'recentf)
2842(add-to-list 'recentf-keep 'file-remote-p)
2843(recentf-mode 1)
2844@end ifset
2845@ifset xemacs
2846(recent-files-initialize)
2847(add-hook
2848 'find-file-hooks
2849 (lambda ()
2850 (when (file-remote-p (buffer-file-name))
2851 (recent-files-make-permanent)))
2852 'append)
2853@end ifset
2854@end lisp
2855
2856The list of files opened recently is reachable via
2857@ifset emacs
2858@kbd{@key{menu-bar} @key{file} @key{Open Recent}}.
2859@end ifset
2860@ifset xemacs
2861@kbd{@key{menu-bar} @key{Recent Files}}.
2862@end ifset
2863
2864@ifset emacs
2865@item Use filecache:
2866
2867@file{filecache} remembers visited places. Add the directory into
2868the cache:
2869
2870@lisp
2871(eval-after-load "filecache"
2872 '(file-cache-add-directory
2873 "@trampfn{ssh, news, news.my.domain, /opt/news/etc/}"))
2874@end lisp
2875
2876Whenever you want to load a file, you can enter @kbd{C-x C-f
2877C-@key{TAB}} in the minibuffer. The completion is done for the given
2878directory.
2879@end ifset
2880
2881@end enumerate
2882
2883
2155@item 2884@item
2156How can I disable @value{tramp}? 2885How can I disable @value{tramp}?
2157 2886
@@ -2180,12 +2909,12 @@ This resets also the @value{ftppackagename} plugins.
2180@cindex Version Control 2909@cindex Version Control
2181 2910
2182Unlike @value{ftppackagename}, @value{tramp} has full shell access to the 2911Unlike @value{ftppackagename}, @value{tramp} has full shell access to the
2183remote machine. This makes it possible to provide version control for 2912remote machine. This makes it possible to provide version control for
2184files accessed under @value{tramp}. 2913files accessed under @value{tramp}.
2185 2914
2186The actual version control binaries must be installed on the remote 2915The actual version control binaries must be installed on the remote
2187machine, accessible in the directories specified in 2916machine, accessible in the directories specified in
2188@var{tramp-remote-path}. 2917@code{tramp-remote-path}.
2189 2918
2190This transparent integration with the version control systems is one of 2919This transparent integration with the version control systems is one of
2191the most valuable features provided by @value{tramp}, but it is far from perfect. 2920the most valuable features provided by @value{tramp}, but it is far from perfect.
@@ -2204,7 +2933,7 @@ Work is ongoing to improve the transparency of the system.
2204@section Determining if a file is under version control 2933@section Determining if a file is under version control
2205 2934
2206The VC package uses the existence of on-disk revision control master 2935The VC package uses the existence of on-disk revision control master
2207files to determine if a given file is under revision control. These file 2936files to determine if a given file is under revision control. These file
2208tests happen on the remote machine through the standard @value{tramp} mechanisms. 2937tests happen on the remote machine through the standard @value{tramp} mechanisms.
2209 2938
2210 2939
@@ -2212,7 +2941,7 @@ tests happen on the remote machine through the standard @value{tramp} mechanisms
2212@section Executing the version control commands on the remote machine 2941@section Executing the version control commands on the remote machine
2213 2942
2214There are no hooks provided by VC to allow intercepting of the version 2943There are no hooks provided by VC to allow intercepting of the version
2215control command execution. The calls occur through the 2944control command execution. The calls occur through the
2216@code{call-process} mechanism, a function that is somewhat more 2945@code{call-process} mechanism, a function that is somewhat more
2217efficient than the @code{shell-command} function but that does not 2946efficient than the @code{shell-command} function but that does not
2218provide hooks for remote execution of commands. 2947provide hooks for remote execution of commands.
@@ -2239,7 +2968,7 @@ workfile and the version control master.
2239 2968
2240This requires that a shell command be executed remotely, a process that 2969This requires that a shell command be executed remotely, a process that
2241is notably heavier-weight than the mtime comparison used for local 2970is notably heavier-weight than the mtime comparison used for local
2242files. Unfortunately, unless a portable solution to the issue is found, 2971files. Unfortunately, unless a portable solution to the issue is found,
2243this will remain the cost of remote version control. 2972this will remain the cost of remote version control.
2244 2973
2245 2974
@@ -2247,7 +2976,7 @@ this will remain the cost of remote version control.
2247@section Bringing the workfile out of the repository 2976@section Bringing the workfile out of the repository
2248 2977
2249VC will, by default, check for remote files and refuse to act on them 2978VC will, by default, check for remote files and refuse to act on them
2250when checking out files from the repository. To work around this 2979when checking out files from the repository. To work around this
2251problem, the function @code{vc-checkout} knows about @value{tramp} files and 2980problem, the function @code{vc-checkout} knows about @value{tramp} files and
2252allows version control to occur. 2981allows version control to occur.
2253 2982
@@ -2266,14 +2995,14 @@ Minor implementation details, &c.
2266@node Remote File Ownership 2995@node Remote File Ownership
2267@subsection How VC determines who owns a workfile 2996@subsection How VC determines who owns a workfile
2268 2997
2269@value{emacsname} provides the @code{user-full-name} function to 2998@value{emacsname} provides the @code{user-login-name} function to
2270return the login name of the current user as well as mapping from 2999return the login name of the current user as well as mapping from
2271arbitrary user id values back to login names. The VC code uses this 3000arbitrary user id values back to login names. The VC code uses this
2272functionality to map from the uid of the owner of a workfile to the 3001functionality to map from the uid of the owner of a workfile to the
2273login name in some circumstances. 3002login name in some circumstances.
2274 3003
2275This will not, for obvious reasons, work if the remote system has a 3004This will not, for obvious reasons, work if the remote system has a
2276different set of logins. As such, it is necessary to delegate to the 3005different set of logins. As such, it is necessary to delegate to the
2277remote machine the job of determining the login name associated with a 3006remote machine the job of determining the login name associated with a
2278uid. 3007uid.
2279 3008
@@ -2282,7 +3011,7 @@ as @code{NIS}, @code{NIS+} and @code{NetInfo}, there is no simple,
2282reliable and portable method for performing this mapping. 3011reliable and portable method for performing this mapping.
2283 3012
2284Thankfully, the only place in the VC code that depends on the mapping of 3013Thankfully, the only place in the VC code that depends on the mapping of
2285a uid to a login name is the @code{vc-file-owner} function. This returns 3014a uid to a login name is the @code{vc-file-owner} function. This returns
2286the login of the owner of the file as a string. 3015the login of the owner of the file as a string.
2287 3016
2288This function has been advised to use the output of @command{ls} on the 3017This function has been advised to use the output of @command{ls} on the
@@ -2304,7 +3033,7 @@ executing a process and parsing its output each time the information is
2304needed. 3033needed.
2305 3034
2306Unfortunately, life is not quite so easy when remote version control 3035Unfortunately, life is not quite so easy when remote version control
2307comes into the picture. Each remote machine may have a different version 3036comes into the picture. Each remote machine may have a different version
2308of the version control tools and, while this is painful, we need to 3037of the version control tools and, while this is painful, we need to
2309ensure that unavailable features are not used remotely. 3038ensure that unavailable features are not used remotely.
2310 3039
@@ -2313,9 +3042,9 @@ approach of making the release values of the revision control tools
2313local to each @value{tramp} buffer, forcing VC to determine these values 3042local to each @value{tramp} buffer, forcing VC to determine these values
2314again each time a new file is visited. 3043again each time a new file is visited.
2315 3044
2316This has, quite obviously, some performance implications. Thankfully, 3045This has, quite obviously, some performance implications. Thankfully,
2317most of the common operations performed by VC do not actually require 3046most of the common operations performed by VC do not actually require
2318that the remote version be known. This makes the problem far less 3047that the remote version be known. This makes the problem far less
2319apparent. 3048apparent.
2320 3049
2321Eventually these values will be captured by @value{tramp} on a system by 3050Eventually these values will be captured by @value{tramp} on a system by
@@ -2334,11 +3063,11 @@ system basis and the results cached to improve performance.
2334@section Breaking a localname into its components. 3063@section Breaking a localname into its components.
2335 3064
2336@value{tramp} file names are somewhat different, obviously, to ordinary file 3065@value{tramp} file names are somewhat different, obviously, to ordinary file
2337names. As such, the lisp functions @code{file-name-directory} and 3066names. As such, the lisp functions @code{file-name-directory} and
2338@code{file-name-nondirectory} are overridden within the @value{tramp} 3067@code{file-name-nondirectory} are overridden within the @value{tramp}
2339package. 3068package.
2340 3069
2341Their replacements are reasonably simplistic in their approach. They 3070Their replacements are reasonably simplistic in their approach. They
2342dissect the filename, call the original handler on the localname and 3071dissect the filename, call the original handler on the localname and
2343then rebuild the @value{tramp} file name with the result. 3072then rebuild the @value{tramp} file name with the result.
2344 3073
@@ -2346,6 +3075,77 @@ This allows the platform specific hacks in the original handlers to take
2346effect while preserving the @value{tramp} file name information. 3075effect while preserving the @value{tramp} file name information.
2347 3076
2348 3077
3078@node Traces and Profiles
3079@chapter How to Customize Traces
3080
3081All @value{tramp} messages are raised with a verbosity level. The
3082verbosity level can be any number between 0 and 10. Only messages with
3083a verbosity level less than or equal to @code{tramp-verbose} are
3084displayed.
3085
3086The verbosity levels are
3087
3088 @w{ 0} silent (no @value{tramp} messages at all)
3089@*@indent @w{ 1} errors
3090@*@indent @w{ 2} warnings
3091@*@indent @w{ 3} connection to remote hosts (default verbosity)
3092@*@indent @w{ 4} activities
3093@*@indent @w{ 5} internal
3094@*@indent @w{ 6} sent and received strings
3095@*@indent @w{ 7} file caching
3096@*@indent @w{ 8} connection properties
3097@*@indent @w{10} traces (huge)
3098
3099When @code{tramp-verbose} is greater than or equal to 4, the messages
3100are also written into a @value{tramp} debug buffer. This debug buffer
3101is useful for analysing problems; sending a @value{tramp} bug report
3102should be done with @code{tramp-verbose} set to a verbosity level of at
3103least 6 (@pxref{Bug Reports}).
3104
3105The debug buffer is in
3106@ifinfo
3107@ref{Outline Mode, , , @value{emacsdir}}.
3108@end ifinfo
3109@ifnotinfo
3110Outline Mode.
3111@end ifnotinfo
3112That means, you can change the level of messages to be viewed. If you
3113want, for example, see only messages up to verbosity level 5, you must
3114enter @kbd{C-u 6 C-c C-q}.
3115@ifinfo
3116Other keys for navigating are described in
3117@ref{Outline Visibility, , , @value{emacsdir}}.
3118@end ifinfo
3119
3120@value{tramp} errors are handled internally in order to raise the
3121verbosity level 1 messages. When you want to get a Lisp backtrace in
3122case of an error, you need to set both
3123
3124@lisp
3125(setq debug-on-error t
3126 debug-on-signal t)
3127@end lisp
3128
3129Sometimes, it might be even necessary to step through @value{tramp}
3130function call traces. Such traces are enabled by the following code:
3131
3132@lisp
3133(require 'tramp)
3134(require 'trace)
3135(mapcar 'trace-function-background
3136 (mapcar 'intern
3137 (all-completions "tramp-" obarray 'functionp)))
3138(untrace-function 'tramp-read-passwd)
3139(untrace-function 'tramp-gw-basic-authentication)
3140@end lisp
3141
3142The function call traces are inserted in the buffer
3143@file{*trace-output*}. @code{tramp-read-passwd} and
3144@code{tramp-gw-basic-authentication} shall be disabled when the
3145function call traces are added to @value{tramp}, because both
3146functions return password strings, which should not be distributed.
3147
3148
2349@node Issues 3149@node Issues
2350@chapter Debatable Issues and What Was Decided 3150@chapter Debatable Issues and What Was Decided
2351 3151
@@ -2368,14 +3168,6 @@ printed and deleted.
2368But I have decided that this is too fragile to reliably work, so on some 3168But I have decided that this is too fragile to reliably work, so on some
2369systems you'll have to do without the uuencode methods. 3169systems you'll have to do without the uuencode methods.
2370 3170
2371@item @value{tramp} does not work on XEmacs 20.
2372
2373This is because it requires the macro @code{with-timeout} which does not
2374appear to exist in XEmacs 20. I'm somewhat reluctant to add an
2375emulation macro to @value{tramp}, but if somebody who uses XEmacs 20 steps
2376forward and wishes to implement and test it, please contact me or the
2377mailing list.
2378
2379@item The @value{tramp} filename syntax differs between GNU Emacs and XEmacs. 3171@item The @value{tramp} filename syntax differs between GNU Emacs and XEmacs.
2380 3172
2381The GNU Emacs maintainers wish to use a unified filename syntax for 3173The GNU Emacs maintainers wish to use a unified filename syntax for
@@ -2402,10 +3194,10 @@ The autoload of the @value{emacsname} @value{tramp} package must be
2402disabled. This can be achieved by setting file permissions @code{000} 3194disabled. This can be achieved by setting file permissions @code{000}
2403to the files @file{.../xemacs-packages/lisp/tramp/auto-autoloads.el*}. 3195to the files @file{.../xemacs-packages/lisp/tramp/auto-autoloads.el*}.
2404 3196
2405In case of unified filenames, all @value{emacsname} download sites 3197In case of unified filenames, all @value{emacsname} download sites are
2406are added to @code{tramp-default-method-alist} with default method 3198added to @code{tramp-default-method-alist} with default method
2407@option{ftp} @xref{Default Method}. These settings shouldn't be touched 3199@option{ftp} @xref{Default Method}. These settings shouldn't be
2408for proper working of the @value{emacsname} package system. 3200touched for proper working of the @value{emacsname} package system.
2409 3201
2410The syntax for unified filenames is described in the @value{tramp} manual 3202The syntax for unified filenames is described in the @value{tramp} manual
2411for @value{emacsothername}. 3203for @value{emacsothername}.
@@ -2430,7 +3222,6 @@ for @value{emacsothername}.
2430@c shells. 3222@c shells.
2431@c * Explain how tramp.el works in principle: open a shell on a remote 3223@c * Explain how tramp.el works in principle: open a shell on a remote
2432@c host and then send commands to it. 3224@c host and then send commands to it.
2433@c * Mention that bookmarks are a cool feature to go along with Tramp.
2434@c * Make terminology "inline" vs "out-of-band" consistent. 3225@c * Make terminology "inline" vs "out-of-band" consistent.
2435@c It seems that "external" is also used instead of "out-of-band". 3226@c It seems that "external" is also used instead of "out-of-band".
2436 3227
diff --git a/man/trampver.texi b/man/trampver.texi
index 6c770dc8ad1..6d97869d115 100644
--- a/man/trampver.texi
+++ b/man/trampver.texi
@@ -1,27 +1,26 @@
1@c -*-texinfo-*- 1@c -*-texinfo-*-
2@c texi/trampver.texi. Generated from trampver.texi.in by configure. 2@c texi/trampver.texi. Generated from trampver.texi.in by configure.
3 3
4@c This is part of the Emacs manual.
5@c Copyright (C) 2003, 2004, 2005, 2006, 2007
6@c Free Software Foundation, Inc.
7@c See file emacs.texi for copying conditions.
8
9@c In the Tramp CVS, the version number is auto-frobbed from 4@c In the Tramp CVS, the version number is auto-frobbed from
10@c configure.ac, so you should edit that file and run 5@c configure.ac, so you should edit that file and run
11@c "autoconf && ./configure" to change the version number. 6@c "autoconf && ./configure" to change the version number.
12@set trampver 2.0.56 7@set trampver 2.1.10-pre
13 8
14@c Other flags from configuration 9@c Other flags from configuration
15@set prefix /usr/local 10@set instprefix /usr/local
16@set lispdir /usr/local/share/emacs/site-lisp 11@set lispdir /usr/local/share/emacs/site-lisp
17@set infodir /usr/local/share/info 12@set infodir /usr/local/info
18 13
19@c Formatting of the tramp program name consistent. 14@c Formatting of the tramp program name consistent.
20@set tramp @sc{tramp} 15@set tramp @sc{tramp}
21 16
17@c Whether or not describe gateway methods.
18@ifclear noemacsgw
19@set emacsgw
20@end ifclear
21
22@c Some flags which make the text independent on the (X)Emacs flavor. 22@c Some flags which make the text independent on the (X)Emacs flavor.
23@c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs". 23@c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs".
24
25@ifclear emacs 24@ifclear emacs
26@ifclear xemacs 25@ifclear xemacs
27@set emacs 26@set emacs
@@ -34,10 +33,9 @@
34@set emacsdir emacs 33@set emacsdir emacs
35@set ftppackagename Ange-FTP 34@set ftppackagename Ange-FTP
36@set prefix / 35@set prefix /
37@set prefixsinglehop 36@set prefixhop
38@set postfix : 37@set postfix :
39@set postfixsinglehop : 38@set postfixhop :
40@set postfixmultihop :
41@set emacsothername XEmacs 39@set emacsothername XEmacs
42@set emacsotherdir xemacs 40@set emacsotherdir xemacs
43@set emacsotherfilename tramp-xemacs.html 41@set emacsotherfilename tramp-xemacs.html
@@ -50,10 +48,9 @@
50@set emacsdir xemacs 48@set emacsdir xemacs
51@set ftppackagename EFS 49@set ftppackagename EFS
52@set prefix /[ 50@set prefix /[
53@set prefixsinglehop [ 51@set prefixhop [
54@set postfix ] 52@set postfix ]
55@set postfixsinglehop / 53@set postfixhop /
56@set postfixmultihop :
57@set emacsothername GNU Emacs 54@set emacsothername GNU Emacs
58@set emacsotherdir emacs 55@set emacsotherdir emacs
59@set emacsotherfilename tramp-emacs.html 56@set emacsotherfilename tramp-emacs.html
diff --git a/nt/ChangeLog b/nt/ChangeLog
index 65f3bc7b622..df2344dc3af 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,14 @@
12007-07-14 Jason Rumney <jasonr@gnu.org>
2
3 * inc/sys/socket.h: Include winsock2.h and ws2tcpip.h instead
4 of winsock.h.
5
62007-07-11 Jason Rumney <jasonr@gnu.org>
7
8 * gmake.defs (OLE32): New library to link.
9
10 * nmake.defs (OLE32): Likewise.
11
12007-06-25 Jason Rumney <jasonr@gnu.org> 122007-06-25 Jason Rumney <jasonr@gnu.org>
2 13
3 * cmdproxy.c (main): Set console codepages to "ANSI". 14 * cmdproxy.c (main): Set console codepages to "ANSI".
diff --git a/nt/gmake.defs b/nt/gmake.defs
index 15ec2bf0ea3..c08ca32200f 100644
--- a/nt/gmake.defs
+++ b/nt/gmake.defs
@@ -176,8 +176,9 @@ MPR = -lmpr
176SHELL32 = -lshell32 176SHELL32 = -lshell32
177USER32 = -luser32 177USER32 = -luser32
178WSOCK32 = -lwsock32 178WSOCK32 = -lwsock32
179WINMM = -lwinmm 179WINMM = -lwinmm
180WINSPOOL = -lwinspool 180WINSPOOL = -lwinspool
181OLE32 = -lole32
181 182
182ifdef NOOPT 183ifdef NOOPT
183DEBUG_CFLAGS = -DEMACSDEBUG 184DEBUG_CFLAGS = -DEMACSDEBUG
diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h
index 0923dd9246b..2e52c74691e 100644
--- a/nt/inc/sys/socket.h
+++ b/nt/inc/sys/socket.h
@@ -51,7 +51,8 @@ Boston, MA 02110-1301, USA. */
51#define timeval ws_timeval 51#define timeval ws_timeval
52#endif 52#endif
53 53
54#include <winsock.h> 54#include <winsock2.h>
55#include <ws2tcpip.h>
55 56
56/* redefine select to reference our version */ 57/* redefine select to reference our version */
57#ifdef MUST_REDEF_SELECT 58#ifdef MUST_REDEF_SELECT
diff --git a/nt/nmake.defs b/nt/nmake.defs
index 5f52bc18c62..03ae2f851fa 100644
--- a/nt/nmake.defs
+++ b/nt/nmake.defs
@@ -123,8 +123,9 @@ MPR = mpr.lib
123SHELL32 = shell32.lib 123SHELL32 = shell32.lib
124USER32 = user32.lib 124USER32 = user32.lib
125WSOCK32 = wsock32.lib 125WSOCK32 = wsock32.lib
126WINMM = winmm.lib 126WINMM = winmm.lib
127WINSPOOL = winspool.lib 127WINSPOOL = winspool.lib
128OLE32 = ole32.lib
128 129
129!ifdef NOOPT 130!ifdef NOOPT
130DEBUG_CFLAGS = -DEMACSDEBUG 131DEBUG_CFLAGS = -DEMACSDEBUG
diff --git a/src/ChangeLog b/src/ChangeLog
index 101dd489fb3..76c8c8ef163 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,98 @@
12007-07-14 Jason Rumney <jasonr@gnu.org>
2
3 * process.c [WINDOWSNT]: Don't undefine AF_INET6.
4
52007-07-14 Richard Stallman <rms@gnu.org>
6
7 * eval.c (maybe_call_debugger): New function.
8 (find_handler_clause): Use maybe_call_debugger.
9 Call it when the handler says `debug'.
10 Eliminate DEBUGGER_VALUE_PTR.
11 (Fsignal): Eliminate debugger_value.
12 (Qdebug): New variable.
13 (syms_of_eval): Initialize it.
14
152007-07-14 Juanma Barranquero <lekktu@gmail.com>
16
17 * eval.c (Fprogn):
18 * keyboard.c (Ftrack_mouse):
19 * print.c (Fwith_output_to_temp_buffer):
20 * window.c (Fsave_window_excursion): Doc fix.
21
222007-07-13 Stefan Monnier <monnier@iro.umontreal.ca>
23
24 * eval.c (init_eval_once): Bump max_lisp_eval_depth to 400.
25
262007-07-12 Stefan Monnier <monnier@iro.umontreal.ca>
27
28 * process.h (struct Lisp_Process): Turn slots infd, outfd,
29 kill_without_query, pty_flag, tick, update_tick, decoding_carryover,
30 inherit_coding_system_flag, filter_multibyte, adaptive_read_buffering,
31 read_output_delay, and read_output_skip from Lisp_Objects to ints.
32 Remove unused encoding_carryover.
33 * process.c: Adjust all functions accordingly.
34
352007-07-12 Richard Stallman <rms@gnu.org>
36
37 * term.c: Include unistd.h only if HAVE_UNISTD_H.
38
392007-07-11 Jason Rumney <jasonr@gnu.org>
40
41 * makefile.w32-in (LIBS): Include OLE32.
42
43 * w32fns.c (w32_msg_pump) <WM_EMACS_CREATEWINDOW>: Initialize COM.
44 (w32_msg_pump) <WM_DESTROY>: Uninitialize COM.
45
462007-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
47
48 * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer.
49 * fns.c (weak_hash_tables): Rename from Vweak_hash_tables and turned
50 from a Lisp_Object into a bare pointer.
51 (make_hash_table, copy_hash_table, sweep_weak_hash_tables, init_fns):
52 Adjust the code correspondingly.
53
54 * alloc.c (emacs_blocked_free): Remove unused var `bytes_used_now'.
55
56 * term.c: Include unistd.h for ttyname, used in handle_one_term_event.
57 (term_show_mouse_face): Remove unused var `j'.
58 (handle_one_term_event): Remove unused vars `i' and `j'.
59 Don't cast return value of ttyname since it's not necessary.
60
612007-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
62
63 * alloc.c (mark_maybe_pointer): Enforce mult-of-8 alignment when using
64 USE_LSB_TAG. Suggested by Dmitry Antipov <dmantipov@yandex.ru>.
65
66 * fns.c (map_char_table): Use an array of int for `indices' rather than
67 an array of Lisp_Objects (which are only ever integers anyway).
68 (Fmap_char_table): Update caller.
69 * lisp.h: Update prototype.
70 * keymap.c (Fset_keymap_parent, map_keymap, Fcopy_keymap):
71 * fontset.c (Ffontset_info):
72 * casetab.c (set_case_table): Update callers.
73
74 * editfns.c (Ftranspose_regions): Use EMACS_INT for positions.
75
76 * keymap.c (struct accessible_keymaps_data)
77 (struct where_is_internal_data): New structures.
78 (accessible_keymaps_1, where_is_internal_1): Use them to change
79 interface to adhere to the one used by map_keymap.
80 (Faccessible_keymaps, where_is_internal): Use map_keymap.
81 (accessible_keymaps_char_table, where_is_internal_2): Remove.
82
83 * keymap.h (map_keymap_function_t): More informative prototype.
84
852007-07-10 Guanpeng Xu <herberteuler@hotmail.com>
86
87 * search.c (Vinhibit_changing_match_data, search_regs_1): New vars.
88 (looking_at_1): Don't change search_regs and last_thing_searched
89 if `inhibit-changing-match-data' is non-nil.
90 (string_match_1, search_buffer, set_search_regs): Likewise.
91 (syms_of_search): Add Lisp level definition for
92 `inhibit-changing-match-data' and set it to nil.
93 (boyer_moore): If `inhibit-changing-match-data' is non-nil, compute
94 start and end of the match, instead of using values in search_regs.
95
12007-07-01 Stefan Monnier <monnier@iro.umontreal.ca> 962007-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
2 97
3 * minibuf.c (Fcompleting_read): New value `confirm-only' 98 * minibuf.c (Fcompleting_read): New value `confirm-only'
@@ -1118,13 +1213,13 @@
1118 when popup menu finishes. 1213 when popup menu finishes.
1119 1214
1120 * w32fns.c (menubar_in_use): New flag. 1215 * w32fns.c (menubar_in_use): New flag.
1121 (w32_wnd_proc) [WM_INITMENU, WM_EXITMENULOOP, WM_TIMER, WM_COMMAND]: 1216 (w32_wnd_proc) <WM_INITMENU, WM_EXITMENULOOP, WM_TIMER, WM_COMMAND>:
1122 Use it. 1217 Use it.
1123 1218
1124 * w32menu.c (Fx_popup_menu): Don't free menu strings here. 1219 * w32menu.c (Fx_popup_menu): Don't free menu strings here.
1125 (w32_menu_show): Do it here instead. 1220 (w32_menu_show): Do it here instead.
1126 1221
1127 * w32fns.c (w32_wnd_proc) [WM_INITMENU]: Set menubar_active frame 1222 * w32fns.c (w32_wnd_proc) <WM_INITMENU>: Set menubar_active frame
1128 parameter. 1223 parameter.
1129 1224
1130 * w32menu.c (current_popup_menu): Make available globally. 1225 * w32menu.c (current_popup_menu): Make available globally.
@@ -1132,7 +1227,7 @@
1132 menu event into the keyboard buffer. Remove menu_command_in_progress. 1227 menu event into the keyboard buffer. Remove menu_command_in_progress.
1133 1228
1134 * w32fns.c (current_popup_menu): Use from w32menu.c. 1229 * w32fns.c (current_popup_menu): Use from w32menu.c.
1135 (w32_wnd_proc) [WM_EXITMENULOOP, WM_TIMER]: Use menubar_active 1230 (w32_wnd_proc) <WM_EXITMENULOOP, WM_TIMER>: Use menubar_active
1136 and current_popup_menu to determine whether a menubar menu has 1231 and current_popup_menu to determine whether a menubar menu has
1137 been cancelled. 1232 been cancelled.
1138 1233
@@ -10243,7 +10338,7 @@
10243 * w32term.h (x_output): Add focus_state. 10338 * w32term.h (x_output): Add focus_state.
10244 10339
10245 * w32term.c (x_focus_changed, w32_detect_focus_change): New functions. 10340 * w32term.c (x_focus_changed, w32_detect_focus_change): New functions.
10246 (w32_read_socket) [WM_SETFOCUS]: Call w32_detect_focus_change. 10341 (w32_read_socket) <WM_SETFOCUS>: Call w32_detect_focus_change.
10247 10342
102482005-03-25 Stefan Monnier <monnier@iro.umontreal.ca> 103432005-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
10249 10344
@@ -13531,7 +13626,7 @@
13531 13626
13532 * w32term.h (AppendMenuW_Proc): Move declaration from w32menu.c. 13627 * w32term.h (AppendMenuW_Proc): Move declaration from w32menu.c.
13533 13628
13534 * w32fns.c (w32_wnd_proc) [WM_MEASUREITEM, WM_DRAWITEM]: 13629 * w32fns.c (w32_wnd_proc) <WM_MEASUREITEM, WM_DRAWITEM>:
13535 Handle Unicode menu titles. 13630 Handle Unicode menu titles.
13536 13631
135372004-09-07 Kim F. Storm <storm@cua.dk> 136322004-09-07 Kim F. Storm <storm@cua.dk>
diff --git a/src/alloc.c b/src/alloc.c
index d5de5f7296b..fd366339a53 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1179,8 +1179,6 @@ emacs_blocked_free (ptr, ptr2)
1179 void *ptr; 1179 void *ptr;
1180 const void *ptr2; 1180 const void *ptr2;
1181{ 1181{
1182 EMACS_INT bytes_used_now;
1183
1184 BLOCK_INPUT_ALLOC; 1182 BLOCK_INPUT_ALLOC;
1185 1183
1186#ifdef GC_MALLOC_CHECK 1184#ifdef GC_MALLOC_CHECK
@@ -4220,9 +4218,14 @@ mark_maybe_pointer (p)
4220{ 4218{
4221 struct mem_node *m; 4219 struct mem_node *m;
4222 4220
4223 /* Quickly rule out some values which can't point to Lisp data. We 4221 /* Quickly rule out some values which can't point to Lisp data. */
4224 assume that Lisp data is aligned on even addresses. */ 4222 if ((EMACS_INT) p %
4225 if ((EMACS_INT) p & 1) 4223#ifdef USE_LSB_TAG
4224 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
4225#else
4226 2 /* We assume that Lisp data is aligned on even addresses. */
4227#endif
4228 )
4226 return; 4229 return;
4227 4230
4228 m = mem_find (p); 4231 m = mem_find (p);
diff --git a/src/editfns.c b/src/editfns.c
index b615012c700..43dc59e78b3 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4256,9 +4256,9 @@ Transposing beyond buffer boundaries is an error. */)
4256 (startr1, endr1, startr2, endr2, leave_markers) 4256 (startr1, endr1, startr2, endr2, leave_markers)
4257 Lisp_Object startr1, endr1, startr2, endr2, leave_markers; 4257 Lisp_Object startr1, endr1, startr2, endr2, leave_markers;
4258{ 4258{
4259 register int start1, end1, start2, end2; 4259 register EMACS_INT start1, end1, start2, end2;
4260 int start1_byte, start2_byte, len1_byte, len2_byte; 4260 EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte;
4261 int gap, len1, len_mid, len2; 4261 EMACS_INT gap, len1, len_mid, len2;
4262 unsigned char *start1_addr, *start2_addr, *temp; 4262 unsigned char *start1_addr, *start2_addr, *temp;
4263 4263
4264 INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3; 4264 INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3;
diff --git a/src/eval.c b/src/eval.c
index 6707849a840..cd0d0fc1c5c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
97Lisp_Object Qand_rest, Qand_optional; 97Lisp_Object Qand_rest, Qand_optional;
98Lisp_Object Qdebug_on_error; 98Lisp_Object Qdebug_on_error;
99Lisp_Object Qdeclare; 99Lisp_Object Qdeclare;
100Lisp_Object Qdebug;
100 101
101/* This holds either the symbol `run-hooks' or nil. 102/* This holds either the symbol `run-hooks' or nil.
102 It is nil at an early stage of startup, and when Emacs 103 It is nil at an early stage of startup, and when Emacs
@@ -220,7 +221,7 @@ init_eval_once ()
220 specpdl_ptr = specpdl; 221 specpdl_ptr = specpdl;
221 /* Don't forget to update docs (lispref node "Local Variables"). */ 222 /* Don't forget to update docs (lispref node "Local Variables"). */
222 max_specpdl_size = 1000; 223 max_specpdl_size = 1000;
223 max_lisp_eval_depth = 300; 224 max_lisp_eval_depth = 400;
224 225
225 Vrun_hooks = Qnil; 226 Vrun_hooks = Qnil;
226} 227}
@@ -433,7 +434,7 @@ usage: (cond CLAUSES...) */)
433 434
434DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, 435DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
435 doc: /* Eval BODY forms sequentially and return value of last one. 436 doc: /* Eval BODY forms sequentially and return value of last one.
436usage: (progn BODY ...) */) 437usage: (progn BODY...) */)
437 (args) 438 (args)
438 Lisp_Object args; 439 Lisp_Object args;
439{ 440{
@@ -1585,8 +1586,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
1585 1586
1586 1587
1587static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, 1588static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
1588 Lisp_Object, Lisp_Object, 1589 Lisp_Object, Lisp_Object));
1589 Lisp_Object *));
1590 1590
1591DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1591DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1592 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1592 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
@@ -1612,7 +1612,6 @@ See also the function `condition-case'. */)
1612 Lisp_Object conditions; 1612 Lisp_Object conditions;
1613 extern int gc_in_progress; 1613 extern int gc_in_progress;
1614 extern int waiting_for_input; 1614 extern int waiting_for_input;
1615 Lisp_Object debugger_value;
1616 Lisp_Object string; 1615 Lisp_Object string;
1617 Lisp_Object real_error_symbol; 1616 Lisp_Object real_error_symbol;
1618 struct backtrace *bp; 1617 struct backtrace *bp;
@@ -1670,7 +1669,7 @@ See also the function `condition-case'. */)
1670 register Lisp_Object clause; 1669 register Lisp_Object clause;
1671 1670
1672 clause = find_handler_clause (handlerlist->handler, conditions, 1671 clause = find_handler_clause (handlerlist->handler, conditions,
1673 error_symbol, data, &debugger_value); 1672 error_symbol, data);
1674 1673
1675 if (EQ (clause, Qlambda)) 1674 if (EQ (clause, Qlambda))
1676 { 1675 {
@@ -1701,7 +1700,7 @@ See also the function `condition-case'. */)
1701 handlerlist = allhandlers; 1700 handlerlist = allhandlers;
1702 /* If no handler is present now, try to run the debugger, 1701 /* If no handler is present now, try to run the debugger,
1703 and if that fails, throw to top level. */ 1702 and if that fails, throw to top level. */
1704 find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); 1703 find_handler_clause (Qerror, conditions, error_symbol, data);
1705 if (catchlist != 0) 1704 if (catchlist != 0)
1706 Fthrow (Qtop_level, Qt); 1705 Fthrow (Qtop_level, Qt);
1707 1706
@@ -1853,75 +1852,54 @@ skip_debugger (conditions, data)
1853 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). 1852 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1854 This is for memory-full errors only. 1853 This is for memory-full errors only.
1855 1854
1856 Store value returned from debugger into *DEBUGGER_VALUE_PTR.
1857
1858 We need to increase max_specpdl_size temporarily around 1855 We need to increase max_specpdl_size temporarily around
1859 anything we do that can push on the specpdl, so as not to get 1856 anything we do that can push on the specpdl, so as not to get
1860 a second error here in case we're handling specpdl overflow. */ 1857 a second error here in case we're handling specpdl overflow. */
1861 1858
1862static Lisp_Object 1859static Lisp_Object
1863find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) 1860find_handler_clause (handlers, conditions, sig, data)
1864 Lisp_Object handlers, conditions, sig, data; 1861 Lisp_Object handlers, conditions, sig, data;
1865 Lisp_Object *debugger_value_ptr;
1866{ 1862{
1867 register Lisp_Object h; 1863 register Lisp_Object h;
1868 register Lisp_Object tem; 1864 register Lisp_Object tem;
1865 int debugger_called = 0;
1866 int debugger_considered = 0;
1869 1867
1870 if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ 1868 /* t is used by handlers for all conditions, set up by C code. */
1869 if (EQ (handlers, Qt))
1871 return Qt; 1870 return Qt;
1871
1872 /* Don't run the debugger for a memory-full error.
1873 (There is no room in memory to do that!) */
1874 if (NILP (sig))
1875 debugger_considered = 1;
1876
1872 /* error is used similarly, but means print an error message 1877 /* error is used similarly, but means print an error message
1873 and run the debugger if that is enabled. */ 1878 and run the debugger if that is enabled. */
1874 if (EQ (handlers, Qerror) 1879 if (EQ (handlers, Qerror)
1875 || !NILP (Vdebug_on_signal)) /* This says call debugger even if 1880 || !NILP (Vdebug_on_signal)) /* This says call debugger even if
1876 there is a handler. */ 1881 there is a handler. */
1877 { 1882 {
1878 int debugger_called = 0; 1883 if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
1879 Lisp_Object sig_symbol, combined_data;
1880 /* This is set to 1 if we are handling a memory-full error,
1881 because these must not run the debugger.
1882 (There is no room in memory to do that!) */
1883 int no_debugger = 0;
1884
1885 if (NILP (sig))
1886 {
1887 combined_data = data;
1888 sig_symbol = Fcar (data);
1889 no_debugger = 1;
1890 }
1891 else
1892 {
1893 combined_data = Fcons (sig, data);
1894 sig_symbol = sig;
1895 }
1896
1897 if (wants_debugger (Vstack_trace_on_error, conditions))
1898 { 1884 {
1899 max_specpdl_size++; 1885 max_specpdl_size++;
1900#ifdef PROTOTYPES 1886 #ifdef PROTOTYPES
1901 internal_with_output_to_temp_buffer ("*Backtrace*", 1887 internal_with_output_to_temp_buffer ("*Backtrace*",
1902 (Lisp_Object (*) (Lisp_Object)) Fbacktrace, 1888 (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
1903 Qnil); 1889 Qnil);
1904#else 1890 #else
1905 internal_with_output_to_temp_buffer ("*Backtrace*", 1891 internal_with_output_to_temp_buffer ("*Backtrace*",
1906 Fbacktrace, Qnil); 1892 Fbacktrace, Qnil);
1907#endif 1893 #endif
1908 max_specpdl_size--; 1894 max_specpdl_size--;
1909 } 1895 }
1910 if (! no_debugger 1896
1911 /* Don't try to run the debugger with interrupts blocked. 1897 if (!debugger_considered)
1912 The editing loop would return anyway. */
1913 && ! INPUT_BLOCKED_P
1914 && (EQ (sig_symbol, Qquit)
1915 ? debug_on_quit
1916 : wants_debugger (Vdebug_on_error, conditions))
1917 && ! skip_debugger (conditions, combined_data)
1918 && when_entered_debugger < num_nonmacro_input_events)
1919 { 1898 {
1920 *debugger_value_ptr 1899 debugger_considered = 1;
1921 = call_debugger (Fcons (Qerror, 1900 debugger_called = maybe_call_debugger (conditions, sig, data);
1922 Fcons (combined_data, Qnil)));
1923 debugger_called = 1;
1924 } 1901 }
1902
1925 /* If there is no handler, return saying whether we ran the debugger. */ 1903 /* If there is no handler, return saying whether we ran the debugger. */
1926 if (EQ (handlers, Qerror)) 1904 if (EQ (handlers, Qerror))
1927 { 1905 {
@@ -1930,6 +1908,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
1930 return Qt; 1908 return Qt;
1931 } 1909 }
1932 } 1910 }
1911
1933 for (h = handlers; CONSP (h); h = Fcdr (h)) 1912 for (h = handlers; CONSP (h); h = Fcdr (h))
1934 { 1913 {
1935 Lisp_Object handler, condit; 1914 Lisp_Object handler, condit;
@@ -1948,18 +1927,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
1948 /* Handle a list of condition names in handler HANDLER. */ 1927 /* Handle a list of condition names in handler HANDLER. */
1949 else if (CONSP (condit)) 1928 else if (CONSP (condit))
1950 { 1929 {
1951 while (CONSP (condit)) 1930 Lisp_Object tail;
1931 for (tail = condit; CONSP (tail); tail = XCDR (tail))
1952 { 1932 {
1953 tem = Fmemq (Fcar (condit), conditions); 1933 tem = Fmemq (Fcar (tail), conditions);
1954 if (!NILP (tem)) 1934 if (!NILP (tem))
1955 return handler; 1935 {
1956 condit = XCDR (condit); 1936 /* This handler is going to apply.
1937 Does it allow the debugger to run first? */
1938 if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
1939 maybe_call_debugger (conditions, sig, data);
1940 return handler;
1941 }
1957 } 1942 }
1958 } 1943 }
1959 } 1944 }
1945
1960 return Qnil; 1946 return Qnil;
1961} 1947}
1962 1948
1949/* Call the debugger if calling it is currently enabled for CONDITIONS.
1950 SIG and DATA describe the signal, as in find_handler_clause. */
1951
1952int
1953maybe_call_debugger (conditions, sig, data)
1954 Lisp_Object conditions, sig, data;
1955{
1956 Lisp_Object combined_data;
1957
1958 combined_data = Fcons (sig, data);
1959
1960 if (
1961 /* Don't try to run the debugger with interrupts blocked.
1962 The editing loop would return anyway. */
1963 ! INPUT_BLOCKED_P
1964 /* Does user wants to enter debugger for this kind of error? */
1965 && (EQ (sig, Qquit)
1966 ? debug_on_quit
1967 : wants_debugger (Vdebug_on_error, conditions))
1968 && ! skip_debugger (conditions, combined_data)
1969 /* rms: what's this for? */
1970 && when_entered_debugger < num_nonmacro_input_events)
1971 {
1972 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
1973 return 1;
1974 }
1975
1976 return 0;
1977}
1978
1963/* dump an error message; called like printf */ 1979/* dump an error message; called like printf */
1964 1980
1965/* VARARGS 1 */ 1981/* VARARGS 1 */
@@ -3600,6 +3616,9 @@ before making `inhibit-quit' nil. */);
3600 Qand_optional = intern ("&optional"); 3616 Qand_optional = intern ("&optional");
3601 staticpro (&Qand_optional); 3617 staticpro (&Qand_optional);
3602 3618
3619 Qdebug = intern ("debug");
3620 staticpro (&Qdebug);
3621
3603 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, 3622 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
3604 doc: /* *Non-nil means errors display a backtrace buffer. 3623 doc: /* *Non-nil means errors display a backtrace buffer.
3605More precisely, this happens for any error that is handled 3624More precisely, this happens for any error that is handled
diff --git a/src/keyboard.c b/src/keyboard.c
index 6df2d1b0b25..b21242f7918 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1422,7 +1422,7 @@ DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
1422Within a `track-mouse' form, mouse motion generates input events that 1422Within a `track-mouse' form, mouse motion generates input events that
1423you can read with `read-event'. 1423you can read with `read-event'.
1424Normally, mouse motion is ignored. 1424Normally, mouse motion is ignored.
1425usage: (track-mouse BODY ...) */) 1425usage: (track-mouse BODY...) */)
1426 (args) 1426 (args)
1427 Lisp_Object args; 1427 Lisp_Object args;
1428{ 1428{
diff --git a/src/keymap.c b/src/keymap.c
index 29898fe7a8e..413de76f7d5 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1179,7 +1179,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
1179 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) 1179 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1180 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); 1180 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1181 1181
1182 meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key) 1182 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1183 ? meta_modifier : 0x80); 1183 ? meta_modifier : 0x80);
1184 1184
1185 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) 1185 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
@@ -2079,12 +2079,23 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_
2079 2079
2080/* Help functions for describing and documenting keymaps. */ 2080/* Help functions for describing and documenting keymaps. */
2081 2081
2082struct accessible_keymaps_data {
2083 Lisp_Object maps, tail, thisseq;
2084 /* Does the current sequence end in the meta-prefix-char? */
2085 int is_metized;
2086};
2082 2087
2083static void 2088static void
2084accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) 2089accessible_keymaps_1 (key, cmd, args, data)
2085 Lisp_Object maps, tail, thisseq, key, cmd; 2090 Lisp_Object key, cmd, args;
2086 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ 2091 /* Use void* to be compatible with map_keymap_function_t. */
2092 void *data;
2087{ 2093{
2094 struct accessible_keymaps_data *d = data; /* Cast! */
2095 Lisp_Object maps = d->maps;
2096 Lisp_Object tail = d->tail;
2097 Lisp_Object thisseq = d->thisseq;
2098 int is_metized = d->is_metized && INTEGERP (key);
2088 Lisp_Object tem; 2099 Lisp_Object tem;
2089 2100
2090 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); 2101 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
@@ -2138,17 +2149,6 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
2138 } 2149 }
2139} 2150}
2140 2151
2141static void
2142accessible_keymaps_char_table (args, index, cmd)
2143 Lisp_Object args, index, cmd;
2144{
2145 accessible_keymaps_1 (index, cmd,
2146 XCAR (XCAR (args)),
2147 XCAR (XCDR (args)),
2148 XCDR (XCDR (args)),
2149 XINT (XCDR (XCAR (args))));
2150}
2151
2152/* This function cannot GC. */ 2152/* This function cannot GC. */
2153 2153
2154DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, 2154DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
@@ -2163,14 +2163,11 @@ then the value includes only maps for prefixes that start with PREFIX. */)
2163 Lisp_Object keymap, prefix; 2163 Lisp_Object keymap, prefix;
2164{ 2164{
2165 Lisp_Object maps, tail; 2165 Lisp_Object maps, tail;
2166 int prefixlen = 0; 2166 int prefixlen = XINT (Flength (prefix));
2167 2167
2168 /* no need for gcpro because we don't autoload any keymaps. */ 2168 /* no need for gcpro because we don't autoload any keymaps. */
2169 2169
2170 if (!NILP (prefix)) 2170 if (!NILP (prefix))
2171 prefixlen = XINT (Flength (prefix));
2172
2173 if (!NILP (prefix))
2174 { 2171 {
2175 /* If a prefix was specified, start with the keymap (if any) for 2172 /* If a prefix was specified, start with the keymap (if any) for
2176 that prefix, so we don't waste time considering other prefixes. */ 2173 that prefix, so we don't waste time considering other prefixes. */
@@ -2180,7 +2177,9 @@ then the value includes only maps for prefixes that start with PREFIX. */)
2180 if the prefix is not defined in this particular map. 2177 if the prefix is not defined in this particular map.
2181 It might even give us a list that isn't a keymap. */ 2178 It might even give us a list that isn't a keymap. */
2182 tem = get_keymap (tem, 0, 0); 2179 tem = get_keymap (tem, 0, 0);
2183 if (CONSP (tem)) 2180 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2181 want to return it. */
2182 if (!NILP (tem))
2184 { 2183 {
2185 /* Convert PREFIX to a vector now, so that later on 2184 /* Convert PREFIX to a vector now, so that later on
2186 we don't have to deal with the possibility of a string. */ 2185 we don't have to deal with the possibility of a string. */
@@ -2620,8 +2619,8 @@ ascii_sequence_p (seq)
2620/* where-is - finding a command in a set of keymaps. */ 2619/* where-is - finding a command in a set of keymaps. */
2621 2620
2622static Lisp_Object where_is_internal (); 2621static Lisp_Object where_is_internal ();
2623static Lisp_Object where_is_internal_1 (); 2622static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2624static void where_is_internal_2 (); 2623 Lisp_Object args, void *data));
2625 2624
2626/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. 2625/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2627 Returns the first non-nil binding found in any of those maps. */ 2626 Returns the first non-nil binding found in any of those maps. */
@@ -2650,6 +2649,12 @@ shadow_lookup (shadow, key, flag)
2650 2649
2651static Lisp_Object Vmouse_events; 2650static Lisp_Object Vmouse_events;
2652 2651
2652struct where_is_internal_data {
2653 Lisp_Object definition, noindirect, this, last;
2654 int last_is_meta;
2655 Lisp_Object sequences;
2656};
2657
2653/* This function can GC if Flookup_key autoloads any keymaps. */ 2658/* This function can GC if Flookup_key autoloads any keymaps. */
2654 2659
2655static Lisp_Object 2660static Lisp_Object
@@ -2687,6 +2692,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2687 { 2692 {
2688 /* Key sequence to reach map, and the map that it reaches */ 2693 /* Key sequence to reach map, and the map that it reaches */
2689 register Lisp_Object this, map, tem; 2694 register Lisp_Object this, map, tem;
2695 struct where_is_internal_data data;
2690 2696
2691 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into 2697 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2692 [M-CHAR] sequences, check if last character of the sequence 2698 [M-CHAR] sequences, check if last character of the sequence
@@ -3059,7 +3065,7 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last,
3059 || EQ (binding, definition) 3065 || EQ (binding, definition)
3060 || (CONSP (definition) && !NILP (Fequal (binding, definition))))) 3066 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
3061 /* Doesn't match. */ 3067 /* Doesn't match. */
3062 return Qnil; 3068 return;
3063 3069
3064 /* We have found a match. Construct the key sequence where we found it. */ 3070 /* We have found a match. Construct the key sequence where we found it. */
3065 if (INTEGERP (key) && last_is_meta) 3071 if (INTEGERP (key) && last_is_meta)
@@ -3074,10 +3080,9 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last,
3074 { 3080 {
3075 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); 3081 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
3076 Fputhash (binding, Fcons (sequence, sequences), where_is_cache); 3082 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
3077 return Qnil;
3078 } 3083 }
3079 else 3084 else
3080 return sequence; 3085 d->sequences = Fcons (sequence, d->sequences);
3081} 3086}
3082 3087
3083/* describe-bindings - summarizing all the bindings in a set of keymaps. */ 3088/* describe-bindings - summarizing all the bindings in a set of keymaps. */
diff --git a/src/keymap.h b/src/keymap.h
index 185ae70d945..df135114c87 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -47,7 +47,7 @@ extern void syms_of_keymap P_ ((void));
47extern void keys_of_keymap P_ ((void)); 47extern void keys_of_keymap P_ ((void));
48 48
49typedef void (*map_keymap_function_t) 49typedef void (*map_keymap_function_t)
50 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*)); 50 P_ ((Lisp_Object key, Lisp_Object val, Lisp_Object args, void* data));
51extern void map_keymap P_ ((Lisp_Object map, map_keymap_function_t fun, Lisp_Object largs, void* cargs, int autoload)); 51extern void map_keymap P_ ((Lisp_Object map, map_keymap_function_t fun, Lisp_Object largs, void* cargs, int autoload));
52 52
53#endif 53#endif
diff --git a/src/lisp.h b/src/lisp.h
index 9f144c4c973..188749b2cfb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -56,7 +56,7 @@ Boston, MA 02110-1301, USA. */
56#ifdef GC_CHECK_CONS_LIST 56#ifdef GC_CHECK_CONS_LIST
57#define CHECK_CONS_LIST() check_cons_list() 57#define CHECK_CONS_LIST() check_cons_list()
58#else 58#else
59#define CHECK_CONS_LIST() 0 59#define CHECK_CONS_LIST() ((void)0)
60#endif 60#endif
61 61
62/* These are default choices for the types to use. */ 62/* These are default choices for the types to use. */
@@ -3234,6 +3234,7 @@ EXFUN (Fx_file_dialog, 5);
3234#endif 3234#endif
3235 3235
3236/* Defined in xfaces.c */ 3236/* Defined in xfaces.c */
3237EXFUN (Fclear_face_cache, 1);
3237extern void syms_of_xfaces P_ ((void)); 3238extern void syms_of_xfaces P_ ((void));
3238 3239
3239#ifndef HAVE_GETLOADAVG 3240#ifndef HAVE_GETLOADAVG
@@ -3249,6 +3250,7 @@ extern void syms_of_xfns P_ ((void));
3249extern void syms_of_xsmfns P_ ((void)); 3250extern void syms_of_xsmfns P_ ((void));
3250 3251
3251/* Defined in xselect.c */ 3252/* Defined in xselect.c */
3253EXFUN (Fx_send_client_event, 6);
3252extern void syms_of_xselect P_ ((void)); 3254extern void syms_of_xselect P_ ((void));
3253 3255
3254/* Defined in xterm.c */ 3256/* Defined in xterm.c */
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 40f921961ac..280429b5a71 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -147,7 +147,7 @@ LIBS = $(TLIB0) \
147 $(TLIB1) \ 147 $(TLIB1) \
148 $(TLIBW32) \ 148 $(TLIBW32) \
149 $(TLASTLIB) \ 149 $(TLASTLIB) \
150 $(WINMM) \ 150 $(WINMM) \
151 $(ADVAPI32) \ 151 $(ADVAPI32) \
152 $(GDI32) \ 152 $(GDI32) \
153 $(COMDLG32) \ 153 $(COMDLG32) \
@@ -155,6 +155,7 @@ LIBS = $(TLIB0) \
155 $(MPR) \ 155 $(MPR) \
156 $(SHELL32) \ 156 $(SHELL32) \
157 $(WINSPOOL) \ 157 $(WINSPOOL) \
158 $(OLE32) \
158 $(libc) 159 $(libc)
159 160
160# 161#
diff --git a/src/print.c b/src/print.c
index 524207ce298..f4b02868703 100644
--- a/src/print.c
+++ b/src/print.c
@@ -690,7 +690,7 @@ If variable `temp-buffer-show-function' is non-nil, call it at the end
690to get the buffer displayed instead of just displaying the non-selected 690to get the buffer displayed instead of just displaying the non-selected
691buffer and calling the hook. It gets one argument, the buffer to display. 691buffer and calling the hook. It gets one argument, the buffer to display.
692 692
693usage: (with-output-to-temp-buffer BUFNAME BODY ...) */) 693usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
694 (args) 694 (args)
695 Lisp_Object args; 695 Lisp_Object args;
696{ 696{
diff --git a/src/process.c b/src/process.c
index 067eae7f286..5551c0610d0 100644
--- a/src/process.c
+++ b/src/process.c
@@ -121,14 +121,6 @@ Boston, MA 02110-1301, USA. */
121#include <sys/wait.h> 121#include <sys/wait.h>
122#endif 122#endif
123 123
124/* Disable IPv6 support for w32 until someone figures out how to do it
125 properly. */
126#ifdef WINDOWSNT
127# ifdef AF_INET6
128# undef AF_INET6
129# endif
130#endif
131
132#include "lisp.h" 124#include "lisp.h"
133#include "systime.h" 125#include "systime.h"
134#include "systty.h" 126#include "systty.h"
@@ -393,7 +385,7 @@ struct sockaddr_and_len {
393 int len; 385 int len;
394} datagram_address[MAXDESC]; 386} datagram_address[MAXDESC];
395#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0) 387#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
396#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0) 388#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
397#else 389#else
398#define DATAGRAM_CHAN_P(chan) (0) 390#define DATAGRAM_CHAN_P(chan) (0)
399#define DATAGRAM_CONN_P(proc) (0) 391#define DATAGRAM_CONN_P(proc) (0)
@@ -628,19 +620,19 @@ make_process (name)
628 620
629 p = allocate_process (); 621 p = allocate_process ();
630 622
631 XSETINT (p->infd, -1); 623 p->infd = -1;
632 XSETINT (p->outfd, -1); 624 p->outfd = -1;
633 XSETFASTINT (p->tick, 0); 625 p->tick = 0;
634 XSETFASTINT (p->update_tick, 0); 626 p->update_tick = 0;
635 p->pid = 0; 627 p->pid = 0;
636 p->raw_status_new = 0; 628 p->raw_status_new = 0;
637 p->status = Qrun; 629 p->status = Qrun;
638 p->mark = Fmake_marker (); 630 p->mark = Fmake_marker ();
639 631
640#ifdef ADAPTIVE_READ_BUFFERING 632#ifdef ADAPTIVE_READ_BUFFERING
641 p->adaptive_read_buffering = Qnil; 633 p->adaptive_read_buffering = 0;
642 XSETFASTINT (p->read_output_delay, 0); 634 p->read_output_delay = 0;
643 p->read_output_skip = Qnil; 635 p->read_output_skip = 0;
644#endif 636#endif
645 637
646 /* If name is already in use, modify it until it is unused. */ 638 /* If name is already in use, modify it until it is unused. */
@@ -679,8 +671,8 @@ setup_process_coding_systems (process)
679 Lisp_Object process; 671 Lisp_Object process;
680{ 672{
681 struct Lisp_Process *p = XPROCESS (process); 673 struct Lisp_Process *p = XPROCESS (process);
682 int inch = XINT (p->infd); 674 int inch = p->infd;
683 int outch = XINT (p->outfd); 675 int outch = p->outfd;
684 Lisp_Object coding_system; 676 Lisp_Object coding_system;
685 677
686 if (inch < 0 || outch < 0) 678 if (inch < 0 || outch < 0)
@@ -692,7 +684,7 @@ setup_process_coding_systems (process)
692 coding_system = p->decode_coding_system; 684 coding_system = p->decode_coding_system;
693 if (! NILP (p->filter)) 685 if (! NILP (p->filter))
694 { 686 {
695 if (NILP (p->filter_multibyte)) 687 if (!p->filter_multibyte)
696 coding_system = raw_text_coding_system (coding_system); 688 coding_system = raw_text_coding_system (coding_system);
697 } 689 }
698 else if (BUFFERP (p->buffer)) 690 else if (BUFFERP (p->buffer))
@@ -814,10 +806,10 @@ nil, indicating the current buffer's process. */)
814 if (NETCONN1_P (p)) 806 if (NETCONN1_P (p))
815 { 807 {
816 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); 808 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
817 XSETINT (p->tick, ++process_tick); 809 p->tick = ++process_tick;
818 status_notify (p); 810 status_notify (p);
819 } 811 }
820 else if (XINT (p->infd) >= 0) 812 else if (p->infd >= 0)
821 { 813 {
822#ifdef SIGCHLD 814#ifdef SIGCHLD
823 Lisp_Object symbol; 815 Lisp_Object symbol;
@@ -845,7 +837,7 @@ nil, indicating the current buffer's process. */)
845 /* Do this now, since remove_process will make sigchld_handler do nothing. */ 837 /* Do this now, since remove_process will make sigchld_handler do nothing. */
846 p->status 838 p->status
847 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); 839 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
848 XSETINT (p->tick, ++process_tick); 840 p->tick = ++process_tick;
849 status_notify (p); 841 status_notify (p);
850 } 842 }
851 } 843 }
@@ -1037,18 +1029,18 @@ The string argument is normally a multibyte string, except:
1037 (debug) 1029 (debug)
1038 (set-process-filter process ...) */ 1030 (set-process-filter process ...) */
1039 1031
1040 if (XINT (p->infd) >= 0) 1032 if (p->infd >= 0)
1041 { 1033 {
1042 if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) 1034 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
1043 { 1035 {
1044 FD_CLR (XINT (p->infd), &input_wait_mask); 1036 FD_CLR (p->infd, &input_wait_mask);
1045 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 1037 FD_CLR (p->infd, &non_keyboard_wait_mask);
1046 } 1038 }
1047 else if (EQ (p->filter, Qt) 1039 else if (EQ (p->filter, Qt)
1048 && !EQ (p->command, Qt)) /* Network process not stopped. */ 1040 && !EQ (p->command, Qt)) /* Network process not stopped. */
1049 { 1041 {
1050 FD_SET (XINT (p->infd), &input_wait_mask); 1042 FD_SET (p->infd, &input_wait_mask);
1051 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 1043 FD_SET (p->infd, &non_keyboard_wait_mask);
1052 } 1044 }
1053 } 1045 }
1054 1046
@@ -1110,8 +1102,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size,
1110 CHECK_NATNUM (height); 1102 CHECK_NATNUM (height);
1111 CHECK_NATNUM (width); 1103 CHECK_NATNUM (width);
1112 1104
1113 if (XINT (XPROCESS (process)->infd) < 0 1105 if (XPROCESS (process)->infd < 0
1114 || set_window_size (XINT (XPROCESS (process)->infd), 1106 || set_window_size (XPROCESS (process)->infd,
1115 XINT (height), XINT (width)) <= 0) 1107 XINT (height), XINT (width)) <= 0)
1116 return Qnil; 1108 return Qnil;
1117 else 1109 else
@@ -1139,7 +1131,7 @@ for the process which will run. */)
1139 register Lisp_Object process, flag; 1131 register Lisp_Object process, flag;
1140{ 1132{
1141 CHECK_PROCESS (process); 1133 CHECK_PROCESS (process);
1142 XPROCESS (process)->inherit_coding_system_flag = flag; 1134 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1143 return flag; 1135 return flag;
1144} 1136}
1145 1137
@@ -1154,7 +1146,7 @@ the process output. */)
1154 register Lisp_Object process; 1146 register Lisp_Object process;
1155{ 1147{
1156 CHECK_PROCESS (process); 1148 CHECK_PROCESS (process);
1157 return XPROCESS (process)->inherit_coding_system_flag; 1149 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
1158} 1150}
1159 1151
1160DEFUN ("set-process-query-on-exit-flag", 1152DEFUN ("set-process-query-on-exit-flag",
@@ -1167,7 +1159,7 @@ exiting if PROCESS is running. */)
1167 register Lisp_Object process, flag; 1159 register Lisp_Object process, flag;
1168{ 1160{
1169 CHECK_PROCESS (process); 1161 CHECK_PROCESS (process);
1170 XPROCESS (process)->kill_without_query = Fnull (flag); 1162 XPROCESS (process)->kill_without_query = NILP (flag);
1171 return flag; 1163 return flag;
1172} 1164}
1173 1165
@@ -1179,7 +1171,7 @@ DEFUN ("process-query-on-exit-flag",
1179 register Lisp_Object process; 1171 register Lisp_Object process;
1180{ 1172{
1181 CHECK_PROCESS (process); 1173 CHECK_PROCESS (process);
1182 return Fnull (XPROCESS (process)->kill_without_query); 1174 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1183} 1175}
1184 1176
1185#ifdef DATAGRAM_SOCKETS 1177#ifdef DATAGRAM_SOCKETS
@@ -1354,7 +1346,7 @@ list_processes_1 (query_only)
1354 p = XPROCESS (proc); 1346 p = XPROCESS (proc);
1355 if (NILP (p->childp)) 1347 if (NILP (p->childp))
1356 continue; 1348 continue;
1357 if (!NILP (query_only) && !NILP (p->kill_without_query)) 1349 if (!NILP (query_only) && p->kill_without_query)
1358 continue; 1350 continue;
1359 if (STRINGP (p->name) 1351 if (STRINGP (p->name)
1360 && ( i = SCHARS (p->name), (i > w_proc))) 1352 && ( i = SCHARS (p->name), (i > w_proc)))
@@ -1417,7 +1409,7 @@ list_processes_1 (query_only)
1417 p = XPROCESS (proc); 1409 p = XPROCESS (proc);
1418 if (NILP (p->childp)) 1410 if (NILP (p->childp))
1419 continue; 1411 continue;
1420 if (!NILP (query_only) && !NILP (p->kill_without_query)) 1412 if (!NILP (query_only) && p->kill_without_query)
1421 continue; 1413 continue;
1422 1414
1423 Finsert (1, &p->name); 1415 Finsert (1, &p->name);
@@ -1493,7 +1485,7 @@ list_processes_1 (query_only)
1493 if (NILP (port)) 1485 if (NILP (port))
1494 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil); 1486 port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
1495 sprintf (tembuf, "(network %s server on %s)\n", 1487 sprintf (tembuf, "(network %s server on %s)\n",
1496 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), 1488 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1497 (STRINGP (port) ? (char *)SDATA (port) : "?")); 1489 (STRINGP (port) ? (char *)SDATA (port) : "?"));
1498 insert_string (tembuf); 1490 insert_string (tembuf);
1499 } 1491 }
@@ -1511,7 +1503,7 @@ list_processes_1 (query_only)
1511 if (NILP (host)) 1503 if (NILP (host))
1512 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil); 1504 host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
1513 sprintf (tembuf, "(network %s connection to %s)\n", 1505 sprintf (tembuf, "(network %s connection to %s)\n",
1514 (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), 1506 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1515 (STRINGP (host) ? (char *)SDATA (host) : "?")); 1507 (STRINGP (host) ? (char *)SDATA (host) : "?"));
1516 insert_string (tembuf); 1508 insert_string (tembuf);
1517 } 1509 }
@@ -1642,11 +1634,13 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1642 XPROCESS (proc)->sentinel = Qnil; 1634 XPROCESS (proc)->sentinel = Qnil;
1643 XPROCESS (proc)->filter = Qnil; 1635 XPROCESS (proc)->filter = Qnil;
1644 XPROCESS (proc)->filter_multibyte 1636 XPROCESS (proc)->filter_multibyte
1645 = buffer_defaults.enable_multibyte_characters; 1637 = !NILP (buffer_defaults.enable_multibyte_characters);
1646 XPROCESS (proc)->command = Flist (nargs - 2, args + 2); 1638 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1647 1639
1648#ifdef ADAPTIVE_READ_BUFFERING 1640#ifdef ADAPTIVE_READ_BUFFERING
1649 XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering; 1641 XPROCESS (proc)->adaptive_read_buffering
1642 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1643 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1650#endif 1644#endif
1651 1645
1652 /* Make the process marker point into the process buffer (if any). */ 1646 /* Make the process marker point into the process buffer (if any). */
@@ -1777,13 +1771,11 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1777#endif /* not VMS */ 1771#endif /* not VMS */
1778 1772
1779 XPROCESS (proc)->decoding_buf = make_uninit_string (0); 1773 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
1780 XPROCESS (proc)->decoding_carryover = make_number (0); 1774 XPROCESS (proc)->decoding_carryover = 0;
1781 XPROCESS (proc)->encoding_buf = make_uninit_string (0); 1775 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
1782 XPROCESS (proc)->encoding_carryover = make_number (0);
1783 1776
1784 XPROCESS (proc)->inherit_coding_system_flag 1777 XPROCESS (proc)->inherit_coding_system_flag
1785 = (NILP (buffer) || !inherit_process_coding_system 1778 = (NILP (buffer) || !inherit_process_coding_system);
1786 ? Qnil : Qt);
1787 1779
1788 create_process (proc, (char **) new_argv, current_dir); 1780 create_process (proc, (char **) new_argv, current_dir);
1789 1781
@@ -1955,15 +1947,15 @@ create_process (process, new_argv, current_dir)
1955 /* Record this as an active process, with its channels. 1947 /* Record this as an active process, with its channels.
1956 As a result, child_setup will close Emacs's side of the pipes. */ 1948 As a result, child_setup will close Emacs's side of the pipes. */
1957 chan_process[inchannel] = process; 1949 chan_process[inchannel] = process;
1958 XSETINT (XPROCESS (process)->infd, inchannel); 1950 XPROCESS (process)->infd = inchannel;
1959 XSETINT (XPROCESS (process)->outfd, outchannel); 1951 XPROCESS (process)->outfd = outchannel;
1960 1952
1961 /* Previously we recorded the tty descriptor used in the subprocess. 1953 /* Previously we recorded the tty descriptor used in the subprocess.
1962 It was only used for getting the foreground tty process, so now 1954 It was only used for getting the foreground tty process, so now
1963 we just reopen the device (see emacs_get_tty_pgrp) as this is 1955 we just reopen the device (see emacs_get_tty_pgrp) as this is
1964 more portable (see USG_SUBTTY_WORKS above). */ 1956 more portable (see USG_SUBTTY_WORKS above). */
1965 1957
1966 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); 1958 XPROCESS (process)->pty_flag = pty_flag;
1967 XPROCESS (process)->status = Qrun; 1959 XPROCESS (process)->status = Qrun;
1968 setup_process_coding_systems (process); 1960 setup_process_coding_systems (process);
1969 1961
@@ -2480,7 +2472,7 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_
2480 if (!DATAGRAM_CONN_P (process)) 2472 if (!DATAGRAM_CONN_P (process))
2481 return Qnil; 2473 return Qnil;
2482 2474
2483 channel = XINT (XPROCESS (process)->infd); 2475 channel = XPROCESS (process)->infd;
2484 return conv_sockaddr_to_lisp (datagram_address[channel].sa, 2476 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2485 datagram_address[channel].len); 2477 datagram_address[channel].len);
2486} 2478}
@@ -2500,7 +2492,7 @@ Returns nil upon error setting address, ADDRESS otherwise. */)
2500 if (!DATAGRAM_CONN_P (process)) 2492 if (!DATAGRAM_CONN_P (process))
2501 return Qnil; 2493 return Qnil;
2502 2494
2503 channel = XINT (XPROCESS (process)->infd); 2495 channel = XPROCESS (process)->infd;
2504 2496
2505 len = get_lisp_to_sockaddr_size (address, &family); 2497 len = get_lisp_to_sockaddr_size (address, &family);
2506 if (datagram_address[channel].len != len) 2498 if (datagram_address[channel].len != len)
@@ -2665,7 +2657,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */)
2665 if (!NETCONN1_P (p)) 2657 if (!NETCONN1_P (p))
2666 error ("Process is not a network process"); 2658 error ("Process is not a network process");
2667 2659
2668 s = XINT (p->infd); 2660 s = p->infd;
2669 if (s < 0) 2661 if (s < 0)
2670 error ("Process is not running"); 2662 error ("Process is not running");
2671 2663
@@ -3419,18 +3411,18 @@ usage: (make-network-process &rest ARGS) */)
3419 p->buffer = buffer; 3411 p->buffer = buffer;
3420 p->sentinel = sentinel; 3412 p->sentinel = sentinel;
3421 p->filter = filter; 3413 p->filter = filter;
3422 p->filter_multibyte = buffer_defaults.enable_multibyte_characters; 3414 p->filter_multibyte = !NILP (buffer_defaults.enable_multibyte_characters);
3423 /* Override the above only if :filter-multibyte is specified. */ 3415 /* Override the above only if :filter-multibyte is specified. */
3424 if (! NILP (Fplist_member (contact, QCfilter_multibyte))) 3416 if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
3425 p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte); 3417 p->filter_multibyte = !NILP (Fplist_get (contact, QCfilter_multibyte));
3426 p->log = Fplist_get (contact, QClog); 3418 p->log = Fplist_get (contact, QClog);
3427 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) 3419 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3428 p->kill_without_query = Qt; 3420 p->kill_without_query = 1;
3429 if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) 3421 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3430 p->command = Qt; 3422 p->command = Qt;
3431 p->pid = 0; 3423 p->pid = 0;
3432 XSETINT (p->infd, inch); 3424 p->infd = inch;
3433 XSETINT (p->outfd, outch); 3425 p->outfd = outch;
3434 if (is_server && socktype == SOCK_STREAM) 3426 if (is_server && socktype == SOCK_STREAM)
3435 p->status = Qlisten; 3427 p->status = Qlisten;
3436 3428
@@ -3551,13 +3543,11 @@ usage: (make-network-process &rest ARGS) */)
3551 setup_process_coding_systems (proc); 3543 setup_process_coding_systems (proc);
3552 3544
3553 p->decoding_buf = make_uninit_string (0); 3545 p->decoding_buf = make_uninit_string (0);
3554 p->decoding_carryover = make_number (0); 3546 p->decoding_carryover = 0;
3555 p->encoding_buf = make_uninit_string (0); 3547 p->encoding_buf = make_uninit_string (0);
3556 p->encoding_carryover = make_number (0);
3557 3548
3558 p->inherit_coding_system_flag 3549 p->inherit_coding_system_flag
3559 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system 3550 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3560 ? Qnil : Qt);
3561 3551
3562 UNGCPRO; 3552 UNGCPRO;
3563 return proc; 3553 return proc;
@@ -3820,16 +3810,16 @@ deactivate_process (proc)
3820 register int inchannel, outchannel; 3810 register int inchannel, outchannel;
3821 register struct Lisp_Process *p = XPROCESS (proc); 3811 register struct Lisp_Process *p = XPROCESS (proc);
3822 3812
3823 inchannel = XINT (p->infd); 3813 inchannel = p->infd;
3824 outchannel = XINT (p->outfd); 3814 outchannel = p->outfd;
3825 3815
3826#ifdef ADAPTIVE_READ_BUFFERING 3816#ifdef ADAPTIVE_READ_BUFFERING
3827 if (XINT (p->read_output_delay) > 0) 3817 if (p->read_output_delay > 0)
3828 { 3818 {
3829 if (--process_output_delay_count < 0) 3819 if (--process_output_delay_count < 0)
3830 process_output_delay_count = 0; 3820 process_output_delay_count = 0;
3831 XSETINT (p->read_output_delay, 0); 3821 p->read_output_delay = 0;
3832 p->read_output_skip = Qnil; 3822 p->read_output_skip = 0;
3833 } 3823 }
3834#endif 3824#endif
3835 3825
@@ -3851,8 +3841,8 @@ deactivate_process (proc)
3851 emacs_close (outchannel); 3841 emacs_close (outchannel);
3852#endif 3842#endif
3853 3843
3854 XSETINT (p->infd, -1); 3844 p->infd = -1;
3855 XSETINT (p->outfd, -1); 3845 p->outfd = -1;
3856#ifdef DATAGRAM_SOCKETS 3846#ifdef DATAGRAM_SOCKETS
3857 if (DATAGRAM_CHAN_P (inchannel)) 3847 if (DATAGRAM_CHAN_P (inchannel))
3858 { 3848 {
@@ -3900,8 +3890,8 @@ close_process_descs ()
3900 process = chan_process[i]; 3890 process = chan_process[i];
3901 if (!NILP (process)) 3891 if (!NILP (process))
3902 { 3892 {
3903 int in = XINT (XPROCESS (process)->infd); 3893 int in = XPROCESS (process)->infd;
3904 int out = XINT (XPROCESS (process)->outfd); 3894 int out = XPROCESS (process)->outfd;
3905 if (in >= 0) 3895 if (in >= 0)
3906 emacs_close (in); 3896 emacs_close (in);
3907 if (out >= 0 && in != out) 3897 if (out >= 0 && in != out)
@@ -4145,8 +4135,8 @@ server_accept_connection (server, channel)
4145 p->filter = ps->filter; 4135 p->filter = ps->filter;
4146 p->command = Qnil; 4136 p->command = Qnil;
4147 p->pid = 0; 4137 p->pid = 0;
4148 XSETINT (p->infd, s); 4138 p->infd = s;
4149 XSETINT (p->outfd, s); 4139 p->outfd = s;
4150 p->status = Qrun; 4140 p->status = Qrun;
4151 4141
4152 /* Client processes for accepted connections are not stopped initially. */ 4142 /* Client processes for accepted connections are not stopped initially. */
@@ -4169,12 +4159,11 @@ server_accept_connection (server, channel)
4169 setup_process_coding_systems (proc); 4159 setup_process_coding_systems (proc);
4170 4160
4171 p->decoding_buf = make_uninit_string (0); 4161 p->decoding_buf = make_uninit_string (0);
4172 p->decoding_carryover = make_number (0); 4162 p->decoding_carryover = 0;
4173 p->encoding_buf = make_uninit_string (0); 4163 p->encoding_buf = make_uninit_string (0);
4174 p->encoding_carryover = make_number (0);
4175 4164
4176 p->inherit_coding_system_flag 4165 p->inherit_coding_system_flag
4177 = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag); 4166 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4178 4167
4179 if (!NILP (ps->log)) 4168 if (!NILP (ps->log))
4180 call3 (ps->log, server, proc, 4169 call3 (ps->log, server, proc,
@@ -4299,7 +4288,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4299 4288
4300 /* If wait_proc is a process to watch, set wait_channel accordingly. */ 4289 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4301 if (wait_proc != NULL) 4290 if (wait_proc != NULL)
4302 wait_channel = XINT (wait_proc->infd); 4291 wait_channel = wait_proc->infd;
4303 4292
4304 record_unwind_protect (wait_reading_process_output_unwind, 4293 record_unwind_protect (wait_reading_process_output_unwind,
4305 make_number (waiting_for_user_input_p)); 4294 make_number (waiting_for_user_input_p));
@@ -4484,9 +4473,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4484 XSETPROCESS (proc, wait_proc); 4473 XSETPROCESS (proc, wait_proc);
4485 4474
4486 /* Read data from the process, until we exhaust it. */ 4475 /* Read data from the process, until we exhaust it. */
4487 while (XINT (wait_proc->infd) >= 0) 4476 while (wait_proc->infd >= 0)
4488 { 4477 {
4489 nread = read_process_output (proc, XINT (wait_proc->infd)); 4478 nread = read_process_output (proc, wait_proc->infd);
4490 4479
4491 if (nread == 0) 4480 if (nread == 0)
4492 break; 4481 break;
@@ -4516,9 +4505,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4516 4505
4517 if (wait_proc && just_wait_proc) 4506 if (wait_proc && just_wait_proc)
4518 { 4507 {
4519 if (XINT (wait_proc->infd) < 0) /* Terminated */ 4508 if (wait_proc->infd < 0) /* Terminated */
4520 break; 4509 break;
4521 FD_SET (XINT (wait_proc->infd), &Available); 4510 FD_SET (wait_proc->infd, &Available);
4522 check_delay = 0; 4511 check_delay = 0;
4523 IF_NON_BLOCKING_CONNECT (check_connect = 0); 4512 IF_NON_BLOCKING_CONNECT (check_connect = 0);
4524 } 4513 }
@@ -4566,7 +4555,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4566 4555
4567#ifdef ADAPTIVE_READ_BUFFERING 4556#ifdef ADAPTIVE_READ_BUFFERING
4568 /* Set the timeout for adaptive read buffering if any 4557 /* Set the timeout for adaptive read buffering if any
4569 process has non-nil read_output_skip and non-zero 4558 process has non-zero read_output_skip and non-zero
4570 read_output_delay, and we are not reading output for a 4559 read_output_delay, and we are not reading output for a
4571 specific wait_channel. It is not executed if 4560 specific wait_channel. It is not executed if
4572 Vprocess_adaptive_read_buffering is nil. */ 4561 Vprocess_adaptive_read_buffering is nil. */
@@ -4581,16 +4570,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4581 if (NILP (proc)) 4570 if (NILP (proc))
4582 continue; 4571 continue;
4583 /* Find minimum non-zero read_output_delay among the 4572 /* Find minimum non-zero read_output_delay among the
4584 processes with non-nil read_output_skip. */ 4573 processes with non-zero read_output_skip. */
4585 if (XINT (XPROCESS (proc)->read_output_delay) > 0) 4574 if (XPROCESS (proc)->read_output_delay > 0)
4586 { 4575 {
4587 check_delay--; 4576 check_delay--;
4588 if (NILP (XPROCESS (proc)->read_output_skip)) 4577 if (!XPROCESS (proc)->read_output_skip)
4589 continue; 4578 continue;
4590 FD_CLR (channel, &Available); 4579 FD_CLR (channel, &Available);
4591 XPROCESS (proc)->read_output_skip = Qnil; 4580 XPROCESS (proc)->read_output_skip = 0;
4592 if (XINT (XPROCESS (proc)->read_output_delay) < usecs) 4581 if (XPROCESS (proc)->read_output_delay < usecs)
4593 usecs = XINT (XPROCESS (proc)->read_output_delay); 4582 usecs = XPROCESS (proc)->read_output_delay;
4594 } 4583 }
4595 } 4584 }
4596 EMACS_SET_SECS_USECS (timeout, 0, usecs); 4585 EMACS_SET_SECS_USECS (timeout, 0, usecs);
@@ -4863,7 +4852,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4863 else 4852 else
4864 { 4853 {
4865 /* Preserve status of processes already terminated. */ 4854 /* Preserve status of processes already terminated. */
4866 XSETINT (XPROCESS (proc)->tick, ++process_tick); 4855 XPROCESS (proc)->tick = ++process_tick;
4867 deactivate_process (proc); 4856 deactivate_process (proc);
4868 if (XPROCESS (proc)->raw_status_new) 4857 if (XPROCESS (proc)->raw_status_new)
4869 update_status (XPROCESS (proc)); 4858 update_status (XPROCESS (proc));
@@ -4915,7 +4904,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4915#endif 4904#endif
4916 if (xerrno) 4905 if (xerrno)
4917 { 4906 {
4918 XSETINT (p->tick, ++process_tick); 4907 p->tick = ++process_tick;
4919 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); 4908 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
4920 deactivate_process (proc); 4909 deactivate_process (proc);
4921 } 4910 }
@@ -4928,8 +4917,8 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
4928 exec_sentinel (proc, build_string ("open\n")); 4917 exec_sentinel (proc, build_string ("open\n"));
4929 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) 4918 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
4930 { 4919 {
4931 FD_SET (XINT (p->infd), &input_wait_mask); 4920 FD_SET (p->infd, &input_wait_mask);
4932 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 4921 FD_SET (p->infd, &non_keyboard_wait_mask);
4933 } 4922 }
4934 } 4923 }
4935 } 4924 }
@@ -5003,7 +4992,7 @@ read_process_output (proc, channel)
5003 register struct Lisp_Process *p = XPROCESS (proc); 4992 register struct Lisp_Process *p = XPROCESS (proc);
5004 register int opoint; 4993 register int opoint;
5005 struct coding_system *coding = proc_decode_coding_system[channel]; 4994 struct coding_system *coding = proc_decode_coding_system[channel];
5006 int carryover = XINT (p->decoding_carryover); 4995 int carryover = p->decoding_carryover;
5007 int readmax = 4096; 4996 int readmax = 4096;
5008 4997
5009#ifdef VMS 4998#ifdef VMS
@@ -5056,9 +5045,9 @@ read_process_output (proc, channel)
5056 { 5045 {
5057 nbytes = emacs_read (channel, chars + carryover, readmax); 5046 nbytes = emacs_read (channel, chars + carryover, readmax);
5058#ifdef ADAPTIVE_READ_BUFFERING 5047#ifdef ADAPTIVE_READ_BUFFERING
5059 if (nbytes > 0 && !NILP (p->adaptive_read_buffering)) 5048 if (nbytes > 0 && p->adaptive_read_buffering)
5060 { 5049 {
5061 int delay = XINT (p->read_output_delay); 5050 int delay = p->read_output_delay;
5062 if (nbytes < 256) 5051 if (nbytes < 256)
5063 { 5052 {
5064 if (delay < READ_OUTPUT_DELAY_MAX_MAX) 5053 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
@@ -5074,10 +5063,10 @@ read_process_output (proc, channel)
5074 if (delay == 0) 5063 if (delay == 0)
5075 process_output_delay_count--; 5064 process_output_delay_count--;
5076 } 5065 }
5077 XSETINT (p->read_output_delay, delay); 5066 p->read_output_delay = delay;
5078 if (delay) 5067 if (delay)
5079 { 5068 {
5080 p->read_output_skip = Qt; 5069 p->read_output_skip = 1;
5081 process_output_skip = 1; 5070 process_output_skip = 1;
5082 } 5071 }
5083 } 5072 }
@@ -5095,7 +5084,7 @@ read_process_output (proc, channel)
5095 } 5084 }
5096#endif /* not VMS */ 5085#endif /* not VMS */
5097 5086
5098 XSETINT (p->decoding_carryover, 0); 5087 p->decoding_carryover = 0;
5099 5088
5100 /* At this point, NBYTES holds number of bytes just received 5089 /* At this point, NBYTES holds number of bytes just received
5101 (including the one in proc_buffered_char[channel]). */ 5090 (including the one in proc_buffered_char[channel]). */
@@ -5169,12 +5158,12 @@ read_process_output (proc, channel)
5169 valid memory because p->outfd will be changed once EOF is 5158 valid memory because p->outfd will be changed once EOF is
5170 sent to the process. */ 5159 sent to the process. */
5171 if (NILP (p->encode_coding_system) 5160 if (NILP (p->encode_coding_system)
5172 && proc_encode_coding_system[XINT (p->outfd)]) 5161 && proc_encode_coding_system[p->outfd])
5173 { 5162 {
5174 p->encode_coding_system 5163 p->encode_coding_system
5175 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); 5164 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5176 setup_coding_system (p->encode_coding_system, 5165 setup_coding_system (p->encode_coding_system,
5177 proc_encode_coding_system[XINT (p->outfd)]); 5166 proc_encode_coding_system[p->outfd]);
5178 } 5167 }
5179 } 5168 }
5180 5169
@@ -5184,10 +5173,10 @@ read_process_output (proc, channel)
5184 p->decoding_buf = make_uninit_string (coding->carryover_bytes); 5173 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
5185 bcopy (coding->carryover, SDATA (p->decoding_buf), 5174 bcopy (coding->carryover, SDATA (p->decoding_buf),
5186 coding->carryover_bytes); 5175 coding->carryover_bytes);
5187 XSETINT (p->decoding_carryover, coding->carryover_bytes); 5176 p->decoding_carryover = coding->carryover_bytes;
5188 } 5177 }
5189 /* Adjust the multibyteness of TEXT to that of the filter. */ 5178 /* Adjust the multibyteness of TEXT to that of the filter. */
5190 if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text)) 5179 if (p->filter_multibyte != STRING_MULTIBYTE (text))
5191 text = (STRING_MULTIBYTE (text) 5180 text = (STRING_MULTIBYTE (text)
5192 ? Fstring_as_unibyte (text) 5181 ? Fstring_as_unibyte (text)
5193 : Fstring_to_multibyte (text)); 5182 : Fstring_to_multibyte (text));
@@ -5279,12 +5268,12 @@ read_process_output (proc, channel)
5279 { 5268 {
5280 p->decode_coding_system = Vlast_coding_system_used; 5269 p->decode_coding_system = Vlast_coding_system_used;
5281 if (NILP (p->encode_coding_system) 5270 if (NILP (p->encode_coding_system)
5282 && proc_encode_coding_system[XINT (p->outfd)]) 5271 && proc_encode_coding_system[p->outfd])
5283 { 5272 {
5284 p->encode_coding_system 5273 p->encode_coding_system
5285 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); 5274 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5286 setup_coding_system (p->encode_coding_system, 5275 setup_coding_system (p->encode_coding_system,
5287 proc_encode_coding_system[XINT (p->outfd)]); 5276 proc_encode_coding_system[p->outfd]);
5288 } 5277 }
5289 } 5278 }
5290 if (coding->carryover_bytes > 0) 5279 if (coding->carryover_bytes > 0)
@@ -5293,7 +5282,7 @@ read_process_output (proc, channel)
5293 p->decoding_buf = make_uninit_string (coding->carryover_bytes); 5282 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
5294 bcopy (coding->carryover, SDATA (p->decoding_buf), 5283 bcopy (coding->carryover, SDATA (p->decoding_buf),
5295 coding->carryover_bytes); 5284 coding->carryover_bytes);
5296 XSETINT (p->decoding_carryover, coding->carryover_bytes); 5285 p->decoding_carryover = coding->carryover_bytes;
5297 } 5286 }
5298 /* Adjust the multibyteness of TEXT to that of the buffer. */ 5287 /* Adjust the multibyteness of TEXT to that of the buffer. */
5299 if (NILP (current_buffer->enable_multibyte_characters) 5288 if (NILP (current_buffer->enable_multibyte_characters)
@@ -5412,10 +5401,10 @@ send_process (proc, buf, len, object)
5412 update_status (p); 5401 update_status (p);
5413 if (! EQ (p->status, Qrun)) 5402 if (! EQ (p->status, Qrun))
5414 error ("Process %s not running", SDATA (p->name)); 5403 error ("Process %s not running", SDATA (p->name));
5415 if (XINT (p->outfd) < 0) 5404 if (p->outfd < 0)
5416 error ("Output file descriptor of %s is closed", SDATA (p->name)); 5405 error ("Output file descriptor of %s is closed", SDATA (p->name));
5417 5406
5418 coding = proc_encode_coding_system[XINT (p->outfd)]; 5407 coding = proc_encode_coding_system[p->outfd];
5419 Vlast_coding_system_used = CODING_ID_NAME (coding->id); 5408 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5420 5409
5421 if ((STRINGP (object) && STRING_MULTIBYTE (object)) 5410 if ((STRINGP (object) && STRING_MULTIBYTE (object))
@@ -5499,7 +5488,7 @@ send_process (proc, buf, len, object)
5499 if (pty_max_bytes == 0) 5488 if (pty_max_bytes == 0)
5500 { 5489 {
5501#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) 5490#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5502 pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON); 5491 pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
5503 if (pty_max_bytes < 0) 5492 if (pty_max_bytes < 0)
5504 pty_max_bytes = 250; 5493 pty_max_bytes = 250;
5505#else 5494#else
@@ -5521,7 +5510,7 @@ send_process (proc, buf, len, object)
5521 5510
5522 /* Decide how much data we can send in one batch. 5511 /* Decide how much data we can send in one batch.
5523 Long lines need to be split into multiple batches. */ 5512 Long lines need to be split into multiple batches. */
5524 if (!NILP (p->pty_flag)) 5513 if (p->pty_flag)
5525 { 5514 {
5526 /* Starting this at zero is always correct when not the first 5515 /* Starting this at zero is always correct when not the first
5527 iteration because the previous iteration ended by sending C-d. 5516 iteration because the previous iteration ended by sending C-d.
@@ -5550,7 +5539,7 @@ send_process (proc, buf, len, object)
5550 /* Send this batch, using one or more write calls. */ 5539 /* Send this batch, using one or more write calls. */
5551 while (this > 0) 5540 while (this > 0)
5552 { 5541 {
5553 int outfd = XINT (p->outfd); 5542 int outfd = p->outfd;
5554 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); 5543 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
5555#ifdef DATAGRAM_SOCKETS 5544#ifdef DATAGRAM_SOCKETS
5556 if (DATAGRAM_CHAN_P (outfd)) 5545 if (DATAGRAM_CHAN_P (outfd))
@@ -5570,12 +5559,12 @@ send_process (proc, buf, len, object)
5570 { 5559 {
5571 rv = emacs_write (outfd, (char *) buf, this); 5560 rv = emacs_write (outfd, (char *) buf, this);
5572#ifdef ADAPTIVE_READ_BUFFERING 5561#ifdef ADAPTIVE_READ_BUFFERING
5573 if (XINT (p->read_output_delay) > 0 5562 if (p->read_output_delay > 0
5574 && EQ (p->adaptive_read_buffering, Qt)) 5563 && p->adaptive_read_buffering == 1)
5575 { 5564 {
5576 XSETFASTINT (p->read_output_delay, 0); 5565 p->read_output_delay = 0;
5577 process_output_delay_count--; 5566 process_output_delay_count--;
5578 p->read_output_skip = Qnil; 5567 p->read_output_skip = 0;
5579 } 5568 }
5580#endif 5569#endif
5581 } 5570 }
@@ -5618,7 +5607,7 @@ send_process (proc, buf, len, object)
5618 if (errno == EAGAIN) 5607 if (errno == EAGAIN)
5619 { 5608 {
5620 int flags = FWRITE; 5609 int flags = FWRITE;
5621 ioctl (XINT (p->outfd), TIOCFLUSH, &flags); 5610 ioctl (p->outfd, TIOCFLUSH, &flags);
5622 } 5611 }
5623#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ 5612#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5624 5613
@@ -5667,7 +5656,7 @@ send_process (proc, buf, len, object)
5667#endif 5656#endif
5668 p->raw_status_new = 0; 5657 p->raw_status_new = 0;
5669 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); 5658 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
5670 XSETINT (p->tick, ++process_tick); 5659 p->tick = ++process_tick;
5671 deactivate_process (proc); 5660 deactivate_process (proc);
5672#ifdef VMS 5661#ifdef VMS
5673 error ("Error writing to process %s; closed it", SDATA (p->name)); 5662 error ("Error writing to process %s; closed it", SDATA (p->name));
@@ -5736,7 +5725,7 @@ emacs_get_tty_pgrp (p)
5736 int gid = -1; 5725 int gid = -1;
5737 5726
5738#ifdef TIOCGPGRP 5727#ifdef TIOCGPGRP
5739 if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) 5728 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
5740 { 5729 {
5741 int fd; 5730 int fd;
5742 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the 5731 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
@@ -5774,7 +5763,7 @@ return t unconditionally. */)
5774 if (!EQ (p->childp, Qt)) 5763 if (!EQ (p->childp, Qt))
5775 error ("Process %s is not a subprocess", 5764 error ("Process %s is not a subprocess",
5776 SDATA (p->name)); 5765 SDATA (p->name));
5777 if (XINT (p->infd) < 0) 5766 if (p->infd < 0)
5778 error ("Process %s is not active", 5767 error ("Process %s is not active",
5779 SDATA (p->name)); 5768 SDATA (p->name));
5780 5769
@@ -5817,11 +5806,11 @@ process_send_signal (process, signo, current_group, nomsg)
5817 if (!EQ (p->childp, Qt)) 5806 if (!EQ (p->childp, Qt))
5818 error ("Process %s is not a subprocess", 5807 error ("Process %s is not a subprocess",
5819 SDATA (p->name)); 5808 SDATA (p->name));
5820 if (XINT (p->infd) < 0) 5809 if (p->infd < 0)
5821 error ("Process %s is not active", 5810 error ("Process %s is not active",
5822 SDATA (p->name)); 5811 SDATA (p->name));
5823 5812
5824 if (NILP (p->pty_flag)) 5813 if (!p->pty_flag)
5825 current_group = Qnil; 5814 current_group = Qnil;
5826 5815
5827 /* If we are using pgrps, get a pgrp number and make it negative. */ 5816 /* If we are using pgrps, get a pgrp number and make it negative. */
@@ -5840,7 +5829,7 @@ process_send_signal (process, signo, current_group, nomsg)
5840 struct termios t; 5829 struct termios t;
5841 cc_t *sig_char = NULL; 5830 cc_t *sig_char = NULL;
5842 5831
5843 tcgetattr (XINT (p->infd), &t); 5832 tcgetattr (p->infd, &t);
5844 5833
5845 switch (signo) 5834 switch (signo)
5846 { 5835 {
@@ -5880,16 +5869,16 @@ process_send_signal (process, signo, current_group, nomsg)
5880 switch (signo) 5869 switch (signo)
5881 { 5870 {
5882 case SIGINT: 5871 case SIGINT:
5883 ioctl (XINT (p->infd), TIOCGETC, &c); 5872 ioctl (p->infd, TIOCGETC, &c);
5884 send_process (proc, &c.t_intrc, 1, Qnil); 5873 send_process (proc, &c.t_intrc, 1, Qnil);
5885 return; 5874 return;
5886 case SIGQUIT: 5875 case SIGQUIT:
5887 ioctl (XINT (p->infd), TIOCGETC, &c); 5876 ioctl (p->infd, TIOCGETC, &c);
5888 send_process (proc, &c.t_quitc, 1, Qnil); 5877 send_process (proc, &c.t_quitc, 1, Qnil);
5889 return; 5878 return;
5890#ifdef SIGTSTP 5879#ifdef SIGTSTP
5891 case SIGTSTP: 5880 case SIGTSTP:
5892 ioctl (XINT (p->infd), TIOCGLTC, &lc); 5881 ioctl (p->infd, TIOCGLTC, &lc);
5893 send_process (proc, &lc.t_suspc, 1, Qnil); 5882 send_process (proc, &lc.t_suspc, 1, Qnil);
5894 return; 5883 return;
5895#endif /* ! defined (SIGTSTP) */ 5884#endif /* ! defined (SIGTSTP) */
@@ -5904,16 +5893,16 @@ process_send_signal (process, signo, current_group, nomsg)
5904 switch (signo) 5893 switch (signo)
5905 { 5894 {
5906 case SIGINT: 5895 case SIGINT:
5907 ioctl (XINT (p->infd), TCGETA, &t); 5896 ioctl (p->infd, TCGETA, &t);
5908 send_process (proc, &t.c_cc[VINTR], 1, Qnil); 5897 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
5909 return; 5898 return;
5910 case SIGQUIT: 5899 case SIGQUIT:
5911 ioctl (XINT (p->infd), TCGETA, &t); 5900 ioctl (p->infd, TCGETA, &t);
5912 send_process (proc, &t.c_cc[VQUIT], 1, Qnil); 5901 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
5913 return; 5902 return;
5914#ifdef SIGTSTP 5903#ifdef SIGTSTP
5915 case SIGTSTP: 5904 case SIGTSTP:
5916 ioctl (XINT (p->infd), TCGETA, &t); 5905 ioctl (p->infd, TCGETA, &t);
5917 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); 5906 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
5918 return; 5907 return;
5919#endif /* ! defined (SIGTSTP) */ 5908#endif /* ! defined (SIGTSTP) */
@@ -5971,7 +5960,7 @@ process_send_signal (process, signo, current_group, nomsg)
5971 case SIGCONT: 5960 case SIGCONT:
5972 p->raw_status_new = 0; 5961 p->raw_status_new = 0;
5973 p->status = Qrun; 5962 p->status = Qrun;
5974 XSETINT (p->tick, ++process_tick); 5963 p->tick = ++process_tick;
5975 if (!nomsg) 5964 if (!nomsg)
5976 status_notify (NULL); 5965 status_notify (NULL);
5977 break; 5966 break;
@@ -5991,7 +5980,7 @@ process_send_signal (process, signo, current_group, nomsg)
5991 sys$forcex (&(p->pid), 0, 1); 5980 sys$forcex (&(p->pid), 0, 1);
5992 whoosh: 5981 whoosh:
5993#endif 5982#endif
5994 flush_pending_output (XINT (p->infd)); 5983 flush_pending_output (p->infd);
5995 break; 5984 break;
5996 } 5985 }
5997 5986
@@ -6008,7 +5997,7 @@ process_send_signal (process, signo, current_group, nomsg)
6008#ifdef TIOCSIGSEND 5997#ifdef TIOCSIGSEND
6009 if (!NILP (current_group)) 5998 if (!NILP (current_group))
6010 { 5999 {
6011 if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1) 6000 if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
6012 EMACS_KILLPG (gid, signo); 6001 EMACS_KILLPG (gid, signo);
6013 } 6002 }
6014 else 6003 else
@@ -6074,10 +6063,10 @@ If PROCESS is a network process, inhibit handling of incoming traffic. */)
6074 6063
6075 p = XPROCESS (process); 6064 p = XPROCESS (process);
6076 if (NILP (p->command) 6065 if (NILP (p->command)
6077 && XINT (p->infd) >= 0) 6066 && p->infd >= 0)
6078 { 6067 {
6079 FD_CLR (XINT (p->infd), &input_wait_mask); 6068 FD_CLR (p->infd, &input_wait_mask);
6080 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 6069 FD_CLR (p->infd, &non_keyboard_wait_mask);
6081 } 6070 }
6082 p->command = Qt; 6071 p->command = Qt;
6083 return process; 6072 return process;
@@ -6105,11 +6094,11 @@ If PROCESS is a network process, resume handling of incoming traffic. */)
6105 6094
6106 p = XPROCESS (process); 6095 p = XPROCESS (process);
6107 if (EQ (p->command, Qt) 6096 if (EQ (p->command, Qt)
6108 && XINT (p->infd) >= 0 6097 && p->infd >= 0
6109 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) 6098 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6110 { 6099 {
6111 FD_SET (XINT (p->infd), &input_wait_mask); 6100 FD_SET (p->infd, &input_wait_mask);
6112 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 6101 FD_SET (p->infd, &non_keyboard_wait_mask);
6113 } 6102 }
6114 p->command = Qnil; 6103 p->command = Qnil;
6115 return process; 6104 return process;
@@ -6306,7 +6295,7 @@ text to PROCESS after you call this function. */)
6306 return process; 6295 return process;
6307 6296
6308 proc = get_process (process); 6297 proc = get_process (process);
6309 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; 6298 coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
6310 6299
6311 /* Make sure the process is really alive. */ 6300 /* Make sure the process is really alive. */
6312 if (XPROCESS (proc)->raw_status_new) 6301 if (XPROCESS (proc)->raw_status_new)
@@ -6323,7 +6312,7 @@ text to PROCESS after you call this function. */)
6323#ifdef VMS 6312#ifdef VMS
6324 send_process (proc, "\032", 1, Qnil); /* ^z */ 6313 send_process (proc, "\032", 1, Qnil); /* ^z */
6325#else 6314#else
6326 if (!NILP (XPROCESS (proc)->pty_flag)) 6315 if (XPROCESS (proc)->pty_flag)
6327 send_process (proc, "\004", 1, Qnil); 6316 send_process (proc, "\004", 1, Qnil);
6328 else 6317 else
6329 { 6318 {
@@ -6335,18 +6324,18 @@ text to PROCESS after you call this function. */)
6335 (In some old system, shutdown to socketpair doesn't work. 6324 (In some old system, shutdown to socketpair doesn't work.
6336 Then we just can't win.) */ 6325 Then we just can't win.) */
6337 if (XPROCESS (proc)->pid == 0 6326 if (XPROCESS (proc)->pid == 0
6338 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd)) 6327 || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
6339 shutdown (XINT (XPROCESS (proc)->outfd), 1); 6328 shutdown (XPROCESS (proc)->outfd, 1);
6340 /* In case of socketpair, outfd == infd, so don't close it. */ 6329 /* In case of socketpair, outfd == infd, so don't close it. */
6341 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd)) 6330 if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
6342 emacs_close (XINT (XPROCESS (proc)->outfd)); 6331 emacs_close (XPROCESS (proc)->outfd);
6343#else /* not HAVE_SHUTDOWN */ 6332#else /* not HAVE_SHUTDOWN */
6344 emacs_close (XINT (XPROCESS (proc)->outfd)); 6333 emacs_close (XPROCESS (proc)->outfd);
6345#endif /* not HAVE_SHUTDOWN */ 6334#endif /* not HAVE_SHUTDOWN */
6346 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0); 6335 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6347 if (new_outfd < 0) 6336 if (new_outfd < 0)
6348 abort (); 6337 abort ();
6349 old_outfd = XINT (XPROCESS (proc)->outfd); 6338 old_outfd = XPROCESS (proc)->outfd;
6350 6339
6351 if (!proc_encode_coding_system[new_outfd]) 6340 if (!proc_encode_coding_system[new_outfd])
6352 proc_encode_coding_system[new_outfd] 6341 proc_encode_coding_system[new_outfd]
@@ -6357,7 +6346,7 @@ text to PROCESS after you call this function. */)
6357 bzero (proc_encode_coding_system[old_outfd], 6346 bzero (proc_encode_coding_system[old_outfd],
6358 sizeof (struct coding_system)); 6347 sizeof (struct coding_system));
6359 6348
6360 XSETINT (XPROCESS (proc)->outfd, new_outfd); 6349 XPROCESS (proc)->outfd = new_outfd;
6361 } 6350 }
6362#endif /* VMS */ 6351#endif /* VMS */
6363 return process; 6352 return process;
@@ -6380,7 +6369,7 @@ kill_buffer_processes (buffer)
6380 { 6369 {
6381 if (NETCONN_P (proc)) 6370 if (NETCONN_P (proc))
6382 Fdelete_process (proc); 6371 Fdelete_process (proc);
6383 else if (XINT (XPROCESS (proc)->infd) >= 0) 6372 else if (XPROCESS (proc)->infd >= 0)
6384 process_send_signal (proc, SIGHUP, Qnil, 1); 6373 process_send_signal (proc, SIGHUP, Qnil, 1);
6385 } 6374 }
6386 } 6375 }
@@ -6510,21 +6499,21 @@ sigchld_handler (signo)
6510 union { int i; WAITTYPE wt; } u; 6499 union { int i; WAITTYPE wt; } u;
6511 int clear_desc_flag = 0; 6500 int clear_desc_flag = 0;
6512 6501
6513 XSETINT (p->tick, ++process_tick); 6502 p->tick = ++process_tick;
6514 u.wt = w; 6503 u.wt = w;
6515 p->raw_status = u.i; 6504 p->raw_status = u.i;
6516 p->raw_status_new = 1; 6505 p->raw_status_new = 1;
6517 6506
6518 /* If process has terminated, stop waiting for its output. */ 6507 /* If process has terminated, stop waiting for its output. */
6519 if ((WIFSIGNALED (w) || WIFEXITED (w)) 6508 if ((WIFSIGNALED (w) || WIFEXITED (w))
6520 && XINT (p->infd) >= 0) 6509 && p->infd >= 0)
6521 clear_desc_flag = 1; 6510 clear_desc_flag = 1;
6522 6511
6523 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ 6512 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6524 if (clear_desc_flag) 6513 if (clear_desc_flag)
6525 { 6514 {
6526 FD_CLR (XINT (p->infd), &input_wait_mask); 6515 FD_CLR (p->infd, &input_wait_mask);
6527 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 6516 FD_CLR (p->infd, &non_keyboard_wait_mask);
6528 } 6517 }
6529 6518
6530 /* Tell wait_reading_process_output that it needs to wake up and 6519 /* Tell wait_reading_process_output that it needs to wake up and
@@ -6701,18 +6690,18 @@ status_notify (deleting_process)
6701 proc = Fcdr (Fcar (tail)); 6690 proc = Fcdr (Fcar (tail));
6702 p = XPROCESS (proc); 6691 p = XPROCESS (proc);
6703 6692
6704 if (XINT (p->tick) != XINT (p->update_tick)) 6693 if (p->tick != p->update_tick)
6705 { 6694 {
6706 XSETINT (p->update_tick, XINT (p->tick)); 6695 p->update_tick = p->tick;
6707 6696
6708 /* If process is still active, read any output that remains. */ 6697 /* If process is still active, read any output that remains. */
6709 while (! EQ (p->filter, Qt) 6698 while (! EQ (p->filter, Qt)
6710 && ! EQ (p->status, Qconnect) 6699 && ! EQ (p->status, Qconnect)
6711 && ! EQ (p->status, Qlisten) 6700 && ! EQ (p->status, Qlisten)
6712 && ! EQ (p->command, Qt) /* Network process not stopped. */ 6701 && ! EQ (p->command, Qt) /* Network process not stopped. */
6713 && XINT (p->infd) >= 0 6702 && p->infd >= 0
6714 && p != deleting_process 6703 && p != deleting_process
6715 && read_process_output (proc, XINT (p->infd)) > 0); 6704 && read_process_output (proc, p->infd) > 0);
6716 6705
6717 buffer = p->buffer; 6706 buffer = p->buffer;
6718 6707
@@ -6739,7 +6728,7 @@ status_notify (deleting_process)
6739 So set p->update_tick again 6728 So set p->update_tick again
6740 so that an error in the sentinel will not cause 6729 so that an error in the sentinel will not cause
6741 this code to be run again. */ 6730 this code to be run again. */
6742 XSETINT (p->update_tick, XINT (p->tick)); 6731 p->update_tick = p->tick;
6743 /* Now output the message suitably. */ 6732 /* Now output the message suitably. */
6744 if (!NILP (p->sentinel)) 6733 if (!NILP (p->sentinel))
6745 exec_sentinel (proc, msg); 6734 exec_sentinel (proc, msg);
@@ -6812,9 +6801,9 @@ encode subprocess input. */)
6812 6801
6813 CHECK_PROCESS (process); 6802 CHECK_PROCESS (process);
6814 p = XPROCESS (process); 6803 p = XPROCESS (process);
6815 if (XINT (p->infd) < 0) 6804 if (p->infd < 0)
6816 error ("Input file descriptor of %s closed", SDATA (p->name)); 6805 error ("Input file descriptor of %s closed", SDATA (p->name));
6817 if (XINT (p->outfd) < 0) 6806 if (p->outfd < 0)
6818 error ("Output file descriptor of %s closed", SDATA (p->name)); 6807 error ("Output file descriptor of %s closed", SDATA (p->name));
6819 Fcheck_coding_system (decoding); 6808 Fcheck_coding_system (decoding);
6820 Fcheck_coding_system (encoding); 6809 Fcheck_coding_system (encoding);
@@ -6851,7 +6840,7 @@ suppressed. */)
6851 6840
6852 CHECK_PROCESS (process); 6841 CHECK_PROCESS (process);
6853 p = XPROCESS (process); 6842 p = XPROCESS (process);
6854 p->filter_multibyte = flag; 6843 p->filter_multibyte = !NILP (flag);
6855 setup_process_coding_systems (process); 6844 setup_process_coding_systems (process);
6856 6845
6857 return Qnil; 6846 return Qnil;
@@ -6868,7 +6857,7 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6868 CHECK_PROCESS (process); 6857 CHECK_PROCESS (process);
6869 p = XPROCESS (process); 6858 p = XPROCESS (process);
6870 6859
6871 return (NILP (p->filter_multibyte) ? Qnil : Qt); 6860 return (p->filter_multibyte ? Qt : Qnil);
6872} 6861}
6873 6862
6874 6863
diff --git a/src/process.h b/src/process.h
index 718d2a70ea8..fd7847b5e29 100644
--- a/src/process.h
+++ b/src/process.h
@@ -36,10 +36,6 @@ struct Lisp_Process
36 { 36 {
37 EMACS_INT size; 37 EMACS_INT size;
38 struct Lisp_Vector *v_next; 38 struct Lisp_Vector *v_next;
39 /* Descriptor by which we read from this process */
40 Lisp_Object infd;
41 /* Descriptor by which we write to this process */
42 Lisp_Object outfd;
43 /* Name of subprocess terminal. */ 39 /* Name of subprocess terminal. */
44 Lisp_Object tty_name; 40 Lisp_Object tty_name;
45 /* Name of this process */ 41 /* Name of this process */
@@ -64,61 +60,65 @@ struct Lisp_Process
64 Lisp_Object plist; 60 Lisp_Object plist;
65 /* Marker set to end of last buffer-inserted output from this process */ 61 /* Marker set to end of last buffer-inserted output from this process */
66 Lisp_Object mark; 62 Lisp_Object mark;
67 /* Non-nil means kill silently if Emacs is exited.
68 This is the inverse of the `query-on-exit' flag. */
69 Lisp_Object kill_without_query;
70 /* Symbol indicating status of process. 63 /* Symbol indicating status of process.
71 This may be a symbol: run, open, or closed. 64 This may be a symbol: run, open, or closed.
72 Or it may be a list, whose car is stop, exit or signal 65 Or it may be a list, whose car is stop, exit or signal
73 and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG) 66 and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG)
74 or (SIGNAL_NUMBER . COREDUMP_FLAG). */ 67 or (SIGNAL_NUMBER . COREDUMP_FLAG). */
75 Lisp_Object status; 68 Lisp_Object status;
76 /* Non-nil if communicating through a pty. */
77 Lisp_Object pty_flag;
78 /* Event-count of last event in which this process changed status. */
79 Lisp_Object tick;
80 /* Event-count of last such event reported. */
81 Lisp_Object update_tick;
82 /* Coding-system for decoding the input from this process. */ 69 /* Coding-system for decoding the input from this process. */
83 Lisp_Object decode_coding_system; 70 Lisp_Object decode_coding_system;
84 /* Working buffer for decoding. */ 71 /* Working buffer for decoding. */
85 Lisp_Object decoding_buf; 72 Lisp_Object decoding_buf;
86 /* Size of carryover in decoding. */
87 Lisp_Object decoding_carryover;
88 /* Coding-system for encoding the output to this process. */ 73 /* Coding-system for encoding the output to this process. */
89 Lisp_Object encode_coding_system; 74 Lisp_Object encode_coding_system;
90 /* Working buffer for encoding. */ 75 /* Working buffer for encoding. */
91 Lisp_Object encoding_buf; 76 Lisp_Object encoding_buf;
92 /* Size of carryover in encoding. */
93 Lisp_Object encoding_carryover;
94 /* Flag to set coding-system of the process buffer from the
95 coding_system used to decode process output. */
96 Lisp_Object inherit_coding_system_flag;
97 /* Flat to decide the multibyteness of a string given to the
98 filter (if any). It is initialized to the value of
99 `default-enable-multibyte-characters' when the process is
100 generated, and can be changed by the function
101 `set-process-fileter-multibyte'. */
102 Lisp_Object filter_multibyte;
103 /* Should we delay reading output from this process.
104 Initialized from `Vprocess_adaptive_read_buffering'. */
105 Lisp_Object adaptive_read_buffering;
106 /* Hysteresis to try to read process output in larger blocks.
107 On some systems, e.g. GNU/Linux, Emacs is seen as
108 an interactive app also when reading process output, meaning
109 that process output can be read in as little as 1 byte at a
110 time. Value is micro-seconds to delay reading output from
111 this process. Range is 0 .. 50000. */
112 Lisp_Object read_output_delay;
113 /* Skip reading this process on next read. */
114 Lisp_Object read_output_skip;
115 77
116 /* After this point, there are no Lisp_Objects any more. */ 78 /* After this point, there are no Lisp_Objects any more. */
79 /* alloc.c assumes that `pid' is the first such non-Lisp slot. */
117 80
118 /* Number of this process. 81 /* Number of this process.
119 allocate_process assumes this is the first non-Lisp_Object field. 82 allocate_process assumes this is the first non-Lisp_Object field.
120 A value 0 is used for pseudo-processes such as network connections. */ 83 A value 0 is used for pseudo-processes such as network connections. */
121 pid_t pid; 84 pid_t pid;
85 /* Descriptor by which we read from this process */
86 int infd;
87 /* Descriptor by which we write to this process */
88 int outfd;
89 /* Event-count of last event in which this process changed status. */
90 int tick;
91 /* Event-count of last such event reported. */
92 int update_tick;
93 /* Size of carryover in decoding. */
94 int decoding_carryover;
95 /* Hysteresis to try to read process output in larger blocks.
96 On some systems, e.g. GNU/Linux, Emacs is seen as
97 an interactive app also when reading process output, meaning
98 that process output can be read in as little as 1 byte at a
99 time. Value is micro-seconds to delay reading output from
100 this process. Range is 0 .. 50000. */
101 int read_output_delay;
102 /* Should we delay reading output from this process.
103 Initialized from `Vprocess_adaptive_read_buffering'.
104 0 = nil, 1 = t, 2 = other. */
105 int adaptive_read_buffering : 2;
106 /* Skip reading this process on next read. */
107 int read_output_skip : 1;
108 /* Non-nil means kill silently if Emacs is exited.
109 This is the inverse of the `query-on-exit' flag. */
110 int kill_without_query : 1;
111 /* Non-nil if communicating through a pty. */
112 int pty_flag : 1;
113 /* Flag to set coding-system of the process buffer from the
114 coding_system used to decode process output. */
115 int inherit_coding_system_flag : 1;
116 /* Flag to decide the multibyteness of a string given to the
117 filter (if any). It is initialized to the value of
118 `default-enable-multibyte-characters' when the process is
119 generated, and can be changed by the function
120 `set-process-filter-multibyte'. */
121 int filter_multibyte : 1;
122 /* Record the process status in the raw form in which it comes from `wait'. 122 /* Record the process status in the raw form in which it comes from `wait'.
123 This is to avoid consing in a signal handler. The `raw_status_new' 123 This is to avoid consing in a signal handler. The `raw_status_new'
124 flag indicates that `raw_status' contains a new status that still 124 flag indicates that `raw_status' contains a new status that still
diff --git a/src/search.c b/src/search.c
index fd7b474e4ab..ae5ae608e4a 100644
--- a/src/search.c
+++ b/src/search.c
@@ -93,6 +93,11 @@ Lisp_Object Qsearch_failed;
93 93
94Lisp_Object Vsearch_spaces_regexp; 94Lisp_Object Vsearch_spaces_regexp;
95 95
96/* If non-nil, the match data will not be changed during call to
97 searching or matching functions. This variable is for internal use
98 only. */
99Lisp_Object Vinhibit_changing_match_data;
100
96static void set_search_regs (); 101static void set_search_regs ();
97static void save_search_regs (); 102static void save_search_regs ();
98static int simple_search (); 103static int simple_search ();
@@ -289,7 +294,9 @@ looking_at_1 (string, posix)
289 = current_buffer->case_eqv_table; 294 = current_buffer->case_eqv_table;
290 295
291 CHECK_STRING (string); 296 CHECK_STRING (string);
292 bufp = compile_pattern (string, &search_regs, 297 bufp = compile_pattern (string,
298 (NILP (Vinhibit_changing_match_data)
299 ? &search_regs : NULL),
293 (!NILP (current_buffer->case_fold_search) 300 (!NILP (current_buffer->case_fold_search)
294 ? current_buffer->case_canon_table : Qnil), 301 ? current_buffer->case_canon_table : Qnil),
295 posix, 302 posix,
@@ -320,7 +327,9 @@ looking_at_1 (string, posix)
320 re_match_object = Qnil; 327 re_match_object = Qnil;
321 328
322 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, 329 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
323 PT_BYTE - BEGV_BYTE, &search_regs, 330 PT_BYTE - BEGV_BYTE,
331 (NILP (Vinhibit_changing_match_data)
332 ? &search_regs : NULL),
324 ZV_BYTE - BEGV_BYTE); 333 ZV_BYTE - BEGV_BYTE);
325 immediate_quit = 0; 334 immediate_quit = 0;
326 335
@@ -328,7 +337,7 @@ looking_at_1 (string, posix)
328 matcher_overflow (); 337 matcher_overflow ();
329 338
330 val = (0 <= i ? Qt : Qnil); 339 val = (0 <= i ? Qt : Qnil);
331 if (i >= 0) 340 if (NILP (Vinhibit_changing_match_data) && i >= 0)
332 for (i = 0; i < search_regs.num_regs; i++) 341 for (i = 0; i < search_regs.num_regs; i++)
333 if (search_regs.start[i] >= 0) 342 if (search_regs.start[i] >= 0)
334 { 343 {
@@ -337,7 +346,11 @@ looking_at_1 (string, posix)
337 search_regs.end[i] 346 search_regs.end[i]
338 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); 347 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
339 } 348 }
340 XSETBUFFER (last_thing_searched, current_buffer); 349
350 /* Set last_thing_searched only when match data is changed. */
351 if (NILP (Vinhibit_changing_match_data))
352 XSETBUFFER (last_thing_searched, current_buffer);
353
341 return val; 354 return val;
342} 355}
343 356
@@ -399,7 +412,9 @@ string_match_1 (regexp, string, start, posix)
399 XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] 412 XCHAR_TABLE (current_buffer->case_canon_table)->extras[2]
400 = current_buffer->case_eqv_table; 413 = current_buffer->case_eqv_table;
401 414
402 bufp = compile_pattern (regexp, &search_regs, 415 bufp = compile_pattern (regexp,
416 (NILP (Vinhibit_changing_match_data)
417 ? &search_regs : NULL),
403 (!NILP (current_buffer->case_fold_search) 418 (!NILP (current_buffer->case_fold_search)
404 ? current_buffer->case_canon_table : Qnil), 419 ? current_buffer->case_canon_table : Qnil),
405 posix, 420 posix,
@@ -410,21 +425,27 @@ string_match_1 (regexp, string, start, posix)
410 val = re_search (bufp, (char *) SDATA (string), 425 val = re_search (bufp, (char *) SDATA (string),
411 SBYTES (string), pos_byte, 426 SBYTES (string), pos_byte,
412 SBYTES (string) - pos_byte, 427 SBYTES (string) - pos_byte,
413 &search_regs); 428 (NILP (Vinhibit_changing_match_data)
429 ? &search_regs : NULL));
414 immediate_quit = 0; 430 immediate_quit = 0;
415 last_thing_searched = Qt; 431
432 /* Set last_thing_searched only when match data is changed. */
433 if (NILP (Vinhibit_changing_match_data))
434 last_thing_searched = Qt;
435
416 if (val == -2) 436 if (val == -2)
417 matcher_overflow (); 437 matcher_overflow ();
418 if (val < 0) return Qnil; 438 if (val < 0) return Qnil;
419 439
420 for (i = 0; i < search_regs.num_regs; i++) 440 if (NILP (Vinhibit_changing_match_data))
421 if (search_regs.start[i] >= 0) 441 for (i = 0; i < search_regs.num_regs; i++)
422 { 442 if (search_regs.start[i] >= 0)
423 search_regs.start[i] 443 {
424 = string_byte_to_char (string, search_regs.start[i]); 444 search_regs.start[i]
425 search_regs.end[i] 445 = string_byte_to_char (string, search_regs.start[i]);
426 = string_byte_to_char (string, search_regs.end[i]); 446 search_regs.end[i]
427 } 447 = string_byte_to_char (string, search_regs.end[i]);
448 }
428 449
429 return make_number (string_byte_to_char (string, val)); 450 return make_number (string_byte_to_char (string, val));
430} 451}
@@ -1042,6 +1063,11 @@ do \
1042 } \ 1063 } \
1043while (0) 1064while (0)
1044 1065
1066/* Only used in search_buffer, to record the end position of the match
1067 when searching regexps and SEARCH_REGS should not be changed
1068 (i.e. Vinhibit_changing_match_data is non-nil). */
1069static struct re_registers search_regs_1;
1070
1045static int 1071static int
1046search_buffer (string, pos, pos_byte, lim, lim_byte, n, 1072search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1047 RE, trt, inverse_trt, posix) 1073 RE, trt, inverse_trt, posix)
@@ -1077,7 +1103,10 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1077 int s1, s2; 1103 int s1, s2;
1078 struct re_pattern_buffer *bufp; 1104 struct re_pattern_buffer *bufp;
1079 1105
1080 bufp = compile_pattern (string, &search_regs, trt, posix, 1106 bufp = compile_pattern (string,
1107 (NILP (Vinhibit_changing_match_data)
1108 ? &search_regs : &search_regs_1),
1109 trt, posix,
1081 !NILP (current_buffer->enable_multibyte_characters)); 1110 !NILP (current_buffer->enable_multibyte_characters));
1082 1111
1083 immediate_quit = 1; /* Quit immediately if user types ^G, 1112 immediate_quit = 1; /* Quit immediately if user types ^G,
@@ -1110,7 +1139,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1110 int val; 1139 int val;
1111 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, 1140 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1112 pos_byte - BEGV_BYTE, lim_byte - pos_byte, 1141 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1113 &search_regs, 1142 (NILP (Vinhibit_changing_match_data)
1143 ? &search_regs : &search_regs_1),
1114 /* Don't allow match past current point */ 1144 /* Don't allow match past current point */
1115 pos_byte - BEGV_BYTE); 1145 pos_byte - BEGV_BYTE);
1116 if (val == -2) 1146 if (val == -2)
@@ -1119,18 +1149,27 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1119 } 1149 }
1120 if (val >= 0) 1150 if (val >= 0)
1121 { 1151 {
1122 pos_byte = search_regs.start[0] + BEGV_BYTE; 1152 if (NILP (Vinhibit_changing_match_data))
1123 for (i = 0; i < search_regs.num_regs; i++) 1153 {
1124 if (search_regs.start[i] >= 0) 1154 pos_byte = search_regs.start[0] + BEGV_BYTE;
1125 { 1155 for (i = 0; i < search_regs.num_regs; i++)
1126 search_regs.start[i] 1156 if (search_regs.start[i] >= 0)
1127 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); 1157 {
1128 search_regs.end[i] 1158 search_regs.start[i]
1129 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); 1159 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1130 } 1160 search_regs.end[i]
1131 XSETBUFFER (last_thing_searched, current_buffer); 1161 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1132 /* Set pos to the new position. */ 1162 }
1133 pos = search_regs.start[0]; 1163 XSETBUFFER (last_thing_searched, current_buffer);
1164 /* Set pos to the new position. */
1165 pos = search_regs.start[0];
1166 }
1167 else
1168 {
1169 pos_byte = search_regs_1.start[0] + BEGV_BYTE;
1170 /* Set pos to the new position. */
1171 pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE);
1172 }
1134 } 1173 }
1135 else 1174 else
1136 { 1175 {
@@ -1144,7 +1183,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1144 int val; 1183 int val;
1145 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, 1184 val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
1146 pos_byte - BEGV_BYTE, lim_byte - pos_byte, 1185 pos_byte - BEGV_BYTE, lim_byte - pos_byte,
1147 &search_regs, 1186 (NILP (Vinhibit_changing_match_data)
1187 ? &search_regs : &search_regs_1),
1148 lim_byte - BEGV_BYTE); 1188 lim_byte - BEGV_BYTE);
1149 if (val == -2) 1189 if (val == -2)
1150 { 1190 {
@@ -1152,17 +1192,25 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n,
1152 } 1192 }
1153 if (val >= 0) 1193 if (val >= 0)
1154 { 1194 {
1155 pos_byte = search_regs.end[0] + BEGV_BYTE; 1195 if (NILP (Vinhibit_changing_match_data))
1156 for (i = 0; i < search_regs.num_regs; i++) 1196 {
1157 if (search_regs.start[i] >= 0) 1197 pos_byte = search_regs.end[0] + BEGV_BYTE;
1158 { 1198 for (i = 0; i < search_regs.num_regs; i++)
1159 search_regs.start[i] 1199 if (search_regs.start[i] >= 0)
1160 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); 1200 {
1161 search_regs.end[i] 1201 search_regs.start[i]
1162 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); 1202 = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE);
1163 } 1203 search_regs.end[i]
1164 XSETBUFFER (last_thing_searched, current_buffer); 1204 = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE);
1165 pos = search_regs.end[0]; 1205 }
1206 XSETBUFFER (last_thing_searched, current_buffer);
1207 pos = search_regs.end[0];
1208 }
1209 else
1210 {
1211 pos_byte = search_regs_1.end[0] + BEGV_BYTE;
1212 pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE);
1213 }
1166 } 1214 }
1167 else 1215 else
1168 { 1216 {
@@ -1907,7 +1955,7 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1907 cursor += dirlen - i - direction; /* fix cursor */ 1955 cursor += dirlen - i - direction; /* fix cursor */
1908 if (i + direction == 0) 1956 if (i + direction == 0)
1909 { 1957 {
1910 int position; 1958 int position, start, end;
1911 1959
1912 cursor -= direction; 1960 cursor -= direction;
1913 1961
@@ -1915,11 +1963,24 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1915 ? 1 - len_byte : 0); 1963 ? 1 - len_byte : 0);
1916 set_search_regs (position, len_byte); 1964 set_search_regs (position, len_byte);
1917 1965
1966 if (NILP (Vinhibit_changing_match_data))
1967 {
1968 start = search_regs.start[0];
1969 end = search_regs.end[0];
1970 }
1971 else
1972 /* If Vinhibit_changing_match_data is non-nil,
1973 search_regs will not be changed. So let's
1974 compute start and end here. */
1975 {
1976 start = BYTE_TO_CHAR (position);
1977 end = BYTE_TO_CHAR (position + len_byte);
1978 }
1979
1918 if ((n -= direction) != 0) 1980 if ((n -= direction) != 0)
1919 cursor += dirlen; /* to resume search */ 1981 cursor += dirlen; /* to resume search */
1920 else 1982 else
1921 return ((direction > 0) 1983 return direction > 0 ? end : start;
1922 ? search_regs.end[0] : search_regs.start[0]);
1923 } 1984 }
1924 else 1985 else
1925 cursor += stride_for_teases; /* <sigh> we lose - */ 1986 cursor += stride_for_teases; /* <sigh> we lose - */
@@ -1984,18 +2045,30 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
1984 pos_byte += dirlen - i- direction; 2045 pos_byte += dirlen - i- direction;
1985 if (i + direction == 0) 2046 if (i + direction == 0)
1986 { 2047 {
1987 int position; 2048 int position, start, end;
1988 pos_byte -= direction; 2049 pos_byte -= direction;
1989 2050
1990 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0); 2051 position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
1991
1992 set_search_regs (position, len_byte); 2052 set_search_regs (position, len_byte);
1993 2053
2054 if (NILP (Vinhibit_changing_match_data))
2055 {
2056 start = search_regs.start[0];
2057 end = search_regs.end[0];
2058 }
2059 else
2060 /* If Vinhibit_changing_match_data is non-nil,
2061 search_regs will not be changed. So let's
2062 compute start and end here. */
2063 {
2064 start = BYTE_TO_CHAR (position);
2065 end = BYTE_TO_CHAR (position + len_byte);
2066 }
2067
1994 if ((n -= direction) != 0) 2068 if ((n -= direction) != 0)
1995 pos_byte += dirlen; /* to resume search */ 2069 pos_byte += dirlen; /* to resume search */
1996 else 2070 else
1997 return ((direction > 0) 2071 return direction > 0 ? end : start;
1998 ? search_regs.end[0] : search_regs.start[0]);
1999 } 2072 }
2000 else 2073 else
2001 pos_byte += stride_for_teases; 2074 pos_byte += stride_for_teases;
@@ -2018,6 +2091,9 @@ set_search_regs (beg_byte, nbytes)
2018{ 2091{
2019 int i; 2092 int i;
2020 2093
2094 if (!NILP (Vinhibit_changing_match_data))
2095 return;
2096
2021 /* Make sure we have registers in which to store 2097 /* Make sure we have registers in which to store
2022 the match position. */ 2098 the match position. */
2023 if (search_regs.num_regs == 0) 2099 if (search_regs.num_regs == 0)
@@ -3145,6 +3221,13 @@ or other such regexp constructs are not replaced with this.
3145A value of nil (which is the normal value) means treat spaces literally. */); 3221A value of nil (which is the normal value) means treat spaces literally. */);
3146 Vsearch_spaces_regexp = Qnil; 3222 Vsearch_spaces_regexp = Qnil;
3147 3223
3224 DEFVAR_LISP ("inhibit-changing-match-data", &Vinhibit_changing_match_data,
3225 doc: /* Internal use only.
3226If non-nil, the match data will not be changed during call to searching or
3227matching functions, such as `looking-at', `string-match', `re-search-forward'
3228etc. */);
3229 Vinhibit_changing_match_data = Qnil;
3230
3148 defsubr (&Slooking_at); 3231 defsubr (&Slooking_at);
3149 defsubr (&Sposix_looking_at); 3232 defsubr (&Sposix_looking_at);
3150 defsubr (&Sstring_match); 3233 defsubr (&Sstring_match);
diff --git a/src/term.c b/src/term.c
index 0210a66afa9..331d9f20e4c 100644
--- a/src/term.c
+++ b/src/term.c
@@ -25,6 +25,9 @@ Boston, MA 02110-1301, USA. */
25#include <stdio.h> 25#include <stdio.h>
26#include <ctype.h> 26#include <ctype.h>
27#include <string.h> 27#include <string.h>
28#ifdef HAVE_UNISTD_H
29#include <unistd.h>
30#endif
28 31
29#include "termchar.h" 32#include "termchar.h"
30#include "termopts.h" 33#include "termopts.h"
@@ -2493,9 +2496,9 @@ set_tty_color_mode (f, val)
2493void 2496void
2494term_mouse_moveto (int x, int y) 2497term_mouse_moveto (int x, int y)
2495{ 2498{
2499 /* TODO: how to set mouse position?
2496 const char *name; 2500 const char *name;
2497 int fd; 2501 int fd;
2498 /* TODO: how to set mouse position?
2499 name = (const char *) ttyname (0); 2502 name = (const char *) ttyname (0);
2500 fd = open (name, O_WRONLY); 2503 fd = open (name, O_WRONLY);
2501 SOME_FUNCTION (x, y, fd); 2504 SOME_FUNCTION (x, y, fd);
@@ -2509,7 +2512,7 @@ term_show_mouse_face (enum draw_glyphs_face draw)
2509{ 2512{
2510 struct window *w = XWINDOW (Qmouse_face_window); 2513 struct window *w = XWINDOW (Qmouse_face_window);
2511 int save_x, save_y; 2514 int save_x, save_y;
2512 int i, j; 2515 int i;
2513 2516
2514 if (/* If window is in the process of being destroyed, don't bother 2517 if (/* If window is in the process of being destroyed, don't bother
2515 to do anything. */ 2518 to do anything. */
@@ -3029,7 +3032,7 @@ int
3029handle_one_term_event (Gpm_Event *event, struct input_event* hold_quit) 3032handle_one_term_event (Gpm_Event *event, struct input_event* hold_quit)
3030{ 3033{
3031 struct frame *f = SELECTED_FRAME (); 3034 struct frame *f = SELECTED_FRAME ();
3032 int i, j, fd; 3035 int fd;
3033 struct input_event ie; 3036 struct input_event ie;
3034 int do_help = 0; 3037 int do_help = 0;
3035 int count = 0; 3038 int count = 0;
@@ -3053,7 +3056,7 @@ handle_one_term_event (Gpm_Event *event, struct input_event* hold_quit)
3053 arg[1] = arg[3] = (unsigned short) event->y + gpm_zerobased; 3056 arg[1] = arg[3] = (unsigned short) event->y + gpm_zerobased;
3054 arg[4] = (unsigned short) 3; 3057 arg[4] = (unsigned short) 3;
3055 3058
3056 name = (const char *) ttyname (0); 3059 name = ttyname (0);
3057 fd = open (name, O_WRONLY); 3060 fd = open (name, O_WRONLY);
3058 ioctl (fd, TIOCLINUX, buf + sizeof (short) - 1); 3061 ioctl (fd, TIOCLINUX, buf + sizeof (short) - 1);
3059 close (fd); 3062 close (fd);
diff --git a/src/w32fns.c b/src/w32fns.c
index fbdb11ca922..e0c763aef99 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -53,6 +53,7 @@ Boston, MA 02110-1301, USA. */
53#include <shellapi.h> 53#include <shellapi.h>
54#include <ctype.h> 54#include <ctype.h>
55#include <winspool.h> 55#include <winspool.h>
56#include <objbase.h>
56 57
57#include <dlgs.h> 58#include <dlgs.h>
58#define FILE_NAME_TEXT_FIELD edt1 59#define FILE_NAME_TEXT_FIELD edt1
@@ -2518,6 +2519,13 @@ w32_msg_pump (deferred_msg * msg_buf)
2518 /* Produced by complete_deferred_msg; just ignore. */ 2519 /* Produced by complete_deferred_msg; just ignore. */
2519 break; 2520 break;
2520 case WM_EMACS_CREATEWINDOW: 2521 case WM_EMACS_CREATEWINDOW:
2522 /* Initialize COM for this window. Even though we don't use it,
2523 some third party shell extensions can cause it to be used in
2524 system dialogs, which causes a crash if it is not initialized.
2525 This is a known bug in Windows, which was fixed long ago, but
2526 the patch for XP is not publically available until XP SP3,
2527 and older versions will never be patched. */
2528 CoInitialize (NULL);
2521 w32_createwindow ((struct frame *) msg.wParam); 2529 w32_createwindow ((struct frame *) msg.wParam);
2522 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) 2530 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2523 abort (); 2531 abort ();
@@ -3664,6 +3672,10 @@ w32_wnd_proc (hwnd, msg, wParam, lParam)
3664 my_post_msg (&wmsg, hwnd, msg, wParam, lParam); 3672 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3665 goto dflt; 3673 goto dflt;
3666 3674
3675 case WM_DESTROY:
3676 CoUninitialize ();
3677 return 0;
3678
3667 case WM_CLOSE: 3679 case WM_CLOSE:
3668 wmsg.dwModifiers = w32_get_modifiers (); 3680 wmsg.dwModifiers = w32_get_modifiers ();
3669 my_post_msg (&wmsg, hwnd, msg, wParam, lParam); 3681 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
diff --git a/src/window.c b/src/window.c
index 61be973e180..42a33828d8d 100644
--- a/src/window.c
+++ b/src/window.c
@@ -6643,7 +6643,7 @@ and the value of point and mark for each window.
6643Also restore the choice of selected window. 6643Also restore the choice of selected window.
6644Also restore which buffer is current. 6644Also restore which buffer is current.
6645Does not restore the value of point in current buffer. 6645Does not restore the value of point in current buffer.
6646usage: (save-window-excursion BODY ...) */) 6646usage: (save-window-excursion BODY...) */)
6647 (args) 6647 (args)
6648 Lisp_Object args; 6648 Lisp_Object args;
6649{ 6649{