aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2004-03-01 14:27:16 +0000
committerKaroly Lorentey2004-03-01 14:27:16 +0000
commit29cd19501134dfde15743f8c5fbdc8b012ed693e (patch)
treeeab1530a8589ab50de84bcd188b1f8d8dda518db /lisp
parent057a9ab495a5fd334f9bd3c7704176502e5219c4 (diff)
parent3f383e4ad7884aad8767d3a6c26c6f3bab5f8f93 (diff)
downloademacs-29cd19501134dfde15743f8c5fbdc8b012ed693e.tar.gz
emacs-29cd19501134dfde15743f8c5fbdc8b012ed693e.zip
Merged in changes from CVS HEAD
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-121 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-122 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-123 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-124 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-125 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-108
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog184
-rw-r--r--lisp/ffap.el61
-rw-r--r--lisp/net/tramp-ftp.el17
-rw-r--r--lisp/net/tramp-smb.el137
-rw-r--r--lisp/net/tramp.el766
-rw-r--r--lisp/net/trampver.el2
-rw-r--r--lisp/progmodes/ebnf-abn.el4
-rw-r--r--lisp/progmodes/ebnf-bnf.el38
-rw-r--r--lisp/progmodes/ebnf2ps.el58
-rw-r--r--lisp/thumbs.el737
10 files changed, 1618 insertions, 386 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 328cc3e8986..b945703cb57 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,131 @@
12004-02-29 Kai Grossjohann <kai.grossjohann@gmx.net>
2
3 Version 2.0.39 of Tramp released.
4
5 * net/tramp.el (tramp-handle-file-local-copy)
6 (tramp-handle-write-region, tramp-open-connection-rsh): Variable
7 name typo. Small change. From Patrick Tullmann
8 <tullmann@flux.utah.edu>.
9 (tramp-process-connection-type): New variable.
10 (tramp-maybe-open-connection): Use it.
11 (tramp-do-copy-or-rename-via-buffer): Handle KEEP-DATE arg, if
12 possible.
13 (tramp-touch): Set last-modified time of a remote file.
14 (tramp-handle-write-region): Say which function is used when
15 encoding.
16
172004-02-29 Michael Albinus <Michael.Albinus@alcatel.de>
18
19 * net/tramp-smb.el (tramp-smb-handle-file-writable-p): Handle the
20 case of non-existing filename, too. Reported by Christoph Bauer
21 <c_bauer@informatik.uni-kl.de>.
22 (tramp-smb-get-file-entries): The directory in question should
23 have permissions "drwxrwxrwx". Just virtual, because we don't
24 know the real permissions. Don't we know?
25 (tramp-smb-prompt): Add virtual prompt from listing shares, too.
26 (tramp-smb-errors): Add "NT_STATUS_ACCOUNT_LOCKED_OUT".
27 (tramp-smb-wait-for-output): Optimize algorithm getting pending
28 output. If it was received chunkwise, there have been problems.
29 Remove the "prompt not found" error message; it is obvious.
30 Simplify algorithm.
31 (tramp-smb-process-running): Removed. Since we acknowledge the
32 virtual prompt for shares, there's no need for distinction of
33 reading shares (process ends afterwards) and interactive mode of
34 smblient.
35 (tramp-smb-open-connection): Setting process sentinel removed.
36 (tramp-smb-errors): Add "NT_STATUS_WRONG_PASSWORD" and
37 "NT_STATUS_NETWORK_ACCESS_DENIED".
38 (tramp-smb-maybe-open-connection): Set `process-connection-type'
39 to 'pty. Suggested by Piet van Oostrum <piet@cs.uu.nl>.
40 (top-level): Setting default value in `tramp-default-method-alist'
41 corrected. Order of USER and HOST have been wrong. Nobody
42 claimed for months ...
43 (tramp-smb-maybe-open-connection): Use
44 `tramp-process-connection-type'.
45 (tramp-smb-open-connection): Clear password cache if login has
46 failed.
47
48 * net/tramp.el (tramp-completion-mode) Don't check for 'xemacs but
49 `tramp-unified-filenames'.
50 (tramp-completion-mode): Make test for XEmacs explicitely.
51 `event-to-character' can exists in Emacs packages too. Reported
52 by Matt Swift <swift@alum.mit.edu>.
53 (tramp-buffer-name): Buffer name must contain the user if exists.
54 Reported by Adrian Phillips <a.phillips@met.no>.
55 (tramp-do-copy-or-rename-file): Handle out-of-band methods. Call
56 `tramp-do-copy-or-rename-file-out-of-band' this case.
57 (tramp-do-copy-or-rename-file-out-of-band): Renamed from
58 `tramp-do-copy-or-rename-file-one-local', because it handles also
59 the case both files use the same out-of-band method.
60 Implementation added.
61 (tramp-handle-file-local-copy, tramp-handle-write-region):
62 Out-of-band handling removed. `copy-file' called instead, which
63 calls `tramp-do-copy-or-rename-file-out-of-band'.
64 (tramp-action-password): Check for out-of-band method removed.
65 This function is used for 'login-program.
66 (tramp-post-connection): Use `tramp-method-out-of-band-p' when
67 appropriate.
68 (tramp-completion-function-alist-ssh): Add `tramp-parse-shostkeys'
69 and `tramp-parse-sknownhosts'.
70 (tramp-completion-function-alist): It's a defvar now, because we
71 want to apply the optimized `tramp-set-completion-function'
72 instead of a static list.
73 (tramp-set-completion-function): Implementation tuned. Avoid
74 double entries, and entries where the function or the
75 file/directory doesn't exist.
76 (tramp-parse-shostkeys, tramp-parse-sknownhosts): New functions
77 for SSH2.
78 (tramp-file-name-handler-alist): Add `dired-compress-file' entry.
79 (tramp-handle-dired-compress-file): New function.
80 (tramp-async-proc): New variable.
81 (tramp-handle-shell-command): Adding asynchronous processes. They
82 are far from being perfect, but it works at least for
83 `find-grep-dired' and `find-name-dired' in Emacs 21.4.
84 (top-level): Require password.el if visible. Should be mandatory
85 once No Gnus has found its way into (X)Emacs.
86 (tramp-read-passwd): Invoke `password-read' if available,
87 `read-passwd' otherwise. `ange-ftp-read-passwd' isn't used as
88 fallback any longer.
89 (tramp-clear-passwd): New function.
90 (tramp-process-actions, tramp-process-multi-actions): Clear
91 password cache if login has failed.
92
93 * net/tramp-ftp.el (Commentary): Remove pointer to EFS. It has
94 its own module.
95 (tramp-ftp-file-name-handler): Unset `ange-ftp-ftp-name-arg' and
96 `ange-ftp-ftp-name-res'. There could be incorrect values from
97 previous calls in case the "ftp" method is used in the Tramp file
98 name. Reported by Katsumi Yamaoka <yamaoka@jpl.org>.
99
1002004-02-28 Richard M. Stallman <rms@gnu.org>
101
102 * term.el (term-mouse-paste): Call mouse-set-point.
103
104 * thumbs.el: New file.
105
1062004-02-28 Vinicius Jose Latorre <viniciusjl@ig.com.br>
107
108 * ebnf-abn.el: Doc fix.
109
110 * ebnf-bnf.el: Doc fix.
111 (ebnf-repeat): Code fix.
112
113 * ebnf2ps.el: Doc fix.
114 (ebnf-syntax-directory, ebnf-syntax-file): New funs.
115
1162004-02-28 Juri Linkov <juri@jurta.org>
117
118 * ffap.el (dired-at-point): Additional writability test for
119 relative directory names.
120 (dired-at-point-prompter): Treat directories as a directory, get
121 the directory component from files.
122 (ffap-string-at-point): Return string from region if region is
123 active.
124 (ffap-file-at-point): Remove redundant code.
125
12004-02-28 Kim F. Storm <storm@cua.dk> 1262004-02-28 Kim F. Storm <storm@cua.dk>
2 127
3 * gdb-ui.el (breakpoint-enabled-icon, breakpoint-disabled-icon): 128 * gdb-ui.el (breakpoint-enabled-icon, breakpoint-disabled-icon):
4 Initialize margin area images to nil. 129 Initialize margin area images to nil.
5 (breakpoint-bitmap): New defvar for breakpoint fringe bitmaps. 130 (breakpoint-bitmap): New defvar for breakpoint fringe bitmaps.
6 (breakpoint-enabled-bitmap-face) 131 (breakpoint-enabled-bitmap-face)
@@ -37,19 +162,19 @@
37 162
382004-02-27 Dan Nicolaescu <dann@ics.uci.edu> 1632004-02-27 Dan Nicolaescu <dann@ics.uci.edu>
39 164
40 * faces.el (face-spec-set-match-display): Add a new attribute, 165 * faces.el (face-spec-set-match-display): Add a new attribute,
41 `min-colors'. 166 `min-colors'.
42 (region, highlight, secondary-selection): Use `min-colors`. 167 (region, highlight, secondary-selection): Use `min-colors'.
43 168
44 * custom.el (defface): Add documentation for `min-colors'. 169 * custom.el (defface): Add documentation for `min-colors'.
45 170
46 * font-lock.el (font-lock-comment-face, font-lock-string-face) 171 * font-lock.el (font-lock-comment-face, font-lock-string-face)
47 (font-lock-keyword-face, font-lock-function-name-face) 172 (font-lock-keyword-face, font-lock-function-name-face)
48 (font-lock-variable-name-face, font-lock-constant-face): Use 173 (font-lock-variable-name-face, font-lock-constant-face): Use
49 `min-colors`. 174 `min-colors'.
50 175
51 * isearch.el (isearch, isearch-lazy-highlight-face): Use 176 * isearch.el (isearch, isearch-lazy-highlight-face): Use
52 `min-colors'. 177 `min-colors'.
53 178
542004-02-25 Vinicius Jose Latorre <viniciusjl@ig.com.br> 1792004-02-25 Vinicius Jose Latorre <viniciusjl@ig.com.br>
55 180
@@ -198,7 +323,7 @@
1982004-02-19 Glenn Morris <gmorris@ast.cam.ac.uk> 3232004-02-19 Glenn Morris <gmorris@ast.cam.ac.uk>
199 324
200 * calendar/appt.el (appt-display-format): Change default to 325 * calendar/appt.el (appt-display-format): Change default to
201 'ignore, for backwards compatability. 326 'ignore, for backwards compatibility.
202 (appt-display-message): If appt-display-format is 'ignore, 327 (appt-display-message): If appt-display-format is 'ignore,
203 respect old vars appt-msg-window and appt-visible. 328 respect old vars appt-msg-window and appt-visible.
204 (appt-activate): Don't depend on return value of cancel-timer. 329 (appt-activate): Don't depend on return value of cancel-timer.
@@ -304,7 +429,7 @@
304 * loadhist.el (unload-feature): Doc fix. Rename flist to 429 * loadhist.el (unload-feature): Doc fix. Rename flist to
305 unload-hook-features-list. 430 unload-hook-features-list.
306 431
3072004-02-16 Jay Belanger <belanger@truman.edu> (tiny change). 4322004-02-16 Jay Belanger <belanger@truman.edu> (tiny change)
308 433
309 * calc/calc-embed.el (calc-do-embedded-activate): Add autoload 434 * calc/calc-embed.el (calc-do-embedded-activate): Add autoload
310 cookie. Don't check if we are looking-at open-formula. 435 cookie. Don't check if we are looking-at open-formula.
@@ -1091,7 +1216,7 @@
1091 1216
10922004-01-05 Karl Berry <karl@gnu.org> 12172004-01-05 Karl Berry <karl@gnu.org>
1093 1218
1094 * emacs-lisp/copyright.el (copyright-regexp): might as well allow 1219 * emacs-lisp/copyright.el (copyright-regexp): Might as well allow
1095 / and *, too. 1220 / and *, too.
1096 1221
10972003-12-31 Simon Josefsson <jas@extundo.com> 12222003-12-31 Simon Josefsson <jas@extundo.com>
@@ -1111,7 +1236,7 @@
1111 1236
11122004-01-04 Karl Berry <karl@gnu.org> 12372004-01-04 Karl Berry <karl@gnu.org>
1113 1238
1114 * emacs-lisp/copyright.el (copyright-regexp): allow the common 1239 * emacs-lisp/copyright.el (copyright-regexp): Allow the common
1115 comment characters % and # in the copyright year notice, 1240 comment characters % and # in the copyright year notice,
1116 as well as ;. 1241 as well as ;.
1117 1242
@@ -1165,7 +1290,7 @@
1165 1290
1166 * ido.el (ido-nonreadable-directory-p): New defun to check for 1291 * ido.el (ido-nonreadable-directory-p): New defun to check for
1167 nonreadable directory without activating tramp (to avoid problems 1292 nonreadable directory without activating tramp (to avoid problems
1168 with checking incomplete tramp paths. 1293 with checking incomplete tramp paths).
1169 (ido-set-current-directory, ido-file-internal) 1294 (ido-set-current-directory, ido-file-internal)
1170 (ido-file-name-all-completions1): Use it. 1295 (ido-file-name-all-completions1): Use it.
1171 1296
@@ -1290,7 +1415,7 @@
1290 1415
1291 * files.el (kill-some-buffers): Doc fix. 1416 * files.el (kill-some-buffers): Doc fix.
1292 1417
12932003-12-29 David Herring <sdh6@ra.msstate.edu> (tiny change) 14182003-12-29 David Herring <sdh6@ra.msstate.edu> (tiny change)
1294 1419
1295 * comint.el (comint-watch-for-password-prompt): Pass `string' as 1420 * comint.el (comint-watch-for-password-prompt): Pass `string' as
1296 arg to send-invisible 1421 arg to send-invisible
@@ -1308,16 +1433,16 @@
1308 1433
1309 * xml.el (xml-get-attribute-or-nil): Doc fix. 1434 * xml.el (xml-get-attribute-or-nil): Doc fix.
1310 1435
13112003-12-29 Peter 'Luna' Runestig <peter@runestig.com> 14362003-12-29 Peter 'Luna' Runestig <peter@runestig.com>
1312 1437
1313 * net/zone-mode.el (zone-mode): Use write-file-functions, not 1438 * net/zone-mode.el (zone-mode): Use write-file-functions, not
1314 write-file-hooks. 1439 write-file-hooks.
1315 1440
13162003-12-29 Eric Hanchrow <offby1@blarg.net> (tiny change) 14412003-12-29 Eric Hanchrow <offby1@blarg.net> (tiny change)
1317 1442
1318 * autorevert.el (auto-revert-interval): Doc fix. 1443 * autorevert.el (auto-revert-interval): Doc fix.
1319 1444
13202003-12-29 Mark A. Hershberger <mah@everybody.org> 14452003-12-29 Mark A. Hershberger <mah@everybody.org>
1321 1446
1322 * xml.el (xml-get-attribute-or-nil): New function, like 1447 * xml.el (xml-get-attribute-or-nil): New function, like
1323 xml-get-attribute, but returns nil if the attribute was not found. 1448 xml-get-attribute, but returns nil if the attribute was not found.
@@ -1328,12 +1453,12 @@
1328 1453
1329 * emacs-lisp/easymenu.el (easy-menu-define): Doc fix. 1454 * emacs-lisp/easymenu.el (easy-menu-define): Doc fix.
1330 1455
13312003-12-29 Alex Schroeder <alex@emacswiki.org> (tiny change) 14562003-12-29 Alex Schroeder <alex@emacswiki.org> (tiny change)
1332 1457
1333 * custom.el (custom-declare-theme): Use `value' when putting 1458 * custom.el (custom-declare-theme): Use `value' when putting
1334 properties on `theme'. 1459 properties on `theme'.
1335 1460
13362003-12-29 Takaaki Ota <Takaaki.Ota@am.sony.com> 14612003-12-29 Takaaki Ota <Takaaki.Ota@am.sony.com>
1337 1462
1338 * subr.el (insert-for-yank): Call insert-for-yank-1 repetitively 1463 * subr.el (insert-for-yank): Call insert-for-yank-1 repetitively
1339 for each yank-handler segment. 1464 for each yank-handler segment.
@@ -1344,7 +1469,7 @@
1344 (table--put-cell-indicator-property): Put yank-handler property 1469 (table--put-cell-indicator-property): Put yank-handler property
1345 that indicates the yank handler for the table cell. 1470 that indicates the yank handler for the table cell.
1346 1471
13472003-12-29 Jesper Harder <harder@ifa.au.dk> (tiny change) 14722003-12-29 Jesper Harder <harder@ifa.au.dk> (tiny change)
1348 1473
1349 * generic-x.el (etc-modules-conf-generic-mode): A more complete 1474 * generic-x.el (etc-modules-conf-generic-mode): A more complete
1350 set of keywords. 1475 set of keywords.
@@ -1417,7 +1542,7 @@
1417 1542
1418 * ffap.el (ffap-read-file-or-url): Revert previous change. 1543 * ffap.el (ffap-read-file-or-url): Revert previous change.
1419 1544
14202003-12-25 Robert J. Chassell <bob@rattlesnake.com> 15452003-12-25 Robert J. Chassell <bob@rattlesnake.com>
1421 1546
1422 * textmodes/texnfo-upd.el (texinfo-multi-file-update): Create a 1547 * textmodes/texnfo-upd.el (texinfo-multi-file-update): Create a
1423 new list of included files called `files-with-node-lines', that 1548 new list of included files called `files-with-node-lines', that
@@ -1497,7 +1622,7 @@
1497 * info.el (Info-unescape-quotes, Info-split-parameter-string) 1622 * info.el (Info-unescape-quotes, Info-split-parameter-string)
1498 (Info-goto-emacs-command-node): Doc fixes. 1623 (Info-goto-emacs-command-node): Doc fixes.
1499 1624
15002003-12-12 Jesper Harder <harder@ifa.au.dk> 16252003-12-12 Jesper Harder <harder@ifa.au.dk>
1501 1626
1502 * cus-edit.el (custom-add-parent-links): Define "many". 1627 * cus-edit.el (custom-add-parent-links): Define "many".
1503 1628
@@ -1588,7 +1713,6 @@
1588 value "'integer". Otherwise, don't use that parameter (default is 1713 value "'integer". Otherwise, don't use that parameter (default is
1589 integer format). 1714 integer format).
1590 1715
1591
15922003-11-30 Luc Teirlinck <teirllm@auburn.edu> 17162003-11-30 Luc Teirlinck <teirllm@auburn.edu>
1593 1717
1594 * help.el (help-map): Bind `display-local-help' to `C-h .'. 1718 * help.el (help-map): Bind `display-local-help' to `C-h .'.
@@ -1882,7 +2006,7 @@
1882 2006
1883 * descr-text.el (describe-char): Fix typo. 2007 * descr-text.el (describe-char): Fix typo.
1884 2008
18852003-11-08 Kailash C. Chowksey <klchxbec@m-net.arbornet.org> 20092003-11-08 Kailash C. Chowksey <klchxbec@m-net.arbornet.org>
1886 2010
1887 These changes are to support Kannada language/script. 2011 These changes are to support Kannada language/script.
1888 2012
@@ -1939,7 +2063,7 @@
1939 (xml-ns-parse-ns-attrs, xml-ns-expand-el) 2063 (xml-ns-parse-ns-attrs, xml-ns-expand-el)
1940 (xml-ns-expand-attr): New functions to do namespace handling. 2064 (xml-ns-expand-attr): New functions to do namespace handling.
1941 (xml-intern-attrlist): Back-compatible handling of attribute names. 2065 (xml-intern-attrlist): Back-compatible handling of attribute names.
1942 (xml-parse-tag): Move namespace handling to seperate functions. 2066 (xml-parse-tag): Move namespace handling to separate functions.
1943 Now produces elements in the form ((:ns . "element") (attr-list) 2067 Now produces elements in the form ((:ns . "element") (attr-list)
1944 children) instead of ('ns:element (attr-list) children). 2068 children) instead of ('ns:element (attr-list) children).
1945 (xml-parse-attlist): Fix attribute parsing. 2069 (xml-parse-attlist): Fix attribute parsing.
@@ -2450,7 +2574,7 @@
2450 (mode-line-position): Change cons cell into proper list in 2574 (mode-line-position): Change cons cell into proper list in
2451 initialization. 2575 initialization.
2452 2576
24532003-09-29 SAITO Takuya <tabmore@rivo.mediatti.net> (tiny change) 25772003-09-29 SAITO Takuya <tabmore@rivo.mediatti.net> (tiny change)
2454 2578
2455 * international/mule.el (decode-coding-inserted-region): Use car 2579 * international/mule.el (decode-coding-inserted-region): Use car
2456 of the return value of find-operation-coding-system. 2580 of the return value of find-operation-coding-system.
@@ -2500,7 +2624,7 @@
2500 is non-nil, initialize an empty `file-name-history' with the 2624 is non-nil, initialize an empty `file-name-history' with the
2501 recent list. 2625 recent list.
2502 2626
25032003-09-28 Evgeni Dobrev <evgeni_dobrev@developer.bg> (tiny patch) 26272003-09-28 Evgeni Dobrev <evgeni_dobrev@developer.bg> (tiny change)
2504 2628
2505 * man.el (Man-default-man-entry): Remove the leading `*' from the 2629 * man.el (Man-default-man-entry): Remove the leading `*' from the
2506 word at point. 2630 word at point.
@@ -2710,7 +2834,7 @@
2710 (bootstrap-clean-CMD, bootstrap-clean-SH): Recreate loaddefs.el 2834 (bootstrap-clean-CMD, bootstrap-clean-SH): Recreate loaddefs.el
2711 from loaddefs-boot.el if necessary. 2835 from loaddefs-boot.el if necessary.
2712 2836
27132003-09-15 Zoltan Kemenczy <kemenczy@rogers.com> 28372003-09-15 Zoltan Kemenczy <kemenczy@rogers.com>
2714 2838
2715 * progmodes/gud.el (gud-find-class): Make jdb work again since 2839 * progmodes/gud.el (gud-find-class): Make jdb work again since
2716 cc-mode changed the syntactic information. 2840 cc-mode changed the syntactic information.
@@ -2741,7 +2865,7 @@
2741 2865
2742 * emacs-lisp/tq.el (tq-create): Fix mixed up unquote style. 2866 * emacs-lisp/tq.el (tq-create): Fix mixed up unquote style.
2743 2867
27442003-09-12 Eric Hanchrow <offby1@blarg.net> (tiny change) 28682003-09-12 Eric Hanchrow <offby1@blarg.net> (tiny change)
2745 2869
2746 * dired.el (dired-mode-map): Fix typo. 2870 * dired.el (dired-mode-map): Fix typo.
2747 2871
@@ -2879,7 +3003,7 @@
2879 * international/fontset.el (setup-default-fontset): For Thai 3003 * international/fontset.el (setup-default-fontset): For Thai
2880 font, specify "*" family. 3004 font, specify "*" family.
2881 3005
28822003-09-01 Kevin Rodgers <ihs_4664@yahoo.com> (tiny change) 30062003-09-01 Kevin Rodgers <ihs_4664@yahoo.com> (tiny change)
2883 3007
2884 * progmodes/compile.el (previous-error): Accept a prefix 3008 * progmodes/compile.el (previous-error): Accept a prefix
2885 argument, similarly to next-error. 3009 argument, similarly to next-error.
@@ -2920,7 +3044,7 @@
2920 * simple.el (blink-matching-open): Work correctly on chars that 3044 * simple.el (blink-matching-open): Work correctly on chars that
2921 are designated as parens through the syntax-table text property. 3045 are designated as parens through the syntax-table text property.
2922 3046
29232003-08-29 Thierry Emery <thierry.emery@club-internet.fr> (tiny change) 30472003-08-29 Thierry Emery <thierry.emery@club-internet.fr> (tiny change)
2924 3048
2925 * kinsoku.el (kinsoku-longer, kinsoku-shorter): Do not choose a 3049 * kinsoku.el (kinsoku-longer, kinsoku-shorter): Do not choose a
2926 line break position in the middle of a non-kinsoku (e.g. latin) 3050 line break position in the middle of a non-kinsoku (e.g. latin)
@@ -2970,7 +3094,7 @@
2970 * progmodes/cc-engine.el (c-just-after-func-arglist-p): 3094 * progmodes/cc-engine.el (c-just-after-func-arglist-p):
2971 Safeguard against unbalanced sexps. 3095 Safeguard against unbalanced sexps.
2972 3096
29732003-08-26 Terje Rosten <terjeros@phys.ntnu.no> 30972003-08-26 Terje Rosten <terjeros@phys.ntnu.no>
2974 3098
2975 * version.el (emacs-version): Check for gtk. Include gtk version info. 3099 * version.el (emacs-version): Check for gtk. Include gtk version info.
2976 3100
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 27abd52f563..38f7f92405e 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,7 +1,7 @@
1;; ffap.el --- find file (or url) at point 1;;; ffap.el --- find file (or url) at point
2;; 2
3;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 96, 97, 2000, 2004 Free Software Foundation, Inc.
4;; 4
5;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> 5;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
6;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org> 6;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org>
7;; Created: 29 Mar 1993 7;; Created: 29 Mar 1993
@@ -701,7 +701,7 @@ kpathsea, a library used by some versions of TeX."
701 701
702(defun ffap-locate-file (file &optional nosuffix path dir-ok) 702(defun ffap-locate-file (file &optional nosuffix path dir-ok)
703 ;; The Emacs 20 version of locate-library could almost replace this, 703 ;; The Emacs 20 version of locate-library could almost replace this,
704 ;; except it does not let us overrride the suffix list. The 704 ;; except it does not let us override the suffix list. The
705 ;; compression-suffixes search moved to ffap-file-exists-string. 705 ;; compression-suffixes search moved to ffap-file-exists-string.
706 "A generic path-searching function, mimics `load' by default. 706 "A generic path-searching function, mimics `load' by default.
707Returns path to file that \(load FILE\) would load, or nil. 707Returns path to file that \(load FILE\) would load, or nil.
@@ -966,6 +966,7 @@ possibly a major-mode name, or one of the symbol
966MODE (defaults to value of `major-mode') is a symbol used to look up string 966MODE (defaults to value of `major-mode') is a symbol used to look up string
967syntax parameters in `ffap-string-at-point-mode-alist'. 967syntax parameters in `ffap-string-at-point-mode-alist'.
968If MODE is not found, we use `file' instead of MODE. 968If MODE is not found, we use `file' instead of MODE.
969If the region is active, return a string from the region.
969Sets `ffap-string-at-point' and `ffap-string-at-point-region'." 970Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
970 (let* ((args 971 (let* ((args
971 (cdr 972 (cdr
@@ -973,15 +974,19 @@ Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
973 (assq 'file ffap-string-at-point-mode-alist)))) 974 (assq 'file ffap-string-at-point-mode-alist))))
974 (pt (point)) 975 (pt (point))
975 (str 976 (str
976 (buffer-substring 977 (if (and transient-mark-mode mark-active)
977 (save-excursion 978 (buffer-substring
978 (skip-chars-backward (car args)) 979 (setcar ffap-string-at-point-region (region-beginning))
979 (skip-chars-forward (nth 1 args) pt) 980 (setcar (cdr ffap-string-at-point-region) (region-end)))
980 (setcar ffap-string-at-point-region (point))) 981 (buffer-substring
981 (save-excursion 982 (save-excursion
982 (skip-chars-forward (car args)) 983 (skip-chars-backward (car args))
983 (skip-chars-backward (nth 2 args) pt) 984 (skip-chars-forward (nth 1 args) pt)
984 (setcar (cdr ffap-string-at-point-region) (point)))))) 985 (setcar ffap-string-at-point-region (point)))
986 (save-excursion
987 (skip-chars-forward (car args))
988 (skip-chars-backward (nth 2 args) pt)
989 (setcar (cdr ffap-string-at-point-region) (point)))))))
985 (set-text-properties 0 (length str) nil str) 990 (set-text-properties 0 (length str) nil str)
986 (setq ffap-string-at-point str))) 991 (setq ffap-string-at-point str)))
987 992
@@ -1128,9 +1133,6 @@ which may actually result in an url rather than a filename."
1128 ((and ffap-shell-prompt-regexp 1133 ((and ffap-shell-prompt-regexp
1129 (not abs) (string-match ffap-shell-prompt-regexp name) 1134 (not abs) (string-match ffap-shell-prompt-regexp name)
1130 (ffap-file-exists-string (substring name (match-end 0))))) 1135 (ffap-file-exists-string (substring name (match-end 0)))))
1131 ;; Immediately test local filenames. If default-directory is
1132 ;; remote, you probably already have a connection.
1133 ((and (not abs) (ffap-file-exists-string name)))
1134 ;; Accept remote names without actual checking (too slow): 1136 ;; Accept remote names without actual checking (too slow):
1135 ((if abs 1137 ((if abs
1136 (ffap-file-remote-p name) 1138 (ffap-file-remote-p name)
@@ -1675,7 +1677,9 @@ ffap most of the time."
1675 (if (file-directory-p filename) 1677 (if (file-directory-p filename)
1676 (dired (expand-file-name filename)) 1678 (dired (expand-file-name filename))
1677 (dired (concat (expand-file-name filename) "*")))) 1679 (dired (concat (expand-file-name filename) "*"))))
1678 ((and (file-writable-p (file-name-directory filename)) 1680 ((and (file-writable-p
1681 (or (file-name-directory (directory-file-name filename))
1682 filename))
1679 (y-or-n-p "Directory does not exist, create it? ")) 1683 (y-or-n-p "Directory does not exist, create it? "))
1680 (make-directory filename) 1684 (make-directory filename)
1681 (dired filename)) 1685 (dired filename))
@@ -1688,9 +1692,24 @@ ffap most of the time."
1688 (ffap-read-file-or-url 1692 (ffap-read-file-or-url
1689 (if ffap-url-regexp "Dired file or URL: " "Dired file: ") 1693 (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
1690 (prog1 1694 (prog1
1691 (setq guess (or guess (ffap-guesser))) 1695 (setq guess (or guess
1692 (and guess (ffap-highlight)) 1696 (let ((guess (ffap-guesser)))
1693 )) 1697 (if (or (not guess)
1698 (ffap-url-p guess)
1699 (ffap-file-remote-p guess))
1700 guess
1701 (setq guess (abbreviate-file-name
1702 (expand-file-name guess)))
1703 (cond
1704 ;; Interpret local directory as a directory.
1705 ((file-directory-p guess)
1706 (file-name-as-directory guess))
1707 ;; Get directory component from local files.
1708 ((file-regular-p guess)
1709 (file-name-directory guess))
1710 (guess))))
1711 ))
1712 (and guess (ffap-highlight))))
1694 (ffap-highlight t))) 1713 (ffap-highlight t)))
1695 1714
1696;;; Offer default global bindings (`ffap-bindings'): 1715;;; Offer default global bindings (`ffap-bindings'):
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index c81e49bf77c..3be891a49f8 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -1,6 +1,6 @@
1;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP and EFS -*- coding: iso-8859-1; -*- 1;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP and EFS -*- coding: iso-8859-1; -*-
2 2
3;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <Michael.Albinus@alcatel.de> 5;; Author: Michael Albinus <Michael.Albinus@alcatel.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
@@ -24,8 +24,8 @@
24 24
25;;; Commentary: 25;;; Commentary:
26 26
27;; Convenience functions for calling Ange-FTP (and maybe EFS, later on) 27;; Convenience functions for calling Ange-FTP from Tramp.
28;; from Tramp. Most of them are displaced from tramp.el. 28;; Most of them are displaced from tramp.el.
29 29
30;;; Code: 30;;; Code:
31 31
@@ -98,9 +98,16 @@ pass to the OPERATION."
98 (list (nth 0 tramp-file-name-structure) 98 (list (nth 0 tramp-file-name-structure)
99 (nth 3 tramp-file-name-structure) 99 (nth 3 tramp-file-name-structure)
100 (nth 2 tramp-file-name-structure) 100 (nth 2 tramp-file-name-structure)
101 (nth 4 tramp-file-name-structure)))) 101 (nth 4 tramp-file-name-structure)))
102 ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
103 ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
104 ;; there could be incorrect values from previous calls in case the
105 ;; "ftp" method is used in the Tramp file name. So we unset
106 ;; those values.
107 (ange-ftp-ftp-name-arg "")
108 (ange-ftp-ftp-name-res nil))
102 (cond 109 (cond
103 ;; If argument is a symlink, 'file-directory-p` and 'file-exists-p` 110 ;; If argument is a symlink, `file-directory-p' and `file-exists-p'
104 ;; call the traversed file recursively. So we cannot disable the 111 ;; call the traversed file recursively. So we cannot disable the
105 ;; file-name-handler this case. 112 ;; file-name-handler this case.
106 ((memq operation '(file-directory-p file-exists-p)) 113 ((memq operation '(file-directory-p file-exists-p))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 95f3fb330c4..ab6ad3310c1 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,6 +1,6 @@
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 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <Michael.Albinus@alcatel.de> 5;; Author: Michael Albinus <Michael.Albinus@alcatel.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
@@ -50,7 +50,7 @@
50;; Add a default for `tramp-default-method-alist'. Rule: If there is 50;; Add a default for `tramp-default-method-alist'. Rule: If there is
51;; a domain in USER, it must be the SMB method. 51;; a domain in USER, it must be the SMB method.
52(add-to-list 'tramp-default-method-alist 52(add-to-list 'tramp-default-method-alist
53 (list "%" "" tramp-smb-method)) 53 (list "" "%" tramp-smb-method))
54 54
55;; Add completion function for SMB method. 55;; Add completion function for SMB method.
56(tramp-set-completion-function 56(tramp-set-completion-function
@@ -62,7 +62,7 @@
62 :group 'tramp 62 :group 'tramp
63 :type 'string) 63 :type 'string)
64 64
65(defconst tramp-smb-prompt "^smb: \\S-+> " 65(defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$"
66 "Regexp used as prompt in smbclient.") 66 "Regexp used as prompt in smbclient.")
67 67
68(defconst tramp-smb-errors 68(defconst tramp-smb-errors
@@ -71,8 +71,8 @@
71 '(; Connection error 71 '(; Connection error
72 "Connection to \\S-+ failed" 72 "Connection to \\S-+ failed"
73 ; Samba 73 ; Samba
74 "ERRSRV"
75 "ERRDOS" 74 "ERRDOS"
75 "ERRSRV"
76 "ERRbadfile" 76 "ERRbadfile"
77 "ERRbadpw" 77 "ERRbadpw"
78 "ERRfilexists" 78 "ERRfilexists"
@@ -81,13 +81,16 @@
81 "ERRnosuchshare" 81 "ERRnosuchshare"
82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) 82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
83 "NT_STATUS_ACCESS_DENIED" 83 "NT_STATUS_ACCESS_DENIED"
84 "NT_STATUS_ACCOUNT_LOCKED_OUT"
84 "NT_STATUS_BAD_NETWORK_NAME" 85 "NT_STATUS_BAD_NETWORK_NAME"
85 "NT_STATUS_CANNOT_DELETE" 86 "NT_STATUS_CANNOT_DELETE"
86 "NT_STATUS_LOGON_FAILURE" 87 "NT_STATUS_LOGON_FAILURE"
88 "NT_STATUS_NETWORK_ACCESS_DENIED"
87 "NT_STATUS_NO_SUCH_FILE" 89 "NT_STATUS_NO_SUCH_FILE"
88 "NT_STATUS_OBJECT_NAME_INVALID" 90 "NT_STATUS_OBJECT_NAME_INVALID"
89 "NT_STATUS_OBJECT_NAME_NOT_FOUND" 91 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
90 "NT_STATUS_SHARING_VIOLATION") 92 "NT_STATUS_SHARING_VIOLATION"
93 "NT_STATUS_WRONG_PASSWORD")
91 "\\|") 94 "\\|")
92 "Regexp for possible error strings of SMB servers. 95 "Regexp for possible error strings of SMB servers.
93Used instead of analyzing error codes of commands.") 96Used instead of analyzing error codes of commands.")
@@ -102,12 +105,6 @@ This variable is local to each buffer.")
102This variable is local to each buffer.") 105This variable is local to each buffer.")
103(make-variable-buffer-local 'tramp-smb-share-cache) 106(make-variable-buffer-local 'tramp-smb-share-cache)
104 107
105(defvar tramp-smb-process-running nil
106 "Flag whether a corresponding process is still running.
107Will be changed by corresponding `process-sentinel'.
108This variable is local to each buffer.")
109(make-variable-buffer-local 'tramp-smb-process-running)
110
111(defvar tramp-smb-inodes nil 108(defvar tramp-smb-inodes nil
112 "Keeps virtual inodes numbers for SMB files.") 109 "Keeps virtual inodes numbers for SMB files.")
113 110
@@ -452,19 +449,23 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
452 449
453(defun tramp-smb-handle-file-writable-p (filename) 450(defun tramp-smb-handle-file-writable-p (filename)
454 "Like `file-writable-p' for tramp files." 451 "Like `file-writable-p' for tramp files."
455; (with-parsed-tramp-file-name filename nil 452 (if (not (file-exists-p filename))
456 (let (user host localname) 453 (let ((dir (file-name-directory filename)))
457 (with-parsed-tramp-file-name filename l 454 (and (file-exists-p dir)
458 (setq user l-user host l-host localname l-localname)) 455 (file-writable-p dir)))
459 (save-excursion 456; (with-parsed-tramp-file-name filename nil
460 (let* ((share (tramp-smb-get-share localname)) 457 (let (user host localname)
461 (file (tramp-smb-get-localname localname nil)) 458 (with-parsed-tramp-file-name filename l
462 (entries (tramp-smb-get-file-entries user host share file)) 459 (setq user l-user host l-host localname l-localname))
463 (entry (and entries 460 (save-excursion
464 (assoc (file-name-nondirectory file) entries)))) 461 (let* ((share (tramp-smb-get-share localname))
465 (and entry 462 (file (tramp-smb-get-localname localname nil))
466 (string-match "w" (nth 1 entry)) 463 (entries (tramp-smb-get-file-entries user host share file))
467 t))))) 464 (entry (and entries
465 (assoc (file-name-nondirectory file) entries))))
466 (and share entry
467 (string-match "w" (nth 1 entry))
468 t))))))
468 469
469(defun tramp-smb-handle-insert-directory 470(defun tramp-smb-handle-insert-directory
470 (filename switches &optional wildcard full-directory-p) 471 (filename switches &optional wildcard full-directory-p)
@@ -733,9 +734,12 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
733 ;; Cache share entries 734 ;; Cache share entries
734 (setq tramp-smb-share-cache res))) 735 (setq tramp-smb-share-cache res)))
735 736
736
737 ;; Add directory itself 737 ;; Add directory itself
738 (add-to-list 'res '("" "dr-xr-xr-x" 0 (0 0))) 738 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
739
740 ;; There's a very strange error (debugged with XEmacs 21.4.14)
741 ;; If there's no short delay, it returns nil. No idea about
742 (when (featurep 'xemacs) (sleep-for 0.01))
739 743
740 ;; Check for matching entries 744 ;; Check for matching entries
741 (delq nil (mapcar 745 (delq nil (mapcar
@@ -913,7 +917,8 @@ there has been an error message from smbclient."
913 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'. 917 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
914Does not do anything if a connection is already open, but re-opens the 918Does not do anything if a connection is already open, but re-opens the
915connection if a previous connection has died for some reason." 919connection if a previous connection has died for some reason."
916 (let ((p (get-buffer-process 920 (let ((process-connection-type tramp-process-connection-type)
921 (p (get-buffer-process
917 (tramp-get-buffer nil tramp-smb-method user host)))) 922 (tramp-get-buffer nil tramp-smb-method user host))))
918 (save-excursion 923 (save-excursion
919 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 924 (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
@@ -987,11 +992,7 @@ Domain names in USER and port numbers in HOST are acknowledged."
987 (tramp-message 9 "Started process %s" (process-command p)) 992 (tramp-message 9 "Started process %s" (process-command p))
988 (process-kill-without-query p) 993 (process-kill-without-query p)
989 (set-buffer buffer) 994 (set-buffer buffer)
990 (set-process-sentinel 995 (setq tramp-smb-share share)
991 p (lambda (proc str) (setq tramp-smb-process-running nil)))
992 ; If no share is given, the process will terminate
993 (setq tramp-smb-process-running share
994 tramp-smb-share share)
995 996
996 ; send password 997 ; send password
997 (when real-user 998 (when real-user
@@ -1000,54 +1001,44 @@ Domain names in USER and port numbers in HOST are acknowledged."
1000 (tramp-enter-password p pw-prompt))) 1001 (tramp-enter-password p pw-prompt)))
1001 1002
1002 (unless (tramp-smb-wait-for-output user host) 1003 (unless (tramp-smb-wait-for-output user host)
1004 (tramp-clear-passwd user host)
1003 (error "Cannot open connection //%s@%s/%s" 1005 (error "Cannot open connection //%s@%s/%s"
1004 user host (or share ""))))))) 1006 user host (or share "")))))))
1005 1007
1006;; We don't use timeouts. If needed, the caller shall wrap around. 1008;; We don't use timeouts. If needed, the caller shall wrap around.
1007(defun tramp-smb-wait-for-output (user host) 1009(defun tramp-smb-wait-for-output (user host)
1008 "Wait for output from smbclient command. 1010 "Wait for output from smbclient command.
1009Sets position to begin of buffer.
1010Returns nil if an error message has appeared." 1011Returns nil if an error message has appeared."
1011 (save-excursion 1012 (let ((proc (get-buffer-process (current-buffer)))
1012 (let ((proc (get-buffer-process (current-buffer))) 1013 (found (progn (goto-char (point-min))
1013 (found (progn (goto-char (point-max)) 1014 (re-search-forward tramp-smb-prompt nil t)))
1014 (beginning-of-line) 1015 (err (progn (goto-char (point-min))
1015 (looking-at tramp-smb-prompt))) 1016 (re-search-forward tramp-smb-errors nil t))))
1016 err) 1017
1017 (save-match-data 1018 ;; Algorithm: get waiting output. See if last line contains
1018 ;; Algorithm: get waiting output. See if last line contains 1019 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
1019 ;; tramp-smb-prompt sentinel, or process has exited. 1020 ;; If not, wait a bit and again get waiting output.
1020 ;; If not, wait a bit and again get waiting output. 1021 (while (and (not found) (not err))
1021 (while (and (not found) tramp-smb-process-running) 1022
1022 (accept-process-output proc) 1023 ;; Accept pending output.
1023 (goto-char (point-max)) 1024 (accept-process-output proc)
1024 (beginning-of-line) 1025
1025 (setq found (looking-at tramp-smb-prompt))) 1026 ;; Search for prompt.
1026
1027 ;; There might be pending output. If tramp-smb-prompt sentinel
1028 ;; hasn't been found, the process has died already. We should
1029 ;; give it a chance.
1030 (when (not found) (accept-process-output nil 1))
1031
1032 ;; Search for errors.
1033 (goto-char (point-min))
1034 (setq err (re-search-forward tramp-smb-errors nil t)))
1035
1036 ;; Add output to debug buffer if appropriate.
1037 (when tramp-debug-buffer
1038 (append-to-buffer
1039 (tramp-get-debug-buffer nil tramp-smb-method user host)
1040 (point-min) (point-max))
1041 (when (and (not found) tramp-smb-process-running)
1042 (save-excursion
1043 (set-buffer
1044 (tramp-get-debug-buffer nil tramp-smb-method user host))
1045 (goto-char (point-max))
1046 (insert (format "[[Remote prompt `%s' not found]]\n"
1047 tramp-smb-prompt)))))
1048 (goto-char (point-min)) 1027 (goto-char (point-min))
1049 ;; Return value is whether no error message has appeared. 1028 (setq found (re-search-forward tramp-smb-prompt nil t))
1050 (not err)))) 1029
1030 ;; Search for errors.
1031 (goto-char (point-min))
1032 (setq err (re-search-forward tramp-smb-errors nil t)))
1033
1034 ;; Add output to debug buffer if appropriate.
1035 (when tramp-debug-buffer
1036 (append-to-buffer
1037 (tramp-get-debug-buffer nil tramp-smb-method user host)
1038 (point-min) (point-max)))
1039
1040 ;; Return value is whether no error message has appeared.
1041 (not err)))
1051 1042
1052 1043
1053;; Snarfed code from time-date.el and parse-time.el 1044;; Snarfed code from time-date.el and parse-time.el
@@ -1125,8 +1116,6 @@ Return the difference in the format of a time value."
1125;; * Provide a local smb.conf. The default one might not be readable. 1116;; * Provide a local smb.conf. The default one might not be readable.
1126;; * Error handling in case password is wrong. 1117;; * Error handling in case password is wrong.
1127;; * Read password from "~/.netrc". 1118;; * Read password from "~/.netrc".
1128;; * Use different buffers for different shares. By this, the password
1129;; won't be requested again when changing shares on the same host.
1130;; * Return more comprehensive file permission string. Think whether it is 1119;; * Return more comprehensive file permission string. Think whether it is
1131;; possible to implement `set-file-modes'. 1120;; possible to implement `set-file-modes'.
1132;; * Handle WILDCARD and FULL-DIRECTORY-P in 1121;; * Handle WILDCARD and FULL-DIRECTORY-P in
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 949d76364fc..cd6ed337927 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,7 +1,7 @@
1;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*- 1;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
2;;; tramp.el --- Transparent Remote Access, Multiple Protocol 2;;; tramp.el --- Transparent Remote Access, Multiple Protocol
3 3
4;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. 4;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
5 5
6;; Author: kai.grossjohann@gmx.net 6;; Author: kai.grossjohann@gmx.net
7;; Keywords: comm, processes 7;; Keywords: comm, processes
@@ -72,6 +72,12 @@
72 72
73(require 'timer) 73(require 'timer)
74(require 'format-spec) ;from Gnus 5.8, also in tar ball 74(require 'format-spec) ;from Gnus 5.8, also in tar ball
75;; As long as password.el is not part of (X)Emacs, it shouldn't
76;; be mandatory
77(if (featurep 'xemacs)
78 (load "password" 'noerror)
79 (require 'password nil 'noerror)) ;from No Gnus, also in tar ball
80
75;; The explicit check is not necessary in Emacs, which provides the 81;; The explicit check is not necessary in Emacs, which provides the
76;; feature even if implemented in C, but it appears to be necessary 82;; feature even if implemented in C, but it appears to be necessary
77;; in XEmacs. 83;; in XEmacs.
@@ -628,14 +634,18 @@ See `tramp-methods' for a list of possibilities for METHOD."
628;; Default values for non-Unices seeked 634;; Default values for non-Unices seeked
629(defconst tramp-completion-function-alist-ssh 635(defconst tramp-completion-function-alist-ssh
630 (unless (memq system-type '(windows-nt)) 636 (unless (memq system-type '(windows-nt))
631 '((tramp-parse-rhosts "/etc/hosts.equiv") 637 '((tramp-parse-rhosts "/etc/hosts.equiv")
632 (tramp-parse-rhosts "/etc/shosts.equiv") 638 (tramp-parse-rhosts "/etc/shosts.equiv")
633 (tramp-parse-shosts "/etc/ssh_known_hosts") 639 (tramp-parse-shosts "/etc/ssh_known_hosts")
634 (tramp-parse-sconfig "/etc/ssh_config") 640 (tramp-parse-sconfig "/etc/ssh_config")
635 (tramp-parse-rhosts "~/.rhosts") 641 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
636 (tramp-parse-rhosts "~/.shosts") 642 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
637 (tramp-parse-shosts "~/.ssh/known_hosts") 643 (tramp-parse-rhosts "~/.rhosts")
638 (tramp-parse-sconfig "~/.ssh/config"))) 644 (tramp-parse-rhosts "~/.shosts")
645 (tramp-parse-shosts "~/.ssh/known_hosts")
646 (tramp-parse-sconfig "~/.ssh/config")
647 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
648 (tramp-parse-sknownhosts "~/.ssh2/knownhosts")))
639 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") 649 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
640 650
641;; Default values for non-Unices seeked 651;; Default values for non-Unices seeked
@@ -650,53 +660,79 @@ See `tramp-methods' for a list of possibilities for METHOD."
650 '((tramp-parse-passwd "/etc/passwd"))) 660 '((tramp-parse-passwd "/etc/passwd")))
651 "Default list of (FUNCTION FILE) pairs to be examined for su methods.") 661 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
652 662
653(defcustom tramp-completion-function-alist 663(defvar tramp-completion-function-alist nil
654 (list (cons "rcp" tramp-completion-function-alist-rsh)
655 (cons "scp" tramp-completion-function-alist-ssh)
656 (cons "scp1" tramp-completion-function-alist-ssh)
657 (cons "scp2" tramp-completion-function-alist-ssh)
658 (cons "scp1_old" tramp-completion-function-alist-ssh)
659 (cons "scp2_old" tramp-completion-function-alist-ssh)
660 (cons "rsync" tramp-completion-function-alist-rsh)
661 (cons "remcp" tramp-completion-function-alist-rsh)
662 (cons "rsh" tramp-completion-function-alist-rsh)
663 (cons "ssh" tramp-completion-function-alist-ssh)
664 (cons "ssh1" tramp-completion-function-alist-ssh)
665 (cons "ssh2" tramp-completion-function-alist-ssh)
666 (cons "ssh1_old" tramp-completion-function-alist-ssh)
667 (cons "ssh2_old" tramp-completion-function-alist-ssh)
668 (cons "remsh" tramp-completion-function-alist-rsh)
669 (cons "telnet" tramp-completion-function-alist-telnet)
670 (cons "su" tramp-completion-function-alist-su)
671 (cons "sudo" tramp-completion-function-alist-su)
672 (cons "multi" nil)
673 (cons "scpx" tramp-completion-function-alist-ssh)
674 (cons "sshx" tramp-completion-function-alist-ssh)
675 (cons "krlogin" tramp-completion-function-alist-rsh)
676 (cons "plink" tramp-completion-function-alist-ssh)
677 (cons "plink1" tramp-completion-function-alist-ssh)
678 (cons "pscp" tramp-completion-function-alist-ssh)
679 (cons "fcp" tramp-completion-function-alist-ssh)
680 )
681 "*Alist of methods for remote files. 664 "*Alist of methods for remote files.
682This is a list of entries of the form (NAME PAIR1 PAIR2 ...). 665This is a list of entries of the form (NAME PAIR1 PAIR2 ...).
683Each NAME stands for a remote access method. Each PAIR is of the form 666Each NAME stands for a remote access method. Each PAIR is of the form
684\(FUNCTION FILE). FUNCTION is responsible to extract user names and host 667\(FUNCTION FILE). FUNCTION is responsible to extract user names and host
685names from FILE for completion. The following predefined FUNCTIONs exists: 668names from FILE for completion. The following predefined FUNCTIONs exists:
686 669
687 * `tramp-parse-rhosts' for \"~/.rhosts\" like files, 670 * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
688 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files, 671 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
689 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files, 672 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
690 * `tramp-parse-hosts' for \"/etc/hosts\" like files, and 673 * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
691 * `tramp-parse-passwd' for \"/etc/passwd\" like files. 674 * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
692 * `tramp-parse-netrc' for \"~/.netrc\" like files. 675 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
693 676 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
694FUNCTION can also see a customer defined function. For more details see 677 * `tramp-parse-netrc' for \"~/.netrc\" like files.
695the info pages." 678
696 :group 'tramp 679FUNCTION can also be a customer defined function. For more details see
697 :type '(repeat 680the info pages.")
698 (cons string 681
699 (choice (const nil) (repeat (list function file)))))) 682(eval-after-load "tramp"
683 '(progn
684 (tramp-set-completion-function
685 "rcp" tramp-completion-function-alist-rsh)
686 (tramp-set-completion-function
687 "scp" tramp-completion-function-alist-ssh)
688 (tramp-set-completion-function
689 "scp1" tramp-completion-function-alist-ssh)
690 (tramp-set-completion-function
691 "scp2" tramp-completion-function-alist-ssh)
692 (tramp-set-completion-function
693 "scp1_old" tramp-completion-function-alist-ssh)
694 (tramp-set-completion-function
695 "scp2_old" tramp-completion-function-alist-ssh)
696 (tramp-set-completion-function
697 "rsync" tramp-completion-function-alist-rsh)
698 (tramp-set-completion-function
699 "remcp" tramp-completion-function-alist-rsh)
700 (tramp-set-completion-function
701 "rsh" tramp-completion-function-alist-rsh)
702 (tramp-set-completion-function
703 "ssh" tramp-completion-function-alist-ssh)
704 (tramp-set-completion-function
705 "ssh1" tramp-completion-function-alist-ssh)
706 (tramp-set-completion-function
707 "ssh2" tramp-completion-function-alist-ssh)
708 (tramp-set-completion-function
709 "ssh1_old" tramp-completion-function-alist-ssh)
710 (tramp-set-completion-function
711 "ssh2_old" tramp-completion-function-alist-ssh)
712 (tramp-set-completion-function
713 "remsh" tramp-completion-function-alist-rsh)
714 (tramp-set-completion-function
715 "telnet" tramp-completion-function-alist-telnet)
716 (tramp-set-completion-function
717 "su" tramp-completion-function-alist-su)
718 (tramp-set-completion-function
719 "sudo" tramp-completion-function-alist-su)
720 (tramp-set-completion-function
721 "multi" nil)
722 (tramp-set-completion-function
723 "scpx" tramp-completion-function-alist-ssh)
724 (tramp-set-completion-function
725 "sshx" tramp-completion-function-alist-ssh)
726 (tramp-set-completion-function
727 "krlogin" tramp-completion-function-alist-rsh)
728 (tramp-set-completion-function
729 "plink" tramp-completion-function-alist-ssh)
730 (tramp-set-completion-function
731 "plink1" tramp-completion-function-alist-ssh)
732 (tramp-set-completion-function
733 "pscp" tramp-completion-function-alist-ssh)
734 (tramp-set-completion-function
735 "fcp" tramp-completion-function-alist-ssh)))
700 736
701(defcustom tramp-rsh-end-of-line "\n" 737(defcustom tramp-rsh-end-of-line "\n"
702 "*String used for end of line in rsh connections. 738 "*String used for end of line in rsh connections.
@@ -1267,6 +1303,17 @@ this variable to be set as well."
1267 :group 'tramp 1303 :group 'tramp
1268 :type '(choice (const nil) integer)) 1304 :type '(choice (const nil) integer))
1269 1305
1306;; Logging in to a remote host normally requires obtaining a pty. But
1307;; Emacs on MacOS X has process-connection-type set to nil by default,
1308;; so on those systems Tramp doesn't obtain a pty. Here, we allow
1309;; for an override of the system default.
1310(defcustom tramp-process-connection-type t
1311 "Overrides `process-connection-type' for connections from Tramp.
1312Tramp binds process-connection-type to the value given here before
1313opening a connection to a remote host."
1314 :group 'tramp
1315 :type '(choice (const nil) (const t) (const pty)))
1316
1270;;; Internal Variables: 1317;;; Internal Variables:
1271 1318
1272(defvar tramp-buffer-file-attributes nil 1319(defvar tramp-buffer-file-attributes nil
@@ -1638,6 +1685,7 @@ on the FILENAME argument, even if VISIT was a string.")
1638 (insert-file-contents . tramp-handle-insert-file-contents) 1685 (insert-file-contents . tramp-handle-insert-file-contents)
1639 (write-region . tramp-handle-write-region) 1686 (write-region . tramp-handle-write-region)
1640 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) 1687 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
1688 (dired-compress-file . tramp-handle-dired-compress-file)
1641 (dired-call-process . tramp-handle-dired-call-process) 1689 (dired-call-process . tramp-handle-dired-call-process)
1642 (dired-recursive-delete-directory 1690 (dired-recursive-delete-directory
1643 . tramp-handle-dired-recursive-delete-directory) 1691 . tramp-handle-dired-recursive-delete-directory)
@@ -1761,15 +1809,30 @@ Example:
1761 '((tramp-parse-sconfig \"/etc/ssh_config\") 1809 '((tramp-parse-sconfig \"/etc/ssh_config\")
1762 (tramp-parse-sconfig \"~/.ssh/config\")))" 1810 (tramp-parse-sconfig \"~/.ssh/config\")))"
1763 1811
1764 (let ((v (cdr (assoc method tramp-completion-function-alist)))) 1812 (let ((r function-list)
1765 (if v (setcdr v function-list) 1813 (v function-list))
1814 (setq tramp-completion-function-alist
1815 (delete (assoc method tramp-completion-function-alist)
1816 tramp-completion-function-alist))
1817
1818 (while v
1819 ;; Remove double entries
1820 (when (member (car v) (cdr v))
1821 (setcdr v (delete (car v) (cdr v))))
1822 ;; Check for function and file
1823 (unless (and (functionp (nth 0 (car v)))
1824 (file-exists-p (nth 1 (car v))))
1825 (setq r (delete (car v) r)))
1826 (setq v (cdr v)))
1827
1828 (when r
1766 (add-to-list 'tramp-completion-function-alist 1829 (add-to-list 'tramp-completion-function-alist
1767 (cons method function-list))))) 1830 (cons method r)))))
1768 1831
1769(defun tramp-get-completion-function (method) 1832(defun tramp-get-completion-function (method)
1770 "Returns list of completion functions for METHOD. 1833 "Returns list of completion functions for METHOD.
1771For definition of that list see `tramp-set-completion-function'." 1834For definition of that list see `tramp-set-completion-function'."
1772 (cdr (assoc method tramp-completion-function-alist))) 1835 (cdr (assoc method tramp-completion-function-alist)))
1773 1836
1774;;; File Name Handler Functions: 1837;;; File Name Handler Functions:
1775 1838
@@ -2586,44 +2649,86 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
2586 (signal 'file-already-exists 2649 (signal 'file-already-exists
2587 (list newname)))) 2650 (list newname))))
2588 (let ((t1 (tramp-tramp-file-p filename)) 2651 (let ((t1 (tramp-tramp-file-p filename))
2589 (t2 (tramp-tramp-file-p newname))) 2652 (t2 (tramp-tramp-file-p newname))
2653 v1-multi-method v1-method v1-user v1-host v1-localname
2654 v2-multi-method v2-method v2-user v2-host v2-localname)
2655
2590 ;; Check which ones of source and target are Tramp files. 2656 ;; Check which ones of source and target are Tramp files.
2657 ;; We cannot invoke `with-parsed-tramp-file-name';
2658 ;; it fails if the file isn't a Tramp file name.
2659 (if t1
2660 (with-parsed-tramp-file-name filename l
2661 (setq v1-multi-method l-multi-method
2662 v1-method l-method
2663 v1-user l-user
2664 v1-host l-host
2665 v1-localname l-localname))
2666 (setq v1-localname filename))
2667 (if t2
2668 (with-parsed-tramp-file-name newname l
2669 (setq v2-multi-method l-multi-method
2670 v2-method l-method
2671 v2-user l-user
2672 v2-host l-host
2673 v2-localname l-localname))
2674 (setq v2-localname newname))
2675
2591 (cond 2676 (cond
2677 ;; Both are Tramp files.
2592 ((and t1 t2) 2678 ((and t1 t2)
2593 ;; Both are Tramp files. 2679 (cond
2594 (with-parsed-tramp-file-name filename v1 2680 ;; Shortcut: if method, host, user are the same for both
2595 (with-parsed-tramp-file-name newname v2 2681 ;; files, we invoke `cp' or `mv' on the remote host
2596 ;; Check if we can use a shortcut. 2682 ;; directly.
2597 (if (and (equal v1-multi-method v2-multi-method) 2683 ((and (equal v1-multi-method v2-multi-method)
2598 (equal v1-method v2-method) 2684 (equal v1-method v2-method)
2599 (equal v1-host v2-host) 2685 (equal v1-user v2-user)
2600 (equal v1-user v2-user)) 2686 (equal v1-host v2-host))
2601 ;; Shortcut: if method, host, user are the same for both 2687 (tramp-do-copy-or-rename-file-directly
2602 ;; files, we invoke `cp' or `mv' on the remote host 2688 op v1-multi-method v1-method v1-user v1-host
2603 ;; directly. 2689 v1-localname v2-localname keep-date))
2604 (tramp-do-copy-or-rename-file-directly 2690 ;; If both source and target are Tramp files,
2605 op v1-multi-method v1-method v1-user v1-host 2691 ;; both are using the same copy-program, then we
2606 v1-localname v2-localname keep-date) 2692 ;; can invoke rcp directly. Note that
2607 ;; The shortcut was not possible. So we copy the 2693 ;; default-directory should point to a local
2608 ;; file first. If the operation was `rename', we go 2694 ;; directory if we want to invoke rcp.
2609 ;; back and delete the original file (if the copy was 2695 ((and (not v1-multi-method)
2610 ;; successful). The approach is simple-minded: we 2696 (not v2-multi-method)
2611 ;; create a new buffer, insert the contents of the 2697 (equal v1-method v2-method)
2612 ;; source file into it, then write out the buffer to 2698 (tramp-method-out-of-band-p
2613 ;; the target file. The advantage is that it doesn't 2699 v1-multi-method v1-method v1-user v1-host)
2614 ;; matter which filename handlers are used for the 2700 (not (string-match "\\([^#]*\\)#\\(.*\\)" v1-host))
2615 ;; source and target file. 2701 (not (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)))
2616 2702 (tramp-do-copy-or-rename-file-out-of-band
2617 ;; CCC: If both source and target are Tramp files, 2703 op filename newname keep-date))
2618 ;; and both are using the same copy-program, then we 2704 ;; No shortcut was possible. So we copy the
2619 ;; can invoke rcp directly. Note that 2705 ;; file first. If the operation was `rename', we go
2620 ;; default-directory should point to a local 2706 ;; back and delete the original file (if the copy was
2621 ;; directory if we want to invoke rcp. 2707 ;; successful). The approach is simple-minded: we
2622 (tramp-do-copy-or-rename-via-buffer 2708 ;; create a new buffer, insert the contents of the
2623 op filename newname keep-date))))) 2709 ;; source file into it, then write out the buffer to
2710 ;; the target file. The advantage is that it doesn't
2711 ;; matter which filename handlers are used for the
2712 ;; source and target file.
2713 (t
2714 (tramp-do-copy-or-rename-via-buffer
2715 op filename newname keep-date))))
2716
2717 ;; One file is a Tramp file, the other one is local.
2624 ((or t1 t2) 2718 ((or t1 t2)
2625 ;; Use the generic method via a Tramp buffer. 2719 ;; If the Tramp file has an out-of-band method, the corresponding
2626 (tramp-do-copy-or-rename-via-buffer op filename newname keep-date)) 2720 ;; copy-program can be invoked.
2721 (if (and (not v1-multi-method)
2722 (not v2-multi-method)
2723 (or (tramp-method-out-of-band-p
2724 v1-multi-method v1-method v1-user v1-host)
2725 (tramp-method-out-of-band-p
2726 v2-multi-method v2-method v2-user v2-host)))
2727 (tramp-do-copy-or-rename-file-out-of-band
2728 op filename newname keep-date)
2729 ;; Use the generic method via a Tramp buffer.
2730 (tramp-do-copy-or-rename-via-buffer op filename newname keep-date)))
2731
2627 (t 2732 (t
2628 ;; One of them must be a Tramp file. 2733 ;; One of them must be a Tramp file.
2629 (error "Tramp implementation says this cannot happen"))))) 2734 (error "Tramp implementation says this cannot happen")))))
@@ -2634,8 +2739,9 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
2634First arg OP is either `copy' or `rename' and indicates the operation. 2739First arg OP is either `copy' or `rename' and indicates the operation.
2635FILENAME is the source file, NEWNAME the target file. 2740FILENAME is the source file, NEWNAME the target file.
2636KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." 2741KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
2637 (let ((trampbuf (get-buffer-create "*tramp output*"))) 2742 (let ((trampbuf (get-buffer-create "*tramp output*"))
2638 (when keep-date 2743 (modtime (nth 5 (file-attributes filename))))
2744 (when (and keep-date (or (null modtime) (equal modtime '(0 0))))
2639 (tramp-message 2745 (tramp-message
2640 1 (concat "Warning: cannot preserve file time stamp" 2746 1 (concat "Warning: cannot preserve file time stamp"
2641 " with inline copying across machines"))) 2747 " with inline copying across machines")))
@@ -2646,7 +2752,12 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
2646 ;; `jka-compr-inhibit' to t. 2752 ;; `jka-compr-inhibit' to t.
2647 (let ((coding-system-for-write 'binary) 2753 (let ((coding-system-for-write 'binary)
2648 (jka-compr-inhibit t)) 2754 (jka-compr-inhibit t))
2649 (write-region (point-min) (point-max) newname))) 2755 (write-region (point-min) (point-max) newname))
2756 ;; KEEP-DATE handling.
2757 (when (and keep-date
2758 (not (null modtime))
2759 (not (equal modtime '(0 0))))
2760 (tramp-touch newname modtime)))
2650 ;; If the operation was `rename', delete the original file. 2761 ;; If the operation was `rename', delete the original file.
2651 (unless (eq op 'copy) 2762 (unless (eq op 'copy)
2652 (delete-file filename)))) 2763 (delete-file filename))))
@@ -2676,13 +2787,112 @@ If KEEP-DATE is non-nil, preserve the time stamp when copying."
2676 "Copying directly failed, see buffer `%s' for details." 2787 "Copying directly failed, see buffer `%s' for details."
2677 (buffer-name))))) 2788 (buffer-name)))))
2678 2789
2679(defun tramp-do-copy-or-rename-file-one-local 2790(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
2680 (op filename newname keep-date)
2681 "Invoke rcp program to copy. 2791 "Invoke rcp program to copy.
2682One of FILENAME and NEWNAME must be a Tramp name, the other must 2792One of FILENAME and NEWNAME must be a Tramp name, the other must
2683be a local filename. The method used must be an out-of-band method." 2793be a local filename. The method used must be an out-of-band method."
2684 ;; CCC 2794 (let ((trampbuf (get-buffer-create "*tramp output*"))
2685 ) 2795 (t1 (tramp-tramp-file-p filename))
2796 (t2 (tramp-tramp-file-p newname))
2797 v1-multi-method v1-method v1-user v1-host v1-localname
2798 v2-multi-method v2-method v2-user v2-host v2-localname
2799 method copy-program copy-args source target)
2800
2801 ;; Check which ones of source and target are Tramp files.
2802 ;; We cannot invoke `with-parsed-tramp-file-name';
2803 ;; it fails if the file isn't a Tramp file name.
2804 (if t1
2805 (with-parsed-tramp-file-name filename l
2806 (setq v1-multi-method l-multi-method
2807 v1-method l-method
2808 v1-user l-user
2809 v1-host l-host
2810 v1-localname l-localname
2811 method (tramp-find-method
2812 v1-multi-method v1-method v1-user v1-host)
2813 copy-program (tramp-get-method-parameter
2814 v1-multi-method method
2815 v1-user v1-host 'tramp-copy-program)
2816 copy-args (tramp-get-method-parameter
2817 v1-multi-method method
2818 v1-user v1-host 'tramp-copy-args)))
2819 (setq v1-localname filename))
2820
2821 (if t2
2822 (with-parsed-tramp-file-name newname l
2823 (setq v2-multi-method l-multi-method
2824 v2-method l-method
2825 v2-user l-user
2826 v2-host l-host
2827 v2-localname l-localname
2828 method (tramp-find-method
2829 v2-multi-method v2-method v2-user v2-host)
2830 copy-program (tramp-get-method-parameter
2831 v2-multi-method method
2832 v2-user v2-host 'tramp-copy-program)
2833 copy-args (tramp-get-method-parameter
2834 v2-multi-method method
2835 v2-user v2-host 'tramp-copy-args)))
2836 (setq v2-localname newname))
2837
2838 ;; The following should be changed. We need a more general
2839 ;; mechanism to parse extra host args.
2840 (if (not t1)
2841 (setq source v1-localname)
2842 (when (string-match "\\([^#]*\\)#\\(.*\\)" v1-host)
2843 (setq copy-args (cons "-P" (cons (match-string 2 v1-host) copy-args)))
2844 (setq v1-host (match-string 1 v1-host)))
2845 (setq source
2846 (tramp-make-copy-program-file-name
2847 v1-user v1-host
2848 (tramp-shell-quote-argument v1-localname))))
2849
2850 (if (not t2)
2851 (setq target v2-localname)
2852 (when (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)
2853 (setq copy-args (cons "-P" (cons (match-string 2 v2-host) copy-args)))
2854 (setq v2-host (match-string 1 v2-host)))
2855 (setq target
2856 (tramp-make-copy-program-file-name
2857 v2-user v2-host
2858 (tramp-shell-quote-argument v2-localname))))
2859
2860 ;; Handle keep-date argument
2861 (when keep-date
2862 (if t1
2863 (setq copy-args
2864 (cons (tramp-get-method-parameter
2865 v1-multi-method method
2866 v1-user v1-host 'tramp-copy-keep-date-arg)
2867 copy-args))
2868 (setq copy-args
2869 (cons (tramp-get-method-parameter
2870 v2-multi-method method
2871 v2-user v2-host 'tramp-copy-keep-date-arg)
2872 copy-args))))
2873
2874 (setq copy-args (append copy-args (list source target)))
2875
2876 ;; Use rcp-like program for file transfer.
2877 (tramp-message
2878 5 "Transferring %s to file %s..." filename newname)
2879 (save-excursion (set-buffer trampbuf) (erase-buffer))
2880 (unless (equal
2881 0
2882 (apply #'call-process copy-program
2883 nil trampbuf nil copy-args))
2884 (pop-to-buffer trampbuf)
2885 (error
2886 (concat
2887 "tramp-do-copy-or-rename-file-out-of-band: `%s' didn't work, "
2888 "see buffer `%s' for details")
2889 copy-program trampbuf))
2890 (tramp-message
2891 5 "Transferring %s to file %s...done" filename newname)
2892
2893 ;; If the operation was `rename', delete the original file.
2894 (unless (eq op 'copy)
2895 (delete-file filename))))
2686 2896
2687;; mkdir 2897;; mkdir
2688(defun tramp-handle-make-directory (dir &optional parents) 2898(defun tramp-handle-make-directory (dir &optional parents)
@@ -2745,7 +2955,6 @@ This is like `dired-recursive-delete-directory' for tramp files."
2745 (and (tramp-handle-file-exists-p filename) 2955 (and (tramp-handle-file-exists-p filename)
2746 (error "Failed to recusively delete %s" filename)))) 2956 (error "Failed to recusively delete %s" filename))))
2747 2957
2748
2749(defun tramp-handle-dired-call-process (program discard &rest arguments) 2958(defun tramp-handle-dired-call-process (program discard &rest arguments)
2750 "Like `dired-call-process' for tramp files." 2959 "Like `dired-call-process' for tramp files."
2751 (with-parsed-tramp-file-name default-directory nil 2960 (with-parsed-tramp-file-name default-directory nil
@@ -2767,6 +2976,59 @@ This is like `dired-recursive-delete-directory' for tramp files."
2767 (tramp-send-command-and-check multi-method method user host nil) 2976 (tramp-send-command-and-check multi-method method user host nil)
2768 (tramp-send-command multi-method method user host "cd") 2977 (tramp-send-command multi-method method user host "cd")
2769 (tramp-wait-for-output))))) 2978 (tramp-wait-for-output)))))
2979
2980(defun tramp-handle-dired-compress-file (file &rest ok-flag)
2981 "Like `dired-compress-file' for tramp files."
2982 ;; OK-FLAG is valid for XEmacs only, but not implemented.
2983 ;; Code stolen mainly from dired-aux.el.
2984 (with-parsed-tramp-file-name file nil
2985 (save-excursion
2986 (let ((suffixes
2987 (if (not (featurep 'xemacs))
2988 ;; Emacs case
2989 (symbol-value 'dired-compress-file-suffixes)
2990 ;; XEmacs has `dired-compression-method-alist', which is
2991 ;; transformed into `dired-compress-file-suffixes' structure.
2992 (mapcar
2993 '(lambda (x)
2994 (list (concat (regexp-quote (nth 1 x)) "\\'")
2995 nil
2996 (mapconcat 'identity (nth 3 x) " ")))
2997 (symbol-value 'dired-compression-method-alist))))
2998 suffix)
2999 ;; See if any suffix rule matches this file name.
3000 (while suffixes
3001 (let (case-fold-search)
3002 (if (string-match (car (car suffixes)) localname)
3003 (setq suffix (car suffixes) suffixes nil))
3004 (setq suffixes (cdr suffixes))))
3005
3006 (cond ((file-symlink-p file)
3007 nil)
3008 ((and suffix (nth 2 suffix))
3009 ;; We found an uncompression rule.
3010 (message "Uncompressing %s..." file)
3011 (when (zerop (tramp-send-command-and-check
3012 multi-method method user host
3013 (concat (nth 2 suffix) " " localname)))
3014 (message "Uncompressing %s...done" file)
3015 (dired-remove-file file)
3016 (string-match (car suffix) file)
3017 (concat (substring file 0 (match-beginning 0)))))
3018 (t
3019 ;; We don't recognize the file as compressed, so compress it.
3020 ;; Try gzip.
3021 (message "Compressing %s..." file)
3022 (when (zerop (tramp-send-command-and-check
3023 multi-method method user host
3024 (concat "gzip -f " localname)))
3025 (message "Compressing %s...done" file)
3026 (dired-remove-file file)
3027 (cond ((file-exists-p (concat file ".gz"))
3028 (concat file ".gz"))
3029 ((file-exists-p (concat file ".z"))
3030 (concat file ".z"))
3031 (t nil)))))))))
2770 3032
2771;; Pacify byte-compiler. The function is needed on XEmacs only. I'm 3033;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
2772;; not sure at all that this is the right way to do it, but let's hope 3034;; not sure at all that this is the right way to do it, but let's hope
@@ -2961,17 +3223,40 @@ the result will be a local, non-Tramp, filename."
2961 3223
2962;; Remote commands. 3224;; Remote commands.
2963 3225
3226(defvar tramp-async-proc nil
3227 "Global variable keeping asyncronous process object.
3228Used in `tramp-handle-shell-command'")
3229
2964(defun tramp-handle-shell-command (command &optional output-buffer error-buffer) 3230(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
2965 "Like `shell-command' for tramp files. 3231 "Like `shell-command' for tramp files.
2966This will break if COMMAND prints a newline, followed by the value of 3232This will break if COMMAND prints a newline, followed by the value of
2967`tramp-end-of-output', followed by another newline." 3233`tramp-end-of-output', followed by another newline."
3234 ;; Asynchronous processes are far from being perfect. But it works at least
3235 ;; for `find-grep-dired' and `find-name-dired' in Emacs 21.4.
2968 (if (tramp-tramp-file-p default-directory) 3236 (if (tramp-tramp-file-p default-directory)
2969 (with-parsed-tramp-file-name default-directory nil 3237 (with-parsed-tramp-file-name default-directory nil
2970 (let (status) 3238 (let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
2971 (when (string-match "&[ \t]*\\'" command) 3239 status)
2972 (error "Tramp doesn't grok asynchronous shell commands, yet")) 3240 (unless output-buffer
2973;; (when error-buffer 3241 (setq output-buffer
2974;; (error "Tramp doesn't grok optional third arg ERROR-BUFFER, yet")) 3242 (get-buffer-create
3243 (if asynchronous
3244 "*Async Shell Command*"
3245 "*Shell Command Output*")))
3246 (set-buffer output-buffer)
3247 (erase-buffer))
3248 (unless (bufferp output-buffer)
3249 (setq output-buffer (current-buffer)))
3250 (set-buffer output-buffer)
3251 ;; Tramp doesn't handle the asynchronous case by an asynchronous
3252 ;; process. Instead of, another asynchronous process is opened
3253 ;; which gets the output of the (synchronous) Tramp process
3254 ;; via process-filter. ERROR-BUFFER is disabled.
3255 (when asynchronous
3256 (setq command (substring command 0 (match-beginning 0))
3257 error-buffer nil
3258 tramp-async-proc (start-process (buffer-name output-buffer)
3259 output-buffer "cat")))
2975 (save-excursion 3260 (save-excursion
2976 (tramp-barf-unless-okay 3261 (tramp-barf-unless-okay
2977 multi-method method user host 3262 multi-method method user host
@@ -2979,23 +3264,39 @@ This will break if COMMAND prints a newline, followed by the value of
2979 nil 'file-error 3264 nil 'file-error
2980 "tramp-handle-shell-command: Couldn't `cd %s'" 3265 "tramp-handle-shell-command: Couldn't `cd %s'"
2981 (tramp-shell-quote-argument localname)) 3266 (tramp-shell-quote-argument localname))
3267 ;; Define the process filter
3268 (when asynchronous
3269 (set-process-filter
3270 (get-buffer-process
3271 (tramp-get-buffer multi-method method user host))
3272 '(lambda (process string)
3273 ;; Write the output into the Tramp Process
3274 (save-current-buffer
3275 (set-buffer (process-buffer process))
3276 (goto-char (point-max))
3277 (insert string))
3278 ;; Hand-over output to asynchronous process.
3279 (let ((end
3280 (string-match
3281 (regexp-quote tramp-end-of-output) string)))
3282 (when end
3283 (setq string
3284 (substring string 0 (1- (match-beginning 0)))))
3285 (process-send-string tramp-async-proc string)
3286 (when end
3287 (set-process-filter process nil)
3288 (process-send-eof tramp-async-proc))))))
3289 ;; Send the command
2982 (tramp-send-command 3290 (tramp-send-command
2983 multi-method method user host 3291 multi-method method user host
2984 (if error-buffer 3292 (if error-buffer
2985 (format "( %s ) 2>/tmp/tramp.$$.err; tramp_old_status=$?" 3293 (format "( %s ) 2>/tmp/tramp.$$.err; tramp_old_status=$?"
2986 command) 3294 command)
2987 (format "%s ;tramp_old_status=$?" command))) 3295 (format "%s; tramp_old_status=$?" command)))
2988 ;; This will break if the shell command prints "/////" 3296 (unless asynchronous
2989 ;; somewhere. Let's just hope for the best... 3297 (tramp-wait-for-output)))
2990 (tramp-wait-for-output)) 3298 (unless asynchronous
2991 (unless output-buffer 3299 (insert-buffer (tramp-get-buffer multi-method method user host)))
2992 (setq output-buffer (get-buffer-create "*Shell Command Output*"))
2993 (set-buffer output-buffer)
2994 (erase-buffer))
2995 (unless (bufferp output-buffer)
2996 (setq output-buffer (current-buffer)))
2997 (set-buffer output-buffer)
2998 (insert-buffer (tramp-get-buffer multi-method method user host))
2999 (when error-buffer 3300 (when error-buffer
3000 (save-excursion 3301 (save-excursion
3001 (unless (bufferp error-buffer) 3302 (unless (bufferp error-buffer)
@@ -3010,17 +3311,19 @@ This will break if COMMAND prints a newline, followed by the value of
3010 multi-method method user host "rm -f /tmp/tramp.$$.err"))) 3311 multi-method method user host "rm -f /tmp/tramp.$$.err")))
3011 (save-excursion 3312 (save-excursion
3012 (tramp-send-command multi-method method user host "cd") 3313 (tramp-send-command multi-method method user host "cd")
3013 (tramp-wait-for-output) 3314 (unless asynchronous
3315 (tramp-wait-for-output))
3014 (tramp-send-command 3316 (tramp-send-command
3015 multi-method method user host 3317 multi-method method user host
3016 (concat "tramp_set_exit_status $tramp_old_status;" 3318 (concat "tramp_set_exit_status $tramp_old_status;"
3017 " echo tramp_exit_status $?")) 3319 " echo tramp_exit_status $?"))
3018 (tramp-wait-for-output) 3320 (unless asynchronous
3019 (goto-char (point-max)) 3321 (tramp-wait-for-output)
3020 (unless (search-backward "tramp_exit_status " nil t) 3322 (goto-char (point-max))
3021 (error "Couldn't find exit status of `%s'" command)) 3323 (unless (search-backward "tramp_exit_status " nil t)
3022 (skip-chars-forward "^ ") 3324 (error "Couldn't find exit status of `%s'" command))
3023 (setq status (read (current-buffer)))) 3325 (skip-chars-forward "^ ")
3326 (setq status (read (current-buffer)))))
3024 (unless (zerop (buffer-size)) 3327 (unless (zerop (buffer-size))
3025 (display-buffer output-buffer)) 3328 (display-buffer output-buffer))
3026 status)) 3329 status))
@@ -3041,16 +3344,7 @@ This will break if COMMAND prints a newline, followed by the value of
3041(defun tramp-handle-file-local-copy (filename) 3344(defun tramp-handle-file-local-copy (filename)
3042 "Like `file-local-copy' for tramp files." 3345 "Like `file-local-copy' for tramp files."
3043 (with-parsed-tramp-file-name filename nil 3346 (with-parsed-tramp-file-name filename nil
3044 (let ((output-buf (get-buffer-create "*tramp output*")) 3347 (let ((tramp-buf (tramp-get-buffer multi-method method user host))
3045 (tramp-buf (tramp-get-buffer multi-method method user host))
3046 (copy-program (tramp-get-method-parameter
3047 multi-method
3048 (tramp-find-method multi-method method user host)
3049 user host 'tramp-copy-program))
3050 (copy-args (tramp-get-method-parameter
3051 multi-method
3052 (tramp-find-method multi-method method user host)
3053 user host 'tramp-copy-args))
3054 ;; We used to bind the following as late as possible. 3348 ;; We used to bind the following as late as possible.
3055 ;; loc-enc and loc-dec were bound directly before the if 3349 ;; loc-enc and loc-dec were bound directly before the if
3056 ;; statement that checks them. But the functions 3350 ;; statement that checks them. But the functions
@@ -3066,37 +3360,12 @@ This will break if COMMAND prints a newline, followed by the value of
3066 (error "Cannot make local copy of non-existing file `%s'" 3360 (error "Cannot make local copy of non-existing file `%s'"
3067 filename)) 3361 filename))
3068 (setq tmpfil (tramp-make-temp-file)) 3362 (setq tmpfil (tramp-make-temp-file))
3069 (cond (copy-program 3363
3070 ;; The following should be changed. We need a more general 3364
3071 ;; mechanism to parse extra host args. 3365 (cond ((tramp-method-out-of-band-p multi-method method user host)
3072 (when (string-match "\\([^#]*\\)#\\(.*\\)" host) 3366 ;; `copy-file' handles out-of-band methods
3073 (setq copy-args (cons "-p" (cons (match-string 2 host) 3367 (copy-file filename tmpfil t t))
3074 rsh-args))) 3368
3075 (setq host (match-string 1 host)))
3076 ;; Use rcp-like program for file transfer.
3077 (tramp-message-for-buffer
3078 multi-method method user host
3079 5 "Fetching %s to tmp file %s..." filename tmpfil)
3080 (save-excursion (set-buffer output-buf) (erase-buffer))
3081 (unless (equal
3082 0
3083 (apply #'call-process
3084 copy-program
3085 nil output-buf nil
3086 (append copy-args
3087 (list
3088 (tramp-make-copy-program-file-name
3089 user host
3090 (tramp-shell-quote-argument localname))
3091 tmpfil))))
3092 (pop-to-buffer output-buf)
3093 (error
3094 (concat "tramp-handle-file-local-copy: `%s' didn't work, "
3095 "see buffer `%s' for details")
3096 copy-program output-buf))
3097 (tramp-message-for-buffer
3098 multi-method method user host
3099 5 "Fetching %s to tmp file %s...done" filename tmpfil))
3100 ((and rem-enc rem-dec) 3369 ((and rem-enc rem-dec)
3101 ;; Use inline encoding for file transfer. 3370 ;; Use inline encoding for file transfer.
3102 (save-excursion 3371 (save-excursion
@@ -3225,14 +3494,6 @@ This will break if COMMAND prints a newline, followed by the value of
3225 (error "File not overwritten"))) 3494 (error "File not overwritten")))
3226 (with-parsed-tramp-file-name filename nil 3495 (with-parsed-tramp-file-name filename nil
3227 (let ((curbuf (current-buffer)) 3496 (let ((curbuf (current-buffer))
3228 (copy-program (tramp-get-method-parameter
3229 multi-method
3230 (tramp-find-method multi-method method user host)
3231 user host 'tramp-copy-program))
3232 (copy-args (tramp-get-method-parameter
3233 multi-method
3234 (tramp-find-method multi-method method user host)
3235 user host 'tramp-copy-args))
3236 (rem-enc (tramp-get-remote-encoding multi-method method user host)) 3497 (rem-enc (tramp-get-remote-encoding multi-method method user host))
3237 (rem-dec (tramp-get-remote-decoding multi-method method user host)) 3498 (rem-dec (tramp-get-remote-decoding multi-method method user host))
3238 (loc-enc (tramp-get-local-encoding multi-method method user host)) 3499 (loc-enc (tramp-get-local-encoding multi-method method user host))
@@ -3267,44 +3528,10 @@ This will break if COMMAND prints a newline, followed by the value of
3267 ;; decoding command must be specified. However, if the method 3528 ;; decoding command must be specified. However, if the method
3268 ;; _also_ specifies an encoding function, then that is used for 3529 ;; _also_ specifies an encoding function, then that is used for
3269 ;; encoding the contents of the tmp file. 3530 ;; encoding the contents of the tmp file.
3270 (cond (copy-program 3531 (cond ((tramp-method-out-of-band-p multi-method method user host)
3271 ;; The following should be changed. We need a more general 3532 ;; `copy-file' handles out-of-band methods
3272 ;; mechanism to parse extra host args. 3533 (copy-file tmpfil filename t t))
3273 (when (string-match "\\([^#]*\\)#\\(.*\\)" host) 3534
3274 (setq copy-args (cons "-p" (cons (match-string 2 host)
3275 rsh-args)))
3276 (setq host (match-string 1 host)))
3277
3278 ;; use rcp-like program for file transfer
3279 (let ((argl (append copy-args
3280 (list
3281 tmpfil
3282 (tramp-make-copy-program-file-name
3283 user host
3284 (tramp-shell-quote-argument localname))))))
3285 (tramp-message-for-buffer
3286 multi-method method user host
3287 6 "Writing tmp file using `%s'..." copy-program)
3288 (save-excursion (set-buffer trampbuf) (erase-buffer))
3289 (when tramp-debug-buffer
3290 (save-excursion
3291 (set-buffer (tramp-get-debug-buffer multi-method
3292 method user host))
3293 (goto-char (point-max))
3294 (tramp-insert-with-face
3295 'bold (format "$ %s %s\n" copy-program
3296 (mapconcat 'identity argl " ")))))
3297 (unless (equal 0
3298 (apply #'call-process
3299 copy-program nil trampbuf nil argl))
3300 (pop-to-buffer trampbuf)
3301 (error
3302 "Cannot write region to file `%s', command `%s' failed"
3303 filename copy-program))
3304 (tramp-message-for-buffer
3305 multi-method method user host
3306 6 "Transferring file using `%s'...done"
3307 copy-program)))
3308 ((and rem-enc rem-dec) 3535 ((and rem-enc rem-dec)
3309 ;; Use inline file transfer 3536 ;; Use inline file transfer
3310 (let ((tmpbuf (get-buffer-create " *tramp file transfer*"))) 3537 (let ((tmpbuf (get-buffer-create " *tramp file transfer*")))
@@ -3319,7 +3546,8 @@ This will break if COMMAND prints a newline, followed by the value of
3319 (progn 3546 (progn
3320 (tramp-message-for-buffer 3547 (tramp-message-for-buffer
3321 multi-method method user host 3548 multi-method method user host
3322 6 "Encoding region using function...") 3549 6 "Encoding region using function `%s'..."
3550 (symbol-name loc-enc))
3323 (insert-file-contents-literally tmpfil) 3551 (insert-file-contents-literally tmpfil)
3324 ;; CCC. The following `let' is a workaround for 3552 ;; CCC. The following `let' is a workaround for
3325 ;; the base64.el that comes with pgnus-0.84. If 3553 ;; the base64.el that comes with pgnus-0.84. If
@@ -3685,11 +3913,12 @@ necessary anymore."
3685;; shouldn't have partial tramp file name syntax. Maybe another variable should 3913;; shouldn't have partial tramp file name syntax. Maybe another variable should
3686;; be introduced overwriting this check in such cases. Or we change tramp 3914;; be introduced overwriting this check in such cases. Or we change tramp
3687;; file name syntax in order to avoid ambiguities, like in XEmacs ... 3915;; file name syntax in order to avoid ambiguities, like in XEmacs ...
3688;; In case of XEmacs it can be always true (and wouldn't be necessary). 3916;; In case of non unified file names it can be always true (and wouldn't be
3917;; necessary, because there are different regexp).
3689(defun tramp-completion-mode (file) 3918(defun tramp-completion-mode (file)
3690 "Checks whether method / user name / host name completion is active." 3919 "Checks whether method / user name / host name completion is active."
3691 (cond 3920 (cond
3692 ((featurep 'xemacs) t) 3921 ((not tramp-unified-filenames) t)
3693 ((string-match "^/.*:.*:$" file) nil) 3922 ((string-match "^/.*:.*:$" file) nil)
3694 ((string-match 3923 ((string-match
3695 (concat tramp-prefix-regexp 3924 (concat tramp-prefix-regexp
@@ -3697,11 +3926,21 @@ necessary anymore."
3697 file) 3926 file)
3698 (member (match-string 1 file) (mapcar 'car tramp-methods))) 3927 (member (match-string 1 file) (mapcar 'car tramp-methods)))
3699 ((or (equal last-input-event 'tab) 3928 ((or (equal last-input-event 'tab)
3929 ;; Emacs
3700 (and (integerp last-input-event) 3930 (and (integerp last-input-event)
3701 (not (event-modifiers last-input-event)) 3931 (not (event-modifiers last-input-event))
3702 (or (char-equal last-input-event ?\?) 3932 (or (char-equal last-input-event ?\?)
3703 (char-equal last-input-event ?\t) ; handled by 'tab already? 3933 (char-equal last-input-event ?\t) ; handled by 'tab already?
3704 (char-equal last-input-event ?\ )))) 3934 (char-equal last-input-event ?\ )))
3935 ;; XEmacs
3936 (and (featurep 'xemacs)
3937 (not (event-modifiers last-input-event))
3938 (or (char-equal
3939 (funcall 'event-to-character last-input-event) ?\?)
3940 (char-equal
3941 (funcall 'event-to-character last-input-event) ?\t)
3942 (char-equal
3943 (funcall 'event-to-character last-input-event) ?\ ))))
3705 t))) 3944 t)))
3706 3945
3707(defun tramp-completion-handle-file-exists-p (filename) 3946(defun tramp-completion-handle-file-exists-p (filename)
@@ -4050,6 +4289,35 @@ User is always nil."
4050 (forward-line 1)) 4289 (forward-line 1))
4051 result)) 4290 result))
4052 4291
4292(defun tramp-parse-shostkeys (dirname)
4293 "Return a list of (user host) tuples allowed to access.
4294User is always nil."
4295
4296 (let ((regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
4297 (files (when (file-directory-p dirname) (directory-files dirname)))
4298 result)
4299
4300 (while files
4301 (when (string-match regexp (car files))
4302 (push (list nil (match-string 1 (car files))) result))
4303 (setq files (cdr files)))
4304 result))
4305
4306(defun tramp-parse-sknownhosts (dirname)
4307 "Return a list of (user host) tuples allowed to access.
4308User is always nil."
4309
4310 (let ((regexp (concat "^\\(" tramp-host-regexp
4311 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
4312 (files (when (file-directory-p dirname) (directory-files dirname)))
4313 result)
4314
4315 (while files
4316 (when (string-match regexp (car files))
4317 (push (list nil (match-string 1 (car files))) result))
4318 (setq files (cdr files)))
4319 result))
4320
4053(defun tramp-parse-hosts (filename) 4321(defun tramp-parse-hosts (filename)
4054 "Return a list of (user host) tuples allowed to access. 4322 "Return a list of (user host) tuples allowed to access.
4055User is always nil." 4323User is always nil."
@@ -4206,14 +4474,29 @@ hosts, or files, disagree."
4206 (or switch "") 4474 (or switch "")
4207 (tramp-shell-quote-argument localname2)))))) 4475 (tramp-shell-quote-argument localname2))))))
4208 4476
4477(defun tramp-touch (file time)
4478 "Set the last-modified timestamp of the given file.
4479TIME is an Emacs internal time value as returned by `current-time'."
4480 (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time)))
4481 (with-parsed-tramp-file-name file nil
4482 (let ((buf (tramp-get-buffer multi-method method user host)))
4483 (unless (zerop (tramp-send-command-and-check
4484 multi-method method user host
4485 (format "touch -t %s %s"
4486 touch-time
4487 localname)))
4488 (pop-to-buffer buf)
4489 (error "tramp-touch: touch failed, see buffer `%s' for details"
4490 buf))))))
4491
4209(defun tramp-buffer-name (multi-method method user host) 4492(defun tramp-buffer-name (multi-method method user host)
4210 "A name for the connection buffer for USER at HOST using METHOD." 4493 "A name for the connection buffer for USER at HOST using METHOD."
4211 (if multi-method 4494 (if multi-method
4212 (tramp-buffer-name-multi-method "tramp" multi-method method user host) 4495 (tramp-buffer-name-multi-method "tramp" multi-method method user host)
4213 (let ((method (tramp-find-method multi-method method user host))) 4496 (let ((method (tramp-find-method multi-method method user host)))
4214 (if user 4497 (if user
4215 (format "*tramp/%s %s@%s*" method user host)) 4498 (format "*tramp/%s %s@%s*" method user host)
4216 (format "*tramp/%s %s*" method host)))) 4499 (format "*tramp/%s %s*" method host)))))
4217 4500
4218(defun tramp-buffer-name-multi-method (prefix multi-method method user host) 4501(defun tramp-buffer-name-multi-method (prefix multi-method method user host)
4219 "A name for the multi method connection buffer. 4502 "A name for the multi method connection buffer.
@@ -4482,11 +4765,6 @@ Returns nil if none was found, else the command is returned."
4482(defun tramp-action-password (p multi-method method user host) 4765(defun tramp-action-password (p multi-method method user host)
4483 "Query the user for a password." 4766 "Query the user for a password."
4484 (let ((pw-prompt (match-string 0))) 4767 (let ((pw-prompt (match-string 0)))
4485 (when (tramp-method-out-of-band-p multi-method method user host)
4486 (kill-process (get-buffer-process (current-buffer)))
4487 (error (concat "Out of band method `%s' not applicable "
4488 "for remote shell asking for a password")
4489 method))
4490 (tramp-message 9 "Sending password") 4768 (tramp-message 9 "Sending password")
4491 (tramp-enter-password p pw-prompt))) 4769 (tramp-enter-password p pw-prompt)))
4492 4770
@@ -4597,6 +4875,7 @@ The terminal type can be configured with `tramp-terminal-type'."
4597 p multi-method method user host actions) 4875 p multi-method method user host actions)
4598 nil))) 4876 nil)))
4599 (unless (eq exit 'ok) 4877 (unless (eq exit 'ok)
4878 (tramp-clear-passwd user host)
4600 (error "Login failed")))) 4879 (error "Login failed"))))
4601 4880
4602;; For multi-actions. 4881;; For multi-actions.
@@ -4632,6 +4911,7 @@ The terminal type can be configured with `tramp-terminal-type'."
4632 (tramp-process-one-multi-action p method user host actions) 4911 (tramp-process-one-multi-action p method user host actions)
4633 nil))) 4912 nil)))
4634 (unless (eq exit 'ok) 4913 (unless (eq exit 'ok)
4914 (tramp-clear-passwd user host)
4635 (error "Login failed")))) 4915 (error "Login failed"))))
4636 4916
4637;; Functions to execute when we have seen the remote shell prompt but 4917;; Functions to execute when we have seen the remote shell prompt but
@@ -4768,7 +5048,7 @@ arguments, and xx will be used as the host name to connect to.
4768 ;; The following should be changed. We need a more general 5048 ;; The following should be changed. We need a more general
4769 ;; mechanism to parse extra host args. 5049 ;; mechanism to parse extra host args.
4770 (when (string-match "\\([^#]*\\)#\\(.*\\)" host) 5050 (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
4771 (setq login-args (cons "-p" (cons (match-string 2 host) rsh-args))) 5051 (setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
4772 (setq host (match-string 1 host))) 5052 (setq host (match-string 1 host)))
4773 (setenv "TERM" tramp-terminal-type) 5053 (setenv "TERM" tramp-terminal-type)
4774 (let* ((default-directory (tramp-temporary-file-directory)) 5054 (let* ((default-directory (tramp-temporary-file-directory))
@@ -5308,10 +5588,7 @@ locale to C and sets up the remote shell search path."
5308 " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n" 5588 " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n"
5309 "}")) 5589 "}"))
5310 (tramp-wait-for-output) 5590 (tramp-wait-for-output)
5311 (unless (tramp-get-method-parameter 5591 (unless (tramp-method-out-of-band-p multi-method method user host)
5312 multi-method
5313 (tramp-find-method multi-method method user host)
5314 user host 'tramp-copy-program)
5315 (tramp-message 5 "Sending the Perl `mime-encode' implementations.") 5592 (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
5316 (tramp-send-string 5593 (tramp-send-string
5317 multi-method method user host 5594 multi-method method user host
@@ -5350,10 +5627,7 @@ locale to C and sets up the remote shell search path."
5350 (tramp-set-connection-property "ln" ln multi-method method user host))) 5627 (tramp-set-connection-property "ln" ln multi-method method user host)))
5351 (erase-buffer) 5628 (erase-buffer)
5352 ;; Find the right encoding/decoding commands to use. 5629 ;; Find the right encoding/decoding commands to use.
5353 (unless (tramp-get-method-parameter 5630 (unless (tramp-method-out-of-band-p multi-method method user host)
5354 multi-method
5355 (tramp-find-method multi-method method user host)
5356 user host 'tramp-copy-program)
5357 (tramp-find-inline-encoding multi-method method user host)) 5631 (tramp-find-inline-encoding multi-method method user host))
5358 ;; If encoding/decoding command are given, test to see if they work. 5632 ;; If encoding/decoding command are given, test to see if they work.
5359 ;; CCC: Maybe it would be useful to run the encoder both locally and 5633 ;; CCC: Maybe it would be useful to run the encoder both locally and
@@ -5566,11 +5840,12 @@ connection if a previous connection has died for some reason."
5566 (unless (and p (processp p) (memq (process-status p) '(run open))) 5840 (unless (and p (processp p) (memq (process-status p) '(run open)))
5567 (when (and p (processp p)) 5841 (when (and p (processp p))
5568 (delete-process p)) 5842 (delete-process p))
5569 (funcall (tramp-get-method-parameter 5843 (let ((process-connection-type tramp-process-connection-type))
5570 multi-method 5844 (funcall (tramp-get-method-parameter
5571 (tramp-find-method multi-method method user host) 5845 multi-method
5572 user host 'tramp-connection-function) 5846 (tramp-find-method multi-method method user host)
5573 multi-method method user host)))) 5847 user host 'tramp-connection-function)
5848 multi-method method user host)))))
5574 5849
5575(defun tramp-send-command 5850(defun tramp-send-command
5576 (multi-method method user host command &optional noerase neveropen) 5851 (multi-method method user host command &optional noerase neveropen)
@@ -6223,10 +6498,28 @@ this is the function `temp-directory'."
6223 6498
6224(defun tramp-read-passwd (prompt) 6499(defun tramp-read-passwd (prompt)
6225 "Read a password from user (compat function). 6500 "Read a password from user (compat function).
6226Invokes `read-passwd' if that is defined, else `ange-ftp-read-passwd'." 6501Invokes `password-read' if available, `read-passwd' else."
6227 (apply 6502 (if (functionp 'password-read)
6228 (if (fboundp 'read-passwd) #'read-passwd #'ange-ftp-read-passwd) 6503 (let* ((user (or tramp-current-user (user-login-name)))
6229 (list prompt))) 6504 (host (or tramp-current-host (system-name)))
6505 (key (concat user "@" host))
6506 (password (apply #'password-read (list prompt key))))
6507 (apply #'password-cache-add (list key password))
6508 password)
6509 (read-passwd prompt)))
6510
6511(defun tramp-clear-passwd (&optional user host)
6512 "Clear password cache for connection related to current-buffer."
6513 (interactive)
6514 (let ((filename (or buffer-file-name list-buffers-directory "")))
6515 (when (and (functionp 'password-cache-remove)
6516 (or (and user host) (tramp-tramp-file-p filename)))
6517 (let* ((v (when (tramp-tramp-file-p filename)
6518 (tramp-dissect-file-name filename)))
6519 (luser (or user (tramp-file-name-user v) (user-login-name)))
6520 (lhost (or host (tramp-file-name-host v) (system-name)))
6521 (key (concat luser "@" lhost)))
6522 (apply #'password-cache-remove (list key))))))
6230 6523
6231(defun tramp-time-diff (t1 t2) 6524(defun tramp-time-diff (t1 t2)
6232 "Return the difference between the two times, in seconds. 6525 "Return the difference between the two times, in seconds.
@@ -6477,7 +6770,6 @@ report.
6477 6770
6478;;; TODO: 6771;;; TODO:
6479 6772
6480;; * tramp-copy-keep-date-arg is not used!
6481;; * Allow putting passwords in the filename. 6773;; * Allow putting passwords in the filename.
6482;; This should be implemented via a general mechanism to add 6774;; This should be implemented via a general mechanism to add
6483;; parameters in filenames. There is currently a kludge for 6775;; parameters in filenames. There is currently a kludge for
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 72c8c97899a..b3223d7a46e 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -30,7 +30,7 @@
30;; are auto-frobbed from configure.ac, so you should edit that file and run 30;; are auto-frobbed from configure.ac, so you should edit that file and run
31;; "autoconf && ./configure" to change them. 31;; "autoconf && ./configure" to change them.
32 32
33(defconst tramp-version "2.0.38" 33(defconst tramp-version "2.0.39"
34 "This version of Tramp.") 34 "This version of Tramp.")
35 35
36(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org" 36(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index ec96109e0a0..9c341c5181c 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 5;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
6;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Time-stamp: <2004/02/23 22:38:59 vinicius> 7;; Time-stamp: <2004/02/28 17:40:41 vinicius>
8;; Keywords: wp, ebnf, PostScript 8;; Keywords: wp, ebnf, PostScript
9;; Version: 1.0 9;; Version: 1.0
10 10
@@ -41,6 +41,8 @@
41;; ----------- 41;; -----------
42;; 42;;
43;; See the URL: 43;; See the URL:
44;; `http://www.ietf.org/rfc/rfc2234.txt'
45;; or
44;; `http://www.faqs.org/rfcs/rfc2234.html' 46;; `http://www.faqs.org/rfcs/rfc2234.html'
45;; or 47;; or
46;; `http://www.rnp.br/ietf/rfc/rfc2234.txt' 48;; `http://www.rnp.br/ietf/rfc/rfc2234.txt'
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 41bd0cd0d49..4f0ef6099c8 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -5,7 +5,7 @@
5 5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Time-stamp: <2004/02/22 14:25:06 vinicius> 8;; Time-stamp: <2004/02/28 18:25:52 vinicius>
9;; Keywords: wp, ebnf, PostScript 9;; Keywords: wp, ebnf, PostScript
10;; Version: 1.8 10;; Version: 1.8
11 11
@@ -54,7 +54,10 @@
54;; C D sequence (C occurs before D) 54;; C D sequence (C occurs before D)
55;; C | D alternative (C or D occurs) 55;; C | D alternative (C or D occurs)
56;; A - B exception (A excluding B, B without any non-terminal) 56;; A - B exception (A excluding B, B without any non-terminal)
57;; n * A repetition (A repeats n (integer) times) 57;; n * A repetition (A repeats at least n (integer) times)
58;; n * n A repetition (A repeats exactly n (integer) times)
59;; n * m A repetition (A repeats at least n (integer) and at most
60;; m (integer) times)
58;; (C) group (expression C is grouped together) 61;; (C) group (expression C is grouped together)
59;; [C] optional (C may or not occurs) 62;; [C] optional (C may or not occurs)
60;; C+ one or more occurrences of C 63;; C+ one or more occurrences of C
@@ -78,7 +81,7 @@
78;; 81;;
79;; exception = repeat [ "-" repeat]. ;; exception 82;; exception = repeat [ "-" repeat]. ;; exception
80;; 83;;
81;; repeat = [ integer "*" ] term. ;; repetition 84;; repeat = [ integer "*" [ integer ]] term. ;; repetition
82;; 85;;
83;; term = factor 86;; term = factor
84;; | [factor] "+" ;; one-or-more 87;; | [factor] "+" ;; one-or-more
@@ -96,14 +99,30 @@
96;; . 99;; .
97;; 100;;
98;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+". 101;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
102;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
103;; ;; and lower), 8-bit accentuated characters,
104;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
105;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
99;; 106;;
100;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+". 107;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
108;; ;; that is, a valid terminal accepts any printable character (including
109;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
110;; ;; terminal. Also, accepts escaped characters, that is, a character
111;; ;; pair starting with `\' followed by a printable character, for
112;; ;; example: \", \\.
101;; 113;;
102;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*". 114;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
115;; ;; that is, a valid special accepts any printable character (including
116;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
117;; ;; delimit a special.
103;; 118;;
104;; integer = "[0-9]+". 119;; integer = "[0-9]+".
120;; ;; that is, an integer is a sequence of one or more decimal digits.
105;; 121;;
106;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n". 122;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
123;; ;; that is, a comment starts with the character `;' and terminates at end
124;; ;; of line. Also, it only accepts printable characters (including 8-bit
125;; ;; accentuated characters) and tabs.
107;; 126;;
108;; 127;;
109;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 128;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -234,15 +253,20 @@
234 )))) 253 ))))
235 254
236 255
237;;; repeat = [ integer "*" ] term. 256;;; repeat = [ integer "*" [ integer ]] term.
238 257
239(defun ebnf-repeat (token) 258(defun ebnf-repeat (token)
240 (if (not (eq token 'integer)) 259 (if (not (eq token 'integer))
241 (ebnf-term token) 260 (ebnf-term token)
242 (let ((times ebnf-bnf-lex)) 261 (let ((times ebnf-bnf-lex)
262 upper)
243 (or (eq (ebnf-bnf-lex) 'repeat) 263 (or (eq (ebnf-bnf-lex) 'repeat)
244 (error "Missing `*'")) 264 (error "Missing `*'"))
245 (ebnf-token-repeat times (ebnf-term (ebnf-bnf-lex)))))) 265 (setq token (ebnf-bnf-lex))
266 (when (eq token 'integer)
267 (setq upper ebnf-bnf-lex
268 token (ebnf-bnf-lex)))
269 (ebnf-token-repeat times (ebnf-term token) upper))))
246 270
247 271
248;;; term = factor 272;;; term = factor
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index d13ed80fe5c..96ec53ac501 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -5,7 +5,7 @@
5 5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Time-stamp: <2004/02/25 20:17:43 vinicius> 8;; Time-stamp: <2004/02/29 14:06:59 vinicius>
9;; Keywords: wp, ebnf, PostScript 9;; Keywords: wp, ebnf, PostScript
10;; Version: 4.0 10;; Version: 4.0
11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
@@ -28,7 +28,7 @@
28;; Boston, MA 02111-1307, USA. 28;; Boston, MA 02111-1307, USA.
29 29
30(defconst ebnf-version "4.0" 30(defconst ebnf-version "4.0"
31 "ebnf2ps.el, v 4.0 <2004/02/24 vinicius> 31 "ebnf2ps.el, v 4.0 <2004/02/28 vinicius>
32 32
33Vinicius's last change version. When reporting bugs, please also 33Vinicius's last change version. When reporting bugs, please also
34report the version of Emacs, if any, that ebnf2ps was running with. 34report the version of Emacs, if any, that ebnf2ps was running with.
@@ -70,8 +70,8 @@ Please send all bug fixes and enhancements to
70;; Using ebnf2ps 70;; Using ebnf2ps
71;; ------------- 71;; -------------
72;; 72;;
73;; ebnf2ps provides six commands for generating PostScript syntactic chart 73;; ebnf2ps provides the following commands for generating PostScript syntactic
74;; images of Emacs buffers: 74;; chart images of Emacs buffers:
75;; 75;;
76;; ebnf-print-directory 76;; ebnf-print-directory
77;; ebnf-print-file 77;; ebnf-print-file
@@ -193,7 +193,10 @@ Please send all bug fixes and enhancements to
193;; C D sequence (C occurs before D) 193;; C D sequence (C occurs before D)
194;; C | D alternative (C or D occurs) 194;; C | D alternative (C or D occurs)
195;; A - B exception (A excluding B, B without any non-terminal) 195;; A - B exception (A excluding B, B without any non-terminal)
196;; n * A repetition (A repeats n (integer) times) 196;; n * A repetition (A repeats at least n (integer) times)
197;; n * n A repetition (A repeats exactly n (integer) times)
198;; n * m A repetition (A repeats at least n (integer) and at most
199;; m (integer) times)
197;; (C) group (expression C is grouped together) 200;; (C) group (expression C is grouped together)
198;; [C] optional (C may or not occurs) 201;; [C] optional (C may or not occurs)
199;; C+ one or more occurrences of C 202;; C+ one or more occurrences of C
@@ -217,7 +220,7 @@ Please send all bug fixes and enhancements to
217;; 220;;
218;; exception = repeat [ "-" repeat]. ;; exception 221;; exception = repeat [ "-" repeat]. ;; exception
219;; 222;;
220;; repeat = [ integer "*" ] term. ;; repetition 223;; repeat = [ integer "*" [ integer ]] term. ;; repetition
221;; 224;;
222;; term = factor 225;; term = factor
223;; | [factor] "+" ;; one-or-more 226;; | [factor] "+" ;; one-or-more
@@ -302,7 +305,7 @@ Please send all bug fixes and enhancements to
302;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. 305;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
303;; 306;;
304;; `abnf' ebnf2ps recognizes the syntax described in the URL: 307;; `abnf' ebnf2ps recognizes the syntax described in the URL:
305;; `http://www.faqs.org/rfcs/rfc2234.html' 308;; `http://www.ietf.org/rfc/rfc2234.txt'
306;; ("Augmented BNF for Syntax Specifications: ABNF"). 309;; ("Augmented BNF for Syntax Specifications: ABNF").
307;; 310;;
308;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: 311;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -514,6 +517,12 @@ Please send all bug fixes and enhancements to
514;; 517;;
515;; `ebnf-setup' returns the current setup. 518;; `ebnf-setup' returns the current setup.
516;; 519;;
520;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
521;; given directory.
522;;
523;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
524;; file.
525;;
517;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current 526;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
518;; buffer. 527;; buffer.
519;; 528;;
@@ -522,8 +531,9 @@ Please send all bug fixes and enhancements to
522;; 531;;
523;; `ebnf-customize' activates a customization buffer for ebnf2ps options. 532;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
524;; 533;;
525;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound 534;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
526;; to keys in the same way as `ebnf-' commands. 535;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
536;; way as `ebnf-' commands.
527;; 537;;
528;; 538;;
529;; Hooks 539;; Hooks
@@ -1654,7 +1664,7 @@ Valid values are:
1654 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. 1664 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1655 1665
1656 `abnf' ebnf2ps recognizes the syntax described in the URL: 1666 `abnf' ebnf2ps recognizes the syntax described in the URL:
1657 `http://www.faqs.org/rfcs/rfc2234.html' 1667 `http://www.ietf.org/rfc/rfc2234.txt'
1658 (\"Augmented BNF for Syntax Specifications: ABNF\"). 1668 (\"Augmented BNF for Syntax Specifications: ABNF\").
1659 1669
1660 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: 1670 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -2061,6 +2071,34 @@ WARNING: It's *NOT* asked any confirmation to override an existing file."
2061 2071
2062 2072
2063;;;###autoload 2073;;;###autoload
2074(defun ebnf-syntax-directory (&optional directory)
2075 "Does a syntactic analysis of the files in DIRECTORY.
2076
2077If DIRECTORY is nil, it's used `default-directory'.
2078
2079The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2080processed.
2081
2082See also `ebnf-syntax-buffer'."
2083 (interactive
2084 (list (read-file-name "Directory containing EBNF files (syntax): "
2085 nil default-directory)))
2086 (ebnf-directory 'ebnf-syntax-buffer directory))
2087
2088
2089;;;###autoload
2090(defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done)
2091 "Does a syntactic analysis of the FILE.
2092
2093If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2094killed after syntax checking.
2095
2096See also `ebnf-syntax-buffer'."
2097 (interactive "fEBNF file to check syntax: ")
2098 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done))
2099
2100
2101;;;###autoload
2064(defun ebnf-syntax-buffer () 2102(defun ebnf-syntax-buffer ()
2065 "Does a syntactic analysis of the current buffer." 2103 "Does a syntactic analysis of the current buffer."
2066 (interactive) 2104 (interactive)
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
new file mode 100644
index 00000000000..cc692c1f975
--- /dev/null
+++ b/lisp/thumbs.el
@@ -0,0 +1,737 @@
1;;; thumbs.el --- Thumbnails previewer for images files
2;;;
3;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
4;;
5;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some time
6;; The peoples at #emacs@freenode.net for numerous help
7;; RMS for emacs and the GNU project.
8;;
9;; Keywords: Multimedia
10
11(defconst thumbs-version "2.0")
12
13;; This file is part of GNU Emacs.
14
15;; GNU Emacs is free software; you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation; either version 2, or (at your option)
18;; any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs; see the file COPYING. If not, write to the
27;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28;; Boston, MA 02111-1307, USA.
29
30;;; Commentary:
31
32;; This package create two new mode: thumbs-mode and
33;; thumbs-view-image-mode. It is used for images browsing and viewing
34;; from within emacs. Minimal image manipulation functions are also
35;; available via external programs.
36;;
37;; The 'convert' program from 'ImageMagick'
38;; [URL:http://www.imagemagick.org/] is required.
39;;
40;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41;; CHANGELOG
42;;
43;; This is version 2.0
44;;
45;; USAGE
46;;
47;; Type M-x thumbs RET DIR RET to view the directory DIR in Thumbs mode.
48;; That should be a directory containing image files.
49;; from dired, C-t m enter in thumbs-mode with all marked files
50;; C-t a enter in thumbs-mode with all files in current-directory
51;; In thumbs-mode, pressing <return> on a image will bring you in image view mode
52;; for that image. C-h m will give you a list of available keybinding.
53
54;;; History:
55;;
56
57;;; Code:
58
59(require 'dired)
60
61;; Abort if in-line imaging isn't supported (i.e. Emacs-20.7)
62
63(when (not (display-images-p))
64 (error "Your Emacs version (%S) doesn't support in-line images,
65was not compiled with image support or is run in console mode.
66Upgrade to Emacs 21.1 or newer, compile it with image support
67or use a window-system"
68 emacs-version))
69
70;; CUSTOMIZATIONS
71
72(defgroup thumbs nil
73 "Thumbnails previewer."
74 :group 'multimedia)
75
76(defcustom thumbs-thumbsdir
77 (expand-file-name "~/.emacs-thumbs")
78 "*Directory to store thumbnails."
79 :type 'directory
80 :group 'thumbs)
81
82(defcustom thumbs-geometry "100x100"
83 "*Size of thumbnails."
84 :type 'string
85 :group 'thumbs)
86
87(defcustom thumbs-per-line 5
88 "*Number of thumbnails per line to show in directory."
89 :type 'string
90 :group 'thumbs)
91
92(defcustom thumbs-thumbsdir-max-size 50000000
93 "Max size for thumbnails directory.
94When it reach that size (in bytes), a warning is send."
95 :type 'string
96 :group 'thumbs)
97
98(defcustom thumbs-conversion-program
99 (if (equal 'windows-nt system-type)
100 "convert.exe"
101 (or (executable-find "convert")
102 "/usr/X11R6/bin/convert"))
103 "*Name of conversion program for thumbnails generation.
104It must be 'convert'."
105 :type 'string
106 :group 'thumbs)
107
108(defcustom thumbs-setroot-command
109 "xloadimage -onroot -fullscreen *"
110 "Command to set the root window."
111 :type 'string
112 :group 'thumbs)
113
114(defcustom thumbs-relief 5
115 "*Size of button-like border around thumbnails."
116 :type 'string
117 :group 'thumbs)
118
119(defcustom thumbs-margin 2
120 "*Size of the margin around thumbnails.
121This is where you see the cursor."
122 :type 'string
123 :group 'thumbs)
124
125(defcustom thumbs-thumbsdir-auto-clean t
126 "If set, delete older file in the thumbnails directory.
127Deletion is done at load time when the directory size is bigger
128than 'thumbs-thumbsdir-max-size'."
129 :type 'boolean
130 :group 'thumbs)
131
132(defcustom thumbs-image-resizing-step 10
133 "Step by wich to resize image."
134 :type 'string
135 :group 'thumbs)
136
137(defcustom thumbs-temp-dir
138 "/tmp/"
139 "Temporary directory to use.
140Leaving it to default '/tmp/' can let another user
141see some of your images."
142 :type 'directory
143 :group 'thumbs)
144
145(defcustom thumbs-temp-prefix "emacsthumbs"
146 "Prefix to add to temp files."
147 :type 'string
148 :group 'thumbs)
149
150;; Initialize some variable, for later use.
151(defvar thumbs-temp-file
152 (concat thumbs-temp-dir thumbs-temp-prefix)
153 "Temporary filesname for images.")
154
155(defvar thumbs-current-tmp-filename
156 nil
157 "Temporary filename of current image.")
158(defvar thumbs-current-image-filename
159 nil
160 "Filename of current image.")
161(defvar thumbs-current-image-size
162 nil
163 "Size of current image.")
164(defvar thumbs-image-num
165 nil
166 "Number of current image.")
167(defvar thumbs-current-dir
168 nil
169 "Current directory.")
170(defvar thumbs-markedL
171 nil
172 "List of marked files.")
173
174;; Make sure auto-image-file-mode is ON.
175(auto-image-file-mode t)
176
177;; Create the thumbs directory if it does not exists.
178(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir))
179
180(when (not (file-directory-p thumbs-thumbsdir))
181 (progn
182 (make-directory thumbs-thumbsdir)
183 (message "Creating thumbnails directory")))
184
185(when (not (fboundp 'ignore-errors))
186 (defmacro ignore-errors (&rest body)
187 "Execute FORMS; if anz error occurs, return nil.
188Otherwise, return result of last FORM."
189 (let ((err (thumbs-gensym)))
190 (list 'condition-case err (cons 'progn body) '(error nil)))))
191
192(when (not (fboundp 'time-less-p))
193 (defun time-less-p (t1 t2)
194 "Say whether time T1 is less than time T2."
195 (or (< (car t1) (car t2))
196 (and (= (car t1) (car t2))
197 (< (nth 1 t1) (nth 1 t2))))))
198
199(when (not (fboundp 'caddar))
200 (defun caddar (x)
201 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
202 (car (cdr (cdr (car x))))))
203
204(defvar thumbs-gensym-counter 0)
205
206(defun thumbs-gensym (&optional arg)
207 "Generate a new uninterned symbol.
208The name is made by appending a number to PREFIX, default \"Thumbs\"."
209 (let ((prefix (if (stringp arg) arg "Thumbs"))
210 (num (if (integerp arg) arg
211 (prog1
212 thumbs-gensym-counter
213 (setq thumbs-gensym-counter (1+ thumbs-gensym-counter))))))
214 (make-symbol (format "%s%d" prefix num))))
215
216(defun thumbs-cleanup-thumbsdir ()
217 "Clean the thumbnails directory.
218If the total size of all files in 'thumbs-thumbsdir' is bigger than
219'thumbs-thumbsdir-max-size', files are deleted until the max size is
220reached."
221 (let* ((filesL
222 (sort
223 (mapcar
224 (lambda (f)
225 (let ((fattribsL (file-attributes f)))
226 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f)))
227 (directory-files thumbs-thumbsdir t (image-file-name-regexp)))
228 '(lambda (l1 l2) (time-less-p (car l1)(car l2)))))
229 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL))))
230 (while (> dirsize thumbs-thumbsdir-max-size)
231 (progn
232 (message "Deleting file %s" (caddar filesL)))
233 (delete-file (caddar filesL))
234 (setq dirsize (- dirsize (cadar filesL)))
235 (setq filesL (cdr filesL)))))
236
237;; Check the thumbsnail directory size and clean it if necessary.
238(when thumbs-thumbsdir-auto-clean
239 (thumbs-cleanup-thumbsdir))
240
241(defun thumbs-call-convert (filein fileout action
242 &optional arg output-format action-prefix)
243 "Call the convert program.
244FILEIN is the input file,
245FILEOUT is the output file,
246ACTION is the command to send to convert.
247Optional argument are:
248ARG any arguments to the ACTION command,
249OUTPUT-FORMAT is the file format to output, default is jpeg
250ACTION-PREFIX is the symbol to place before the ACTION command
251 (default to '-' but can sometime be '+')."
252 (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
253 thumbs-conversion-program
254 (or action-prefix "-")
255 action
256 (or arg "")
257 filein
258 (or output-format "jpeg")
259 fileout)))
260 (shell-command command)))
261
262(defun thumbs-increment-image-size-element (n d)
263 "Increment number N by D percent."
264 (round (+ n (/ (* d n) 100))))
265
266(defun thumbs-decrement-image-size-element (n d)
267 "Decrement number N by D percent."
268 (round (- n (/ (* d n) 100))))
269
270(defun thumbs-increment-image-size (s)
271 "Increment S (a cons of width x heigh)."
272 (cons
273 (thumbs-increment-image-size-element (car s)
274 thumbs-image-resizing-step)
275 (thumbs-increment-image-size-element (cdr s)
276 thumbs-image-resizing-step)))
277
278(defun thumbs-decrement-image-size (s)
279 "Decrement S (a cons of width x heigh)."
280 (cons
281 (thumbs-decrement-image-size-element (car s)
282 thumbs-image-resizing-step)
283 (thumbs-decrement-image-size-element (cdr s)
284 thumbs-image-resizing-step)))
285
286(defun thumbs-resize-image (&optional increment size)
287 "Resize image in current buffer.
288if INCREMENT is set, make the image bigger, else smaller.
289Or, alternatively, a SIZE may be specified."
290 (interactive)
291 ;; cleaning of old temp file
292 (ignore-errors
293 (apply 'delete-file
294 (directory-files
295 thumbs-temp-dir t
296 thumbs-temp-prefix)))
297 (let ((buffer-read-only nil)
298 (x (if size
299 size
300 (if increment
301 (thumbs-increment-image-size
302 thumbs-current-image-size)
303 (thumbs-decrement-image-size
304 thumbs-current-image-size))))
305 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym))))
306 (erase-buffer)
307 (thumbs-call-convert thumbs-current-image-filename
308 tmp "sample"
309 (concat (number-to-string (car x)) "x"
310 (number-to-string (cdr x))))
311 (thumbs-insert-image tmp 'jpeg 0)
312 (setq thumbs-current-tmp-filename tmp)))
313
314(defun thumbs-resize-interactive (width height)
315 "Resize Image interactively to specified WIDTH and HEIGHT."
316 (interactive "nWidth: \nnHeight: ")
317 (thumbs-resize-image nil (cons width height)))
318
319(defun thumbs-resize-image-size-down ()
320 "Resize image (smaller)."
321 (interactive)
322 (thumbs-resize-image nil))
323
324(defun thumbs-resize-image-size-up ()
325 "Resize image (bigger)."
326 (interactive)
327 (thumbs-resize-image t))
328
329(defun thumbs-subst-char-in-string (orig rep string)
330 "Replace occurrences of character ORIG with character REP in STRING.
331Return the resulting (new) string. -- (defun borowed to Dave Love)"
332 (let ((string (copy-sequence string))
333 (l (length string))
334 (i 0))
335 (while (< i l)
336 (if (= (aref string i) orig)
337 (aset string i rep))
338 (setq i (1+ i)))
339 string))
340
341(defun thumbs-thumbname (img)
342 "Return a thumbnail name for the image IMG."
343 (concat thumbs-thumbsdir "/"
344 (thumbs-subst-char-in-string
345 ?\ ?\_
346 (apply
347 'concat
348 (split-string
349 (expand-file-name img) "/")))))
350
351(defun thumbs-make-thumb (img)
352 "Create the thumbnail for IMG."
353 (let* ((fn (expand-file-name img))
354 (tn (thumbs-thumbname img)))
355 (if (or (not (file-exists-p tn))
356 (not (equal (thumbs-file-size tn) thumbs-geometry)))
357 (thumbs-call-convert fn tn "sample" thumbs-geometry))
358 tn))
359
360(defun thumbs-image-type (img)
361 "Return image type from filename IMG."
362 (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg)
363 ((string-match ".*\\.xpm\\'" img) 'xpm)
364 ((string-match ".*\\.xbm\\'" img) 'xbm)
365 ((string-match ".*\\.gif\\'" img) 'gif)
366 ((string-match ".*\\.bmp\\'" img) 'bmp)
367 ((string-match ".*\\.png\\'" img) 'png)
368 ((string-match ".*\\.tiff?\\'" img) 'tiff)))
369
370(defun thumbs-file-size (img)
371 (let ((i (image-size (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
372 (concat (number-to-string (round (car i)))
373 "x"
374 (number-to-string (round (cdr i))))))
375
376;;;###autoload
377(defun thumbs-find-thumb (img)
378 "Display the thumbnail for IMG."
379 (interactive "f")
380 (find-file (thumbs-make-thumb img)))
381
382(defun thumbs-insert-image (img type relief &optional marked)
383 "Insert image IMG at point.
384TYPE and RELIEF will be used in constructing the image; see `image'
385in the emacs-lisp manual for further documentation.
386if MARKED is non-nil, the image is marked."
387 (let ((i `(image :type ,type
388 :file ,img
389 :relief ,relief
390 :conversion ,(if marked 'disabled)
391 :margin ,thumbs-margin)))
392 (insert-image i)
393 (setq thumbs-current-image-size
394 (image-size i t))))
395
396(defun thumbs-insert-thumb (img &optional marked)
397 "Insert the thumbnail for IMG at point.
398if MARKED is non-nil, the image is marked"
399 (thumbs-insert-image
400 (thumbs-make-thumb img) 'jpeg thumbs-relief marked))
401
402(defun thumbs-do-thumbs-insertion (L)
403 "Insert all thumbs in list L."
404 (setq thumbs-fileL nil)
405 (let ((i 0))
406 (while L
407 (when (= 0 (mod (setq i (1+ i)) thumbs-per-line))
408 (newline))
409 (setq thumbs-fileL (cons (cons (point)
410 (car L))
411 thumbs-fileL))
412 (thumbs-insert-thumb (car L)
413 (member (car L) thumbs-markedL))
414 (setq L (cdr L)))))
415
416(defun thumbs-show-thumbs-list (L &optional buffer-name same-window)
417 (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
418 (or buffer-name "*THUMB-View*"))
419 (let ((inhibit-read-only t))
420 (erase-buffer)
421 (thumbs-mode)
422 (make-variable-buffer-local 'thumbs-fileL)
423 (setq thumbs-fileL nil)
424 (thumbs-do-thumbs-insertion L)
425 (goto-char (point-min))
426 (setq thumbs-current-dir default-directory)
427 (make-variable-buffer-local 'thumbs-current-dir)))
428
429;;;###autoload
430(defun thumbs-show-all-from-dir (dir &optional reg same-window)
431 "Make a preview buffer for all images in DIR.
432Optional argument REG to select file matching a regexp,
433and SAME-WINDOW to show thumbs in the same window."
434 (interactive "DDir: ")
435 (thumbs-show-thumbs-list
436 (directory-files dir t
437 (or reg (image-file-name-regexp)))
438 (concat "*Thumbs: " dir) same-window))
439
440;;;###autoload
441(defun thumbs-dired-show-marked ()
442 "In Dired, make a thumbs buffer with all marked files."
443 (interactive)
444 (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
445
446;;;###autoload
447(defun thumbs-dired-show-all ()
448 "In dired, make a thumbs buffer with all files in current directory."
449 (interactive)
450 (thumbs-show-all-from-dir default-directory nil t))
451
452;;;###autoload
453(defalias 'thumbs 'thumbs-show-all-from-dir)
454
455(defun thumbs-find-image (img L &optional num otherwin)
456 (funcall
457 (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
458 (concat "*Image: " (file-name-nondirectory img) " - "
459 (number-to-string (or num 0)) "*"))
460 (thumbs-view-image-mode)
461 (let ((inhibit-read-only t))
462 (setq thumbs-current-image-filename img
463 thumbs-current-tmp-filename nil
464 thumbs-image-num (or num 0))
465 (make-variable-buffer-local 'thumbs-current-image-filename)
466 (make-variable-buffer-local 'thumbs-current-tmp-filename)
467 (make-variable-buffer-local 'thumbs-current-image-size)
468 (make-variable-buffer-local 'thumbs-image-num)
469 (make-variable-buffer-local 'thumbs-fileL)
470 (setq thumbs-fileL L)
471 (delete-region (point-min)(point-max))
472 (thumbs-insert-image img (thumbs-image-type img) 0)))
473
474(defun thumbs-find-image-at-point (&optional img otherwin)
475 "Display image IMG for thumbnail at point.
476use another window it OTHERWIN is t."
477 (interactive)
478 (let* ((L thumbs-fileL)
479 (n (point))
480 (i (or img (cdr (assoc n L)))))
481 (thumbs-find-image i L n otherwin)))
482
483(defun thumbs-find-image-at-point-other-window ()
484 "Display image for thumbnail at point in the preview buffer.
485Open another window."
486 (interactive)
487 (thumbs-find-image-at-point nil t))
488
489(defun thumbs-call-setroot-command (img)
490 "Call the setroot program for IMG."
491 (run-hooks 'thumbs-before-setroot-hook)
492 (shell-command (replace-regexp-in-string
493 "\\*"
494 (shell-quote-argument (expand-file-name img))
495 thumbs-setroot-command nil t))
496 (run-hooks 'thumbs-after-setroot-hook))
497
498(defun thumbs-set-image-at-point-to-root-window ()
499 "Set the image at point as the desktop wallpaper."
500 (interactive)
501 (thumbs-call-setroot-command (cdr (assoc (point) thumbs-fileL))))
502
503(defun thumbs-set-root ()
504 "Set the current image as root."
505 (interactive)
506 (thumbs-call-setroot-command
507 (or thumbs-current-tmp-filename
508 thumbs-current-image-filename)))
509
510(defun thumbs-delete-images ()
511 "Delete the image at point (and it's thumbnail) (or marked files if any)."
512 (interactive)
513 (let ((f (or thumbs-markedL (list (cdr (assoc (point) thumbs-fileL))))))
514 (if (yes-or-no-p "Really delete %d files?" (length f))
515 (progn
516 (mapcar (lambda (x)
517 (setq thumbs-fileL (delete (rassoc x thumbs-fileL) thumbs-fileL))
518 (delete-file x)
519 (delete-file (thumbs-thumbname x))) f)
520 (thumbs-redraw-buffer)))))
521
522(defun thumbs-kill-buffer ()
523 "Kill the current buffer."
524 (interactive)
525 (let ((buffer (current-buffer)))
526 (ignore-errors (delete-window (selected-window)))
527 (kill-buffer buffer)))
528
529(defun thumbs-show-image-num (num)
530 "Show the image with number NUM."
531 (let ((inhibit-read-only t))
532 (delete-region (point-min)(point-max))
533 (let ((i (cdr (assoc num thumbs-fileL))))
534 (thumbs-insert-image i (thumbs-image-type i) 0)
535 (sleep-for 2)
536 (rename-buffer (concat "*Image: "
537 (file-name-nondirectory i)
538 " - "
539 (number-to-string num) "*")))
540 (setq thumbs-image-num num
541 thumbs-current-image-filename i)))
542
543(defun thumbs-next-image ()
544 "Show next image."
545 (interactive)
546 (let* ((i (1+ thumbs-image-num))
547 (l (caar thumbs-fileL))
548 (num
549 (cond ((assoc i thumbs-fileL) i)
550 ((>= i l) 1)
551 (t (1+ i)))))
552 (thumbs-show-image-num num)))
553
554(defun thumbs-previous-image ()
555 "Show the previous image."
556 (interactive)
557 (let* ((i (- thumbs-image-num 1))
558 (l (caar thumbs-fileL))
559 (num
560 (cond ((assoc i thumbs-fileL) i)
561 ((<= i 1) l)
562 (t (- i 1)))))
563 (thumbs-show-image-num num)))
564
565(defun thumbs-redraw-buffer ()
566 "Redraw the current thumbs buffer."
567 (let ((p (point))
568 (inhibit-read-only t))
569 (delete-region (point-min)(point-max))
570 (thumbs-do-thumbs-insertion (reverse (mapcar 'cdr thumbs-fileL)))
571 (goto-char (1+ p))))
572
573(defun thumbs-mark ()
574 "Mark the image at point."
575 (interactive)
576 (setq thumbs-markedL (cons (cdr (assoc (point) thumbs-fileL)) thumbs-markedL))
577 (let ((inhibit-read-only t))
578 (delete-char 1)
579 (thumbs-insert-thumb (cdr (assoc (point) thumbs-fileL)) t))
580 (when (eolp)(forward-char)))
581
582;; Image modification routines
583
584(defun thumbs-modify-image (action &optional arg)
585 "Call convert to do ACTION on image with argument ARG.
586ACTION and ARG should be legal convert command."
587 (interactive "sAction: \nsValue: ")
588 ;; cleaning of old temp file
589 (mapc 'delete-file
590 (directory-files
591 thumbs-temp-dir
592 t
593 thumbs-temp-prefix))
594 (let ((buffer-read-only nil)
595 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym))))
596 (erase-buffer)
597 (thumbs-call-convert thumbs-current-image-filename
598 tmp
599 action
600 (or arg ""))
601 (thumbs-insert-image tmp 'jpeg 0)
602 (setq thumbs-current-tmp-filename tmp)))
603
604(defun thumbs-emboss-image (emboss)
605 "Emboss the image with value EMBOSS."
606 (interactive "nEmboss value: ")
607 (if (or (< emboss 3)(> emboss 31)(evenp emboss))
608 (error "Arg must be a odd number between 3 and 31"))
609 (thumbs-modify-image "emboss" (number-to-string emboss)))
610
611(defun thumbs-monochrome-image ()
612 "Turn the image to monochrome."
613 (interactive)
614 (thumbs-modify-image "monochrome"))
615
616(defun thumbs-negate-image ()
617 "Negate the image."
618 (interactive)
619 (thumbs-modify-image "negate"))
620
621(defun thumbs-rotate-left ()
622 "Rotate the image 90 degrees counter-clockwise."
623 (interactive)
624 (thumbs-modify-image "rotate" "270"))
625
626(defun thumbs-rotate-right ()
627 "Rotate the image 90 degrees clockwise."
628 (interactive)
629 (thumbs-modify-image "rotate" "90"))
630
631(defun thumbs-forward-char ()
632 "Move forward one image."
633 (interactive)
634 (forward-char)
635 (when (eolp)(forward-char))
636 (thumbs-show-name))
637
638(defun thumbs-backward-char ()
639 "Move backward one image."
640 (interactive)
641 (forward-char -1)
642 (thumbs-show-name))
643
644(defun thumbs-forward-line ()
645 "Move down one line."
646 (interactive)
647 (forward-line 1)
648 (thumbs-show-name))
649
650(defun thumbs-backward-line ()
651 "Move up one line."
652 (interactive)
653 (forward-line -1)
654 (thumbs-show-name))
655
656(defun thumbs-show-name ()
657 "Show the name of the current file."
658 (interactive)
659 (let ((f (cdr (assoc (point) thumbs-fileL))))
660 (message "%s [%s]" f (thumbs-file-size f))))
661
662(defun thumbs-save-current-image ()
663 "Save the current image."
664 (interactive)
665 (let ((f (or thumbs-current-tmp-filename
666 thumbs-current-image-filename))
667 (sa (read-from-minibuffer "save file as: "
668 thumbs-current-image-filename)))
669 (copy-file f sa)))
670
671(defun thumbs-dired ()
672 "Use `dired' on the current thumbs directory."
673 (interactive)
674 (dired thumbs-current-dir))
675
676;; thumbs-mode
677
678(defvar thumbs-mode-map
679 (let ((map (make-sparse-keymap)))
680 (define-key map [return] 'thumbs-find-image-at-point)
681 (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window)
682 (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window)
683 (define-key map [delete] 'thumbs-delete-images)
684 (define-key map [right] 'thumbs-forward-char)
685 (define-key map [left] 'thumbs-backward-char)
686 (define-key map [up] 'thumbs-backward-line)
687 (define-key map [down] 'thumbs-forward-line)
688 (define-key map "d" 'thumbs-dired)
689 (define-key map "m" 'thumbs-mark)
690 (define-key map "s" 'thumbs-show-name)
691 (define-key map "q" 'thumbs-kill-buffer)
692 map)
693 "Keymap for `thumbs-mode'.")
694
695(define-derived-mode thumbs-mode
696 fundamental-mode "thumbs"
697 "Preview images in a thumbnails buffer"
698 (make-variable-buffer-local 'thumbs-markedL)
699 (setq thumbs-markedL nil))
700
701(defvar thumbs-view-image-mode-map
702 (let ((map (make-sparse-keymap)))
703 (define-key map [prior] 'thumbs-previous-image)
704 (define-key map [next] 'thumbs-next-image)
705 (define-key map "-" 'thumbs-resize-image-size-down)
706 (define-key map "+" 'thumbs-resize-image-size-up)
707 (define-key map "<" 'thumbs-rotate-left)
708 (define-key map ">" 'thumbs-rotate-right)
709 (define-key map "e" 'thumbs-emboss-image)
710 (define-key map "r" 'thumbs-resize-interactive)
711 (define-key map "s" 'thumbs-save-current-image)
712 (define-key map "q" 'thumbs-kill-buffer)
713 (define-key map "w" 'thunbs-set-root)
714 map)
715 "Keymap for `thumbs-view-image-mode'.")
716
717;; thumbs-view-image-mode
718(define-derived-mode thumbs-view-image-mode
719 fundamental-mode "image-view-mode")
720
721;;;###autoload
722(defun thumbs-dired-setroot ()
723 "In dired, Call the setroot program on the image at point."
724 (interactive)
725 (thumbs-call-setroot-command (dired-get-filename)))
726
727;; Modif to dired mode map
728(define-key dired-mode-map "\C-ta" 'thumbs-dired-show-all)
729(define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked)
730(define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot)
731
732(provide 'thumbs)
733
734;;; thumbs.el ends here
735
736
737;;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-06 15:48:19 +0000