Mercurial > emacs
changeset 83068:90ccc0dc0d3f
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
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Mon, 01 Mar 2004 14:27:16 +0000 |
| parents | b44978264e1d (current diff) a37354a6c326 (diff) |
| children | a39b38a5d680 |
| files | lisp/ChangeLog src/xfns.c src/xterm.c |
| diffstat | 24 files changed, 1933 insertions(+), 573 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/etc/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,3 +1,7 @@ +2004-02-29 Juanma Barranquero <lektu@terra.es> + + * NEWS: Remove bogus reference to user option unicode-data. + 2004-02-16 Klaus Zeitler <kzeitler@lucent.com> * PROBLEMS: Document crashes on X when build with GCC and GNU ld. @@ -6,7 +10,7 @@ * NEWS: Fix typo. -2003-12-29 Ognyan Kulev <ogi@fmi.uni-sofia.bg> +2003-12-29 Ognyan Kulev <ogi@fmi.uni-sofia.bg> * TUTORIAL.bg: Use windows-1251 encoding. Fix punctuation errors. @@ -14,8 +18,8 @@ * TODO: Add plans for change of file attributes UID and GID from integer to string. - -2003-11-10 Kailash C. Chowksey <klchxbec@m-net.arbornet.org> + +2003-11-10 Kailash C. Chowksey <klchxbec@m-net.arbornet.org> * HELLO: Add Kannada. @@ -32,7 +36,7 @@ 2003-10-30 Kenichi Handa <handa@m17n.org> * HELLO: Fix cases of language names. Make German lines one. - Delete FORTRAN, add Mathematics + Delete FORTRAN, add Mathematics. 2003-10-24 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
--- a/etc/NEWS Sat Feb 28 04:52:40 2004 +0000 +++ b/etc/NEWS Mon Mar 01 14:27:16 2004 +0000 @@ -122,12 +122,12 @@ If value is a cons (ANGLES . ARROWS), the car specifies the position of the angle bitmaps, and the cdr specifies the position of the arrow -bitmaps. +bitmaps. For example, (t . right) places the top angle bitmap in left fringe, the bottom angle bitmap in right fringe, and both arrow bitmaps in right fringe. To show just the angle bitmaps in the left fringe, but -no arrow bitmaps, use (left . nil). +no arrow bitmaps, use (left . nil). ** New command `display-local-help' displays any local help at point in the echo area. It is bound to `C-h .'. It normally displays the @@ -319,9 +319,6 @@ If the configure option `--without-xim' was used to turn off use of XIM by default, the X resource useXIM can be used to turn it on. -** `describe-char' can show data from the Unicode database file. See -user option `unicode-data'. - ** `undo-only' does an undo which does not redo any previous undo. ** `uniquify-strip-common-suffix' tells uniquify to prefer
--- a/lisp/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,6 +1,131 @@ +2004-02-29 Kai Grossjohann <kai.grossjohann@gmx.net> + + Version 2.0.39 of Tramp released. + + * net/tramp.el (tramp-handle-file-local-copy) + (tramp-handle-write-region, tramp-open-connection-rsh): Variable + name typo. Small change. From Patrick Tullmann + <tullmann@flux.utah.edu>. + (tramp-process-connection-type): New variable. + (tramp-maybe-open-connection): Use it. + (tramp-do-copy-or-rename-via-buffer): Handle KEEP-DATE arg, if + possible. + (tramp-touch): Set last-modified time of a remote file. + (tramp-handle-write-region): Say which function is used when + encoding. + +2004-02-29 Michael Albinus <Michael.Albinus@alcatel.de> + + * net/tramp-smb.el (tramp-smb-handle-file-writable-p): Handle the + case of non-existing filename, too. Reported by Christoph Bauer + <c_bauer@informatik.uni-kl.de>. + (tramp-smb-get-file-entries): The directory in question should + have permissions "drwxrwxrwx". Just virtual, because we don't + know the real permissions. Don't we know? + (tramp-smb-prompt): Add virtual prompt from listing shares, too. + (tramp-smb-errors): Add "NT_STATUS_ACCOUNT_LOCKED_OUT". + (tramp-smb-wait-for-output): Optimize algorithm getting pending + output. If it was received chunkwise, there have been problems. + Remove the "prompt not found" error message; it is obvious. + Simplify algorithm. + (tramp-smb-process-running): Removed. Since we acknowledge the + virtual prompt for shares, there's no need for distinction of + reading shares (process ends afterwards) and interactive mode of + smblient. + (tramp-smb-open-connection): Setting process sentinel removed. + (tramp-smb-errors): Add "NT_STATUS_WRONG_PASSWORD" and + "NT_STATUS_NETWORK_ACCESS_DENIED". + (tramp-smb-maybe-open-connection): Set `process-connection-type' + to 'pty. Suggested by Piet van Oostrum <piet@cs.uu.nl>. + (top-level): Setting default value in `tramp-default-method-alist' + corrected. Order of USER and HOST have been wrong. Nobody + claimed for months ... + (tramp-smb-maybe-open-connection): Use + `tramp-process-connection-type'. + (tramp-smb-open-connection): Clear password cache if login has + failed. + + * net/tramp.el (tramp-completion-mode) Don't check for 'xemacs but + `tramp-unified-filenames'. + (tramp-completion-mode): Make test for XEmacs explicitely. + `event-to-character' can exists in Emacs packages too. Reported + by Matt Swift <swift@alum.mit.edu>. + (tramp-buffer-name): Buffer name must contain the user if exists. + Reported by Adrian Phillips <a.phillips@met.no>. + (tramp-do-copy-or-rename-file): Handle out-of-band methods. Call + `tramp-do-copy-or-rename-file-out-of-band' this case. + (tramp-do-copy-or-rename-file-out-of-band): Renamed from + `tramp-do-copy-or-rename-file-one-local', because it handles also + the case both files use the same out-of-band method. + Implementation added. + (tramp-handle-file-local-copy, tramp-handle-write-region): + Out-of-band handling removed. `copy-file' called instead, which + calls `tramp-do-copy-or-rename-file-out-of-band'. + (tramp-action-password): Check for out-of-band method removed. + This function is used for 'login-program. + (tramp-post-connection): Use `tramp-method-out-of-band-p' when + appropriate. + (tramp-completion-function-alist-ssh): Add `tramp-parse-shostkeys' + and `tramp-parse-sknownhosts'. + (tramp-completion-function-alist): It's a defvar now, because we + want to apply the optimized `tramp-set-completion-function' + instead of a static list. + (tramp-set-completion-function): Implementation tuned. Avoid + double entries, and entries where the function or the + file/directory doesn't exist. + (tramp-parse-shostkeys, tramp-parse-sknownhosts): New functions + for SSH2. + (tramp-file-name-handler-alist): Add `dired-compress-file' entry. + (tramp-handle-dired-compress-file): New function. + (tramp-async-proc): New variable. + (tramp-handle-shell-command): Adding asynchronous processes. They + are far from being perfect, but it works at least for + `find-grep-dired' and `find-name-dired' in Emacs 21.4. + (top-level): Require password.el if visible. Should be mandatory + once No Gnus has found its way into (X)Emacs. + (tramp-read-passwd): Invoke `password-read' if available, + `read-passwd' otherwise. `ange-ftp-read-passwd' isn't used as + fallback any longer. + (tramp-clear-passwd): New function. + (tramp-process-actions, tramp-process-multi-actions): Clear + password cache if login has failed. + + * net/tramp-ftp.el (Commentary): Remove pointer to EFS. It has + its own module. + (tramp-ftp-file-name-handler): Unset `ange-ftp-ftp-name-arg' and + `ange-ftp-ftp-name-res'. There could be incorrect values from + previous calls in case the "ftp" method is used in the Tramp file + name. Reported by Katsumi Yamaoka <yamaoka@jpl.org>. + +2004-02-28 Richard M. Stallman <rms@gnu.org> + + * term.el (term-mouse-paste): Call mouse-set-point. + + * thumbs.el: New file. + +2004-02-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ebnf-abn.el: Doc fix. + + * ebnf-bnf.el: Doc fix. + (ebnf-repeat): Code fix. + + * ebnf2ps.el: Doc fix. + (ebnf-syntax-directory, ebnf-syntax-file): New funs. + +2004-02-28 Juri Linkov <juri@jurta.org> + + * ffap.el (dired-at-point): Additional writability test for + relative directory names. + (dired-at-point-prompter): Treat directories as a directory, get + the directory component from files. + (ffap-string-at-point): Return string from region if region is + active. + (ffap-file-at-point): Remove redundant code. + 2004-02-28 Kim F. Storm <storm@cua.dk> - * gdb-ui.el (breakpoint-enabled-icon, breakpoint-disabled-icon): + * gdb-ui.el (breakpoint-enabled-icon, breakpoint-disabled-icon): Initialize margin area images to nil. (breakpoint-bitmap): New defvar for breakpoint fringe bitmaps. (breakpoint-enabled-bitmap-face) @@ -37,19 +162,19 @@ 2004-02-27 Dan Nicolaescu <dann@ics.uci.edu> - * faces.el (face-spec-set-match-display): Add a new attribute, - `min-colors'. - (region, highlight, secondary-selection): Use `min-colors`. + * faces.el (face-spec-set-match-display): Add a new attribute, + `min-colors'. + (region, highlight, secondary-selection): Use `min-colors'. * custom.el (defface): Add documentation for `min-colors'. * font-lock.el (font-lock-comment-face, font-lock-string-face) (font-lock-keyword-face, font-lock-function-name-face) (font-lock-variable-name-face, font-lock-constant-face): Use - `min-colors`. + `min-colors'. * isearch.el (isearch, isearch-lazy-highlight-face): Use - `min-colors'. + `min-colors'. 2004-02-25 Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -198,7 +323,7 @@ 2004-02-19 Glenn Morris <gmorris@ast.cam.ac.uk> * calendar/appt.el (appt-display-format): Change default to - 'ignore, for backwards compatability. + 'ignore, for backwards compatibility. (appt-display-message): If appt-display-format is 'ignore, respect old vars appt-msg-window and appt-visible. (appt-activate): Don't depend on return value of cancel-timer. @@ -304,7 +429,7 @@ * loadhist.el (unload-feature): Doc fix. Rename flist to unload-hook-features-list. -2004-02-16 Jay Belanger <belanger@truman.edu> (tiny change). +2004-02-16 Jay Belanger <belanger@truman.edu> (tiny change) * calc/calc-embed.el (calc-do-embedded-activate): Add autoload cookie. Don't check if we are looking-at open-formula. @@ -1091,7 +1216,7 @@ 2004-01-05 Karl Berry <karl@gnu.org> - * emacs-lisp/copyright.el (copyright-regexp): might as well allow + * emacs-lisp/copyright.el (copyright-regexp): Might as well allow / and *, too. 2003-12-31 Simon Josefsson <jas@extundo.com> @@ -1111,7 +1236,7 @@ 2004-01-04 Karl Berry <karl@gnu.org> - * emacs-lisp/copyright.el (copyright-regexp): allow the common + * emacs-lisp/copyright.el (copyright-regexp): Allow the common comment characters % and # in the copyright year notice, as well as ;. @@ -1165,7 +1290,7 @@ * ido.el (ido-nonreadable-directory-p): New defun to check for nonreadable directory without activating tramp (to avoid problems - with checking incomplete tramp paths. + with checking incomplete tramp paths). (ido-set-current-directory, ido-file-internal) (ido-file-name-all-completions1): Use it. @@ -1290,7 +1415,7 @@ * files.el (kill-some-buffers): Doc fix. -2003-12-29 David Herring <sdh6@ra.msstate.edu> (tiny change) +2003-12-29 David Herring <sdh6@ra.msstate.edu> (tiny change) * comint.el (comint-watch-for-password-prompt): Pass `string' as arg to send-invisible @@ -1308,16 +1433,16 @@ * xml.el (xml-get-attribute-or-nil): Doc fix. -2003-12-29 Peter 'Luna' Runestig <peter@runestig.com> +2003-12-29 Peter 'Luna' Runestig <peter@runestig.com> * net/zone-mode.el (zone-mode): Use write-file-functions, not write-file-hooks. -2003-12-29 Eric Hanchrow <offby1@blarg.net> (tiny change) +2003-12-29 Eric Hanchrow <offby1@blarg.net> (tiny change) * autorevert.el (auto-revert-interval): Doc fix. -2003-12-29 Mark A. Hershberger <mah@everybody.org> +2003-12-29 Mark A. Hershberger <mah@everybody.org> * xml.el (xml-get-attribute-or-nil): New function, like xml-get-attribute, but returns nil if the attribute was not found. @@ -1328,12 +1453,12 @@ * emacs-lisp/easymenu.el (easy-menu-define): Doc fix. -2003-12-29 Alex Schroeder <alex@emacswiki.org> (tiny change) +2003-12-29 Alex Schroeder <alex@emacswiki.org> (tiny change) * custom.el (custom-declare-theme): Use `value' when putting properties on `theme'. -2003-12-29 Takaaki Ota <Takaaki.Ota@am.sony.com> +2003-12-29 Takaaki Ota <Takaaki.Ota@am.sony.com> * subr.el (insert-for-yank): Call insert-for-yank-1 repetitively for each yank-handler segment. @@ -1344,7 +1469,7 @@ (table--put-cell-indicator-property): Put yank-handler property that indicates the yank handler for the table cell. -2003-12-29 Jesper Harder <harder@ifa.au.dk> (tiny change) +2003-12-29 Jesper Harder <harder@ifa.au.dk> (tiny change) * generic-x.el (etc-modules-conf-generic-mode): A more complete set of keywords. @@ -1417,7 +1542,7 @@ * ffap.el (ffap-read-file-or-url): Revert previous change. -2003-12-25 Robert J. Chassell <bob@rattlesnake.com> +2003-12-25 Robert J. Chassell <bob@rattlesnake.com> * textmodes/texnfo-upd.el (texinfo-multi-file-update): Create a new list of included files called `files-with-node-lines', that @@ -1497,7 +1622,7 @@ * info.el (Info-unescape-quotes, Info-split-parameter-string) (Info-goto-emacs-command-node): Doc fixes. -2003-12-12 Jesper Harder <harder@ifa.au.dk> +2003-12-12 Jesper Harder <harder@ifa.au.dk> * cus-edit.el (custom-add-parent-links): Define "many". @@ -1588,7 +1713,6 @@ value "'integer". Otherwise, don't use that parameter (default is integer format). - 2003-11-30 Luc Teirlinck <teirllm@auburn.edu> * help.el (help-map): Bind `display-local-help' to `C-h .'. @@ -1882,7 +2006,7 @@ * descr-text.el (describe-char): Fix typo. -2003-11-08 Kailash C. Chowksey <klchxbec@m-net.arbornet.org> +2003-11-08 Kailash C. Chowksey <klchxbec@m-net.arbornet.org> These changes are to support Kannada language/script. @@ -1939,7 +2063,7 @@ (xml-ns-parse-ns-attrs, xml-ns-expand-el) (xml-ns-expand-attr): New functions to do namespace handling. (xml-intern-attrlist): Back-compatible handling of attribute names. - (xml-parse-tag): Move namespace handling to seperate functions. + (xml-parse-tag): Move namespace handling to separate functions. Now produces elements in the form ((:ns . "element") (attr-list) children) instead of ('ns:element (attr-list) children). (xml-parse-attlist): Fix attribute parsing. @@ -2450,7 +2574,7 @@ (mode-line-position): Change cons cell into proper list in initialization. -2003-09-29 SAITO Takuya <tabmore@rivo.mediatti.net> (tiny change) +2003-09-29 SAITO Takuya <tabmore@rivo.mediatti.net> (tiny change) * international/mule.el (decode-coding-inserted-region): Use car of the return value of find-operation-coding-system. @@ -2500,7 +2624,7 @@ is non-nil, initialize an empty `file-name-history' with the recent list. -2003-09-28 Evgeni Dobrev <evgeni_dobrev@developer.bg> (tiny patch) +2003-09-28 Evgeni Dobrev <evgeni_dobrev@developer.bg> (tiny change) * man.el (Man-default-man-entry): Remove the leading `*' from the word at point. @@ -2710,7 +2834,7 @@ (bootstrap-clean-CMD, bootstrap-clean-SH): Recreate loaddefs.el from loaddefs-boot.el if necessary. -2003-09-15 Zoltan Kemenczy <kemenczy@rogers.com> +2003-09-15 Zoltan Kemenczy <kemenczy@rogers.com> * progmodes/gud.el (gud-find-class): Make jdb work again since cc-mode changed the syntactic information. @@ -2741,7 +2865,7 @@ * emacs-lisp/tq.el (tq-create): Fix mixed up unquote style. -2003-09-12 Eric Hanchrow <offby1@blarg.net> (tiny change) +2003-09-12 Eric Hanchrow <offby1@blarg.net> (tiny change) * dired.el (dired-mode-map): Fix typo. @@ -2879,7 +3003,7 @@ * international/fontset.el (setup-default-fontset): For Thai font, specify "*" family. -2003-09-01 Kevin Rodgers <ihs_4664@yahoo.com> (tiny change) +2003-09-01 Kevin Rodgers <ihs_4664@yahoo.com> (tiny change) * progmodes/compile.el (previous-error): Accept a prefix argument, similarly to next-error. @@ -2920,7 +3044,7 @@ * simple.el (blink-matching-open): Work correctly on chars that are designated as parens through the syntax-table text property. -2003-08-29 Thierry Emery <thierry.emery@club-internet.fr> (tiny change) +2003-08-29 Thierry Emery <thierry.emery@club-internet.fr> (tiny change) * kinsoku.el (kinsoku-longer, kinsoku-shorter): Do not choose a line break position in the middle of a non-kinsoku (e.g. latin) @@ -2970,7 +3094,7 @@ * progmodes/cc-engine.el (c-just-after-func-arglist-p): Safeguard against unbalanced sexps. -2003-08-26 Terje Rosten <terjeros@phys.ntnu.no> +2003-08-26 Terje Rosten <terjeros@phys.ntnu.no> * version.el (emacs-version): Check for gtk. Include gtk version info.
--- a/lisp/ffap.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/ffap.el Mon Mar 01 14:27:16 2004 +0000 @@ -1,7 +1,7 @@ -;; ffap.el --- find file (or url) at point -;; -;; Copyright (C) 1995, 96, 97, 2000 Free Software Foundation, Inc. -;; +;;; ffap.el --- find file (or url) at point + +;; Copyright (C) 1995, 96, 97, 2000, 2004 Free Software Foundation, Inc. + ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> ;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org> ;; Created: 29 Mar 1993 @@ -701,7 +701,7 @@ (defun ffap-locate-file (file &optional nosuffix path dir-ok) ;; The Emacs 20 version of locate-library could almost replace this, - ;; except it does not let us overrride the suffix list. The + ;; except it does not let us override the suffix list. The ;; compression-suffixes search moved to ffap-file-exists-string. "A generic path-searching function, mimics `load' by default. Returns path to file that \(load FILE\) would load, or nil. @@ -966,6 +966,7 @@ MODE (defaults to value of `major-mode') is a symbol used to look up string syntax parameters in `ffap-string-at-point-mode-alist'. If MODE is not found, we use `file' instead of MODE. +If the region is active, return a string from the region. Sets `ffap-string-at-point' and `ffap-string-at-point-region'." (let* ((args (cdr @@ -973,15 +974,19 @@ (assq 'file ffap-string-at-point-mode-alist)))) (pt (point)) (str - (buffer-substring - (save-excursion - (skip-chars-backward (car args)) - (skip-chars-forward (nth 1 args) pt) - (setcar ffap-string-at-point-region (point))) - (save-excursion - (skip-chars-forward (car args)) - (skip-chars-backward (nth 2 args) pt) - (setcar (cdr ffap-string-at-point-region) (point)))))) + (if (and transient-mark-mode mark-active) + (buffer-substring + (setcar ffap-string-at-point-region (region-beginning)) + (setcar (cdr ffap-string-at-point-region) (region-end))) + (buffer-substring + (save-excursion + (skip-chars-backward (car args)) + (skip-chars-forward (nth 1 args) pt) + (setcar ffap-string-at-point-region (point))) + (save-excursion + (skip-chars-forward (car args)) + (skip-chars-backward (nth 2 args) pt) + (setcar (cdr ffap-string-at-point-region) (point))))))) (set-text-properties 0 (length str) nil str) (setq ffap-string-at-point str))) @@ -1128,9 +1133,6 @@ ((and ffap-shell-prompt-regexp (not abs) (string-match ffap-shell-prompt-regexp name) (ffap-file-exists-string (substring name (match-end 0))))) - ;; Immediately test local filenames. If default-directory is - ;; remote, you probably already have a connection. - ((and (not abs) (ffap-file-exists-string name))) ;; Accept remote names without actual checking (too slow): ((if abs (ffap-file-remote-p name) @@ -1675,7 +1677,9 @@ (if (file-directory-p filename) (dired (expand-file-name filename)) (dired (concat (expand-file-name filename) "*")))) - ((and (file-writable-p (file-name-directory filename)) + ((and (file-writable-p + (or (file-name-directory (directory-file-name filename)) + filename)) (y-or-n-p "Directory does not exist, create it? ")) (make-directory filename) (dired filename)) @@ -1688,9 +1692,24 @@ (ffap-read-file-or-url (if ffap-url-regexp "Dired file or URL: " "Dired file: ") (prog1 - (setq guess (or guess (ffap-guesser))) - (and guess (ffap-highlight)) - )) + (setq guess (or guess + (let ((guess (ffap-guesser))) + (if (or (not guess) + (ffap-url-p guess) + (ffap-file-remote-p guess)) + guess + (setq guess (abbreviate-file-name + (expand-file-name guess))) + (cond + ;; Interpret local directory as a directory. + ((file-directory-p guess) + (file-name-as-directory guess)) + ;; Get directory component from local files. + ((file-regular-p guess) + (file-name-directory guess)) + (guess)))) + )) + (and guess (ffap-highlight)))) (ffap-highlight t))) ;;; Offer default global bindings (`ffap-bindings'):
--- a/lisp/net/tramp-ftp.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/net/tramp-ftp.el Mon Mar 01 14:27:16 2004 +0000 @@ -1,6 +1,6 @@ ;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP and EFS -*- coding: iso-8859-1; -*- -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Michael Albinus <Michael.Albinus@alcatel.de> ;; Keywords: comm, processes @@ -24,8 +24,8 @@ ;;; Commentary: -;; Convenience functions for calling Ange-FTP (and maybe EFS, later on) -;; from Tramp. Most of them are displaced from tramp.el. +;; Convenience functions for calling Ange-FTP from Tramp. +;; Most of them are displaced from tramp.el. ;;; Code: @@ -98,9 +98,16 @@ (list (nth 0 tramp-file-name-structure) (nth 3 tramp-file-name-structure) (nth 2 tramp-file-name-structure) - (nth 4 tramp-file-name-structure)))) + (nth 4 tramp-file-name-structure))) + ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' + ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, + ;; there could be incorrect values from previous calls in case the + ;; "ftp" method is used in the Tramp file name. So we unset + ;; those values. + (ange-ftp-ftp-name-arg "") + (ange-ftp-ftp-name-res nil)) (cond - ;; If argument is a symlink, 'file-directory-p` and 'file-exists-p` + ;; If argument is a symlink, `file-directory-p' and `file-exists-p' ;; call the traversed file recursively. So we cannot disable the ;; file-name-handler this case. ((memq operation '(file-directory-p file-exists-p))
--- a/lisp/net/tramp-smb.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/net/tramp-smb.el Mon Mar 01 14:27:16 2004 +0000 @@ -1,6 +1,6 @@ ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- -;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Michael Albinus <Michael.Albinus@alcatel.de> ;; Keywords: comm, processes @@ -50,7 +50,7 @@ ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. (add-to-list 'tramp-default-method-alist - (list "%" "" tramp-smb-method)) + (list "" "%" tramp-smb-method)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -62,7 +62,7 @@ :group 'tramp :type 'string) -(defconst tramp-smb-prompt "^smb: \\S-+> " +(defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$" "Regexp used as prompt in smbclient.") (defconst tramp-smb-errors @@ -71,8 +71,8 @@ '(; Connection error "Connection to \\S-+ failed" ; Samba + "ERRDOS" "ERRSRV" - "ERRDOS" "ERRbadfile" "ERRbadpw" "ERRfilexists" @@ -81,13 +81,16 @@ "ERRnosuchshare" ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) "NT_STATUS_ACCESS_DENIED" + "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" "NT_STATUS_CANNOT_DELETE" "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_NETWORK_ACCESS_DENIED" "NT_STATUS_NO_SUCH_FILE" "NT_STATUS_OBJECT_NAME_INVALID" "NT_STATUS_OBJECT_NAME_NOT_FOUND" - "NT_STATUS_SHARING_VIOLATION") + "NT_STATUS_SHARING_VIOLATION" + "NT_STATUS_WRONG_PASSWORD") "\\|") "Regexp for possible error strings of SMB servers. Used instead of analyzing error codes of commands.") @@ -102,12 +105,6 @@ This variable is local to each buffer.") (make-variable-buffer-local 'tramp-smb-share-cache) -(defvar tramp-smb-process-running nil - "Flag whether a corresponding process is still running. -Will be changed by corresponding `process-sentinel'. -This variable is local to each buffer.") -(make-variable-buffer-local 'tramp-smb-process-running) - (defvar tramp-smb-inodes nil "Keeps virtual inodes numbers for SMB files.") @@ -452,19 +449,23 @@ (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for tramp files." -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) - (save-excursion - (let* ((share (tramp-smb-get-share localname)) - (file (tramp-smb-get-localname localname nil)) - (entries (tramp-smb-get-file-entries user host share file)) - (entry (and entries - (assoc (file-name-nondirectory file) entries)))) - (and entry - (string-match "w" (nth 1 entry)) - t))))) + (if (not (file-exists-p filename)) + (let ((dir (file-name-directory filename))) + (and (file-exists-p dir) + (file-writable-p dir))) +; (with-parsed-tramp-file-name filename nil + (let (user host localname) + (with-parsed-tramp-file-name filename l + (setq user l-user host l-host localname l-localname)) + (save-excursion + (let* ((share (tramp-smb-get-share localname)) + (file (tramp-smb-get-localname localname nil)) + (entries (tramp-smb-get-file-entries user host share file)) + (entry (and entries + (assoc (file-name-nondirectory file) entries)))) + (and share entry + (string-match "w" (nth 1 entry)) + t)))))) (defun tramp-smb-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -733,9 +734,12 @@ ;; Cache share entries (setq tramp-smb-share-cache res))) + ;; Add directory itself + (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0))) - ;; Add directory itself - (add-to-list 'res '("" "dr-xr-xr-x" 0 (0 0))) + ;; There's a very strange error (debugged with XEmacs 21.4.14) + ;; If there's no short delay, it returns nil. No idea about + (when (featurep 'xemacs) (sleep-for 0.01)) ;; Check for matching entries (delq nil (mapcar @@ -913,7 +917,8 @@ "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." - (let ((p (get-buffer-process + (let ((process-connection-type tramp-process-connection-type) + (p (get-buffer-process (tramp-get-buffer nil tramp-smb-method user host)))) (save-excursion (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) @@ -987,11 +992,7 @@ (tramp-message 9 "Started process %s" (process-command p)) (process-kill-without-query p) (set-buffer buffer) - (set-process-sentinel - p (lambda (proc str) (setq tramp-smb-process-running nil))) - ; If no share is given, the process will terminate - (setq tramp-smb-process-running share - tramp-smb-share share) + (setq tramp-smb-share share) ; send password (when real-user @@ -1000,54 +1001,44 @@ (tramp-enter-password p pw-prompt))) (unless (tramp-smb-wait-for-output user host) + (tramp-clear-passwd user host) (error "Cannot open connection //%s@%s/%s" user host (or share ""))))))) ;; We don't use timeouts. If needed, the caller shall wrap around. (defun tramp-smb-wait-for-output (user host) "Wait for output from smbclient command. -Sets position to begin of buffer. Returns nil if an error message has appeared." - (save-excursion - (let ((proc (get-buffer-process (current-buffer))) - (found (progn (goto-char (point-max)) - (beginning-of-line) - (looking-at tramp-smb-prompt))) - err) - (save-match-data - ;; Algorithm: get waiting output. See if last line contains - ;; tramp-smb-prompt sentinel, or process has exited. - ;; If not, wait a bit and again get waiting output. - (while (and (not found) tramp-smb-process-running) - (accept-process-output proc) - (goto-char (point-max)) - (beginning-of-line) - (setq found (looking-at tramp-smb-prompt))) + (let ((proc (get-buffer-process (current-buffer))) + (found (progn (goto-char (point-min)) + (re-search-forward tramp-smb-prompt nil t))) + (err (progn (goto-char (point-min)) + (re-search-forward tramp-smb-errors nil t)))) + + ;; Algorithm: get waiting output. See if last line contains + ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. + ;; If not, wait a bit and again get waiting output. + (while (and (not found) (not err)) + + ;; Accept pending output. + (accept-process-output proc) - ;; There might be pending output. If tramp-smb-prompt sentinel - ;; hasn't been found, the process has died already. We should - ;; give it a chance. - (when (not found) (accept-process-output nil 1)) + ;; Search for prompt. + (goto-char (point-min)) + (setq found (re-search-forward tramp-smb-prompt nil t)) - ;; Search for errors. - (goto-char (point-min)) - (setq err (re-search-forward tramp-smb-errors nil t))) + ;; Search for errors. + (goto-char (point-min)) + (setq err (re-search-forward tramp-smb-errors nil t))) - ;; Add output to debug buffer if appropriate. - (when tramp-debug-buffer - (append-to-buffer - (tramp-get-debug-buffer nil tramp-smb-method user host) - (point-min) (point-max)) - (when (and (not found) tramp-smb-process-running) - (save-excursion - (set-buffer - (tramp-get-debug-buffer nil tramp-smb-method user host)) - (goto-char (point-max)) - (insert (format "[[Remote prompt `%s' not found]]\n" - tramp-smb-prompt))))) - (goto-char (point-min)) - ;; Return value is whether no error message has appeared. - (not err)))) + ;; Add output to debug buffer if appropriate. + (when tramp-debug-buffer + (append-to-buffer + (tramp-get-debug-buffer nil tramp-smb-method user host) + (point-min) (point-max))) + + ;; Return value is whether no error message has appeared. + (not err))) ;; Snarfed code from time-date.el and parse-time.el @@ -1125,8 +1116,6 @@ ;; * Provide a local smb.conf. The default one might not be readable. ;; * Error handling in case password is wrong. ;; * Read password from "~/.netrc". -;; * Use different buffers for different shares. By this, the password -;; won't be requested again when changing shares on the same host. ;; * Return more comprehensive file permission string. Think whether it is ;; possible to implement `set-file-modes'. ;; * Handle WILDCARD and FULL-DIRECTORY-P in
--- a/lisp/net/tramp.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/net/tramp.el Mon Mar 01 14:27:16 2004 +0000 @@ -1,7 +1,7 @@ ;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*- ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: kai.grossjohann@gmx.net ;; Keywords: comm, processes @@ -72,6 +72,12 @@ (require 'timer) (require 'format-spec) ;from Gnus 5.8, also in tar ball +;; As long as password.el is not part of (X)Emacs, it shouldn't +;; be mandatory +(if (featurep 'xemacs) + (load "password" 'noerror) + (require 'password nil 'noerror)) ;from No Gnus, also in tar ball + ;; The explicit check is not necessary in Emacs, which provides the ;; feature even if implemented in C, but it appears to be necessary ;; in XEmacs. @@ -628,14 +634,18 @@ ;; Default values for non-Unices seeked (defconst tramp-completion-function-alist-ssh (unless (memq system-type '(windows-nt)) - '((tramp-parse-rhosts "/etc/hosts.equiv") - (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-rhosts "~/.rhosts") - (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config"))) + '((tramp-parse-rhosts "/etc/hosts.equiv") + (tramp-parse-rhosts "/etc/shosts.equiv") + (tramp-parse-shosts "/etc/ssh_known_hosts") + (tramp-parse-sconfig "/etc/ssh_config") + (tramp-parse-shostkeys "/etc/ssh2/hostkeys") + (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") + (tramp-parse-rhosts "~/.rhosts") + (tramp-parse-rhosts "~/.shosts") + (tramp-parse-shosts "~/.ssh/known_hosts") + (tramp-parse-sconfig "~/.ssh/config") + (tramp-parse-shostkeys "~/.ssh2/hostkeys") + (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") ;; Default values for non-Unices seeked @@ -650,53 +660,79 @@ '((tramp-parse-passwd "/etc/passwd"))) "Default list of (FUNCTION FILE) pairs to be examined for su methods.") -(defcustom tramp-completion-function-alist - (list (cons "rcp" tramp-completion-function-alist-rsh) - (cons "scp" tramp-completion-function-alist-ssh) - (cons "scp1" tramp-completion-function-alist-ssh) - (cons "scp2" tramp-completion-function-alist-ssh) - (cons "scp1_old" tramp-completion-function-alist-ssh) - (cons "scp2_old" tramp-completion-function-alist-ssh) - (cons "rsync" tramp-completion-function-alist-rsh) - (cons "remcp" tramp-completion-function-alist-rsh) - (cons "rsh" tramp-completion-function-alist-rsh) - (cons "ssh" tramp-completion-function-alist-ssh) - (cons "ssh1" tramp-completion-function-alist-ssh) - (cons "ssh2" tramp-completion-function-alist-ssh) - (cons "ssh1_old" tramp-completion-function-alist-ssh) - (cons "ssh2_old" tramp-completion-function-alist-ssh) - (cons "remsh" tramp-completion-function-alist-rsh) - (cons "telnet" tramp-completion-function-alist-telnet) - (cons "su" tramp-completion-function-alist-su) - (cons "sudo" tramp-completion-function-alist-su) - (cons "multi" nil) - (cons "scpx" tramp-completion-function-alist-ssh) - (cons "sshx" tramp-completion-function-alist-ssh) - (cons "krlogin" tramp-completion-function-alist-rsh) - (cons "plink" tramp-completion-function-alist-ssh) - (cons "plink1" tramp-completion-function-alist-ssh) - (cons "pscp" tramp-completion-function-alist-ssh) - (cons "fcp" tramp-completion-function-alist-ssh) - ) +(defvar tramp-completion-function-alist nil "*Alist of methods for remote files. This is a list of entries of the form (NAME PAIR1 PAIR2 ...). Each NAME stands for a remote access method. Each PAIR is of the form \(FUNCTION FILE). FUNCTION is responsible to extract user names and host names from FILE for completion. The following predefined FUNCTIONs exists: - * `tramp-parse-rhosts' for \"~/.rhosts\" like files, - * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files, - * `tramp-parse-sconfig' for \"~/.ssh/config\" like files, - * `tramp-parse-hosts' for \"/etc/hosts\" like files, and - * `tramp-parse-passwd' for \"/etc/passwd\" like files. - * `tramp-parse-netrc' for \"~/.netrc\" like files. - -FUNCTION can also see a customer defined function. For more details see -the info pages." - :group 'tramp - :type '(repeat - (cons string - (choice (const nil) (repeat (list function file)))))) + * `tramp-parse-rhosts' for \"~/.rhosts\" like files, + * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files, + * `tramp-parse-sconfig' for \"~/.ssh/config\" like files, + * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files, + * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files, + * `tramp-parse-hosts' for \"/etc/hosts\" like files, + * `tramp-parse-passwd' for \"/etc/passwd\" like files. + * `tramp-parse-netrc' for \"~/.netrc\" like files. + +FUNCTION can also be a customer defined function. For more details see +the info pages.") + +(eval-after-load "tramp" + '(progn + (tramp-set-completion-function + "rcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "scp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "scp1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "scp2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "scp1_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "scp2_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "rsync" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "remcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "rsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "ssh" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh1_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh2_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "remsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "telnet" tramp-completion-function-alist-telnet) + (tramp-set-completion-function + "su" tramp-completion-function-alist-su) + (tramp-set-completion-function + "sudo" tramp-completion-function-alist-su) + (tramp-set-completion-function + "multi" nil) + (tramp-set-completion-function + "scpx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "sshx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "krlogin" tramp-completion-function-alist-rsh) + (tramp-set-completion-function + "plink" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "plink1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "pscp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "fcp" tramp-completion-function-alist-ssh))) (defcustom tramp-rsh-end-of-line "\n" "*String used for end of line in rsh connections. @@ -1267,6 +1303,17 @@ :group 'tramp :type '(choice (const nil) integer)) +;; Logging in to a remote host normally requires obtaining a pty. But +;; Emacs on MacOS X has process-connection-type set to nil by default, +;; so on those systems Tramp doesn't obtain a pty. Here, we allow +;; for an override of the system default. +(defcustom tramp-process-connection-type t + "Overrides `process-connection-type' for connections from Tramp. +Tramp binds process-connection-type to the value given here before +opening a connection to a remote host." + :group 'tramp + :type '(choice (const nil) (const t) (const pty))) + ;;; Internal Variables: (defvar tramp-buffer-file-attributes nil @@ -1638,6 +1685,7 @@ (insert-file-contents . tramp-handle-insert-file-contents) (write-region . tramp-handle-write-region) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (dired-compress-file . tramp-handle-dired-compress-file) (dired-call-process . tramp-handle-dired-call-process) (dired-recursive-delete-directory . tramp-handle-dired-recursive-delete-directory) @@ -1761,15 +1809,30 @@ '((tramp-parse-sconfig \"/etc/ssh_config\") (tramp-parse-sconfig \"~/.ssh/config\")))" - (let ((v (cdr (assoc method tramp-completion-function-alist)))) - (if v (setcdr v function-list) + (let ((r function-list) + (v function-list)) + (setq tramp-completion-function-alist + (delete (assoc method tramp-completion-function-alist) + tramp-completion-function-alist)) + + (while v + ;; Remove double entries + (when (member (car v) (cdr v)) + (setcdr v (delete (car v) (cdr v)))) + ;; Check for function and file + (unless (and (functionp (nth 0 (car v))) + (file-exists-p (nth 1 (car v)))) + (setq r (delete (car v) r))) + (setq v (cdr v))) + + (when r (add-to-list 'tramp-completion-function-alist - (cons method function-list))))) + (cons method r))))) (defun tramp-get-completion-function (method) "Returns list of completion functions for METHOD. For definition of that list see `tramp-set-completion-function'." - (cdr (assoc method tramp-completion-function-alist))) + (cdr (assoc method tramp-completion-function-alist))) ;;; File Name Handler Functions: @@ -2586,44 +2649,86 @@ (signal 'file-already-exists (list newname)))) (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname))) + (t2 (tramp-tramp-file-p newname)) + v1-multi-method v1-method v1-user v1-host v1-localname + v2-multi-method v2-method v2-user v2-host v2-localname) + ;; Check which ones of source and target are Tramp files. + ;; We cannot invoke `with-parsed-tramp-file-name'; + ;; it fails if the file isn't a Tramp file name. + (if t1 + (with-parsed-tramp-file-name filename l + (setq v1-multi-method l-multi-method + v1-method l-method + v1-user l-user + v1-host l-host + v1-localname l-localname)) + (setq v1-localname filename)) + (if t2 + (with-parsed-tramp-file-name newname l + (setq v2-multi-method l-multi-method + v2-method l-method + v2-user l-user + v2-host l-host + v2-localname l-localname)) + (setq v2-localname newname)) + (cond + ;; Both are Tramp files. ((and t1 t2) - ;; Both are Tramp files. - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 - ;; Check if we can use a shortcut. - (if (and (equal v1-multi-method v2-multi-method) - (equal v1-method v2-method) - (equal v1-host v2-host) - (equal v1-user v2-user)) - ;; Shortcut: if method, host, user are the same for both - ;; files, we invoke `cp' or `mv' on the remote host - ;; directly. - (tramp-do-copy-or-rename-file-directly - op v1-multi-method v1-method v1-user v1-host - v1-localname v2-localname keep-date) - ;; The shortcut was not possible. So we copy the - ;; file first. If the operation was `rename', we go - ;; back and delete the original file (if the copy was - ;; successful). The approach is simple-minded: we - ;; create a new buffer, insert the contents of the - ;; source file into it, then write out the buffer to - ;; the target file. The advantage is that it doesn't - ;; matter which filename handlers are used for the - ;; source and target file. - - ;; CCC: If both source and target are Tramp files, - ;; and both are using the same copy-program, then we - ;; can invoke rcp directly. Note that - ;; default-directory should point to a local - ;; directory if we want to invoke rcp. - (tramp-do-copy-or-rename-via-buffer - op filename newname keep-date))))) + (cond + ;; Shortcut: if method, host, user are the same for both + ;; files, we invoke `cp' or `mv' on the remote host + ;; directly. + ((and (equal v1-multi-method v2-multi-method) + (equal v1-method v2-method) + (equal v1-user v2-user) + (equal v1-host v2-host)) + (tramp-do-copy-or-rename-file-directly + op v1-multi-method v1-method v1-user v1-host + v1-localname v2-localname keep-date)) + ;; If both source and target are Tramp files, + ;; both are using the same copy-program, then we + ;; can invoke rcp directly. Note that + ;; default-directory should point to a local + ;; directory if we want to invoke rcp. + ((and (not v1-multi-method) + (not v2-multi-method) + (equal v1-method v2-method) + (tramp-method-out-of-band-p + v1-multi-method v1-method v1-user v1-host) + (not (string-match "\\([^#]*\\)#\\(.*\\)" v1-host)) + (not (string-match "\\([^#]*\\)#\\(.*\\)" v2-host))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date)) + ;; No shortcut was possible. So we copy the + ;; file first. If the operation was `rename', we go + ;; back and delete the original file (if the copy was + ;; successful). The approach is simple-minded: we + ;; create a new buffer, insert the contents of the + ;; source file into it, then write out the buffer to + ;; the target file. The advantage is that it doesn't + ;; matter which filename handlers are used for the + ;; source and target file. + (t + (tramp-do-copy-or-rename-via-buffer + op filename newname keep-date)))) + + ;; One file is a Tramp file, the other one is local. ((or t1 t2) - ;; Use the generic method via a Tramp buffer. - (tramp-do-copy-or-rename-via-buffer op filename newname keep-date)) + ;; If the Tramp file has an out-of-band method, the corresponding + ;; copy-program can be invoked. + (if (and (not v1-multi-method) + (not v2-multi-method) + (or (tramp-method-out-of-band-p + v1-multi-method v1-method v1-user v1-host) + (tramp-method-out-of-band-p + v2-multi-method v2-method v2-user v2-host))) + (tramp-do-copy-or-rename-file-out-of-band + op filename newname keep-date) + ;; Use the generic method via a Tramp buffer. + (tramp-do-copy-or-rename-via-buffer op filename newname keep-date))) + (t ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))))) @@ -2634,8 +2739,9 @@ First arg OP is either `copy' or `rename' and indicates the operation. FILENAME is the source file, NEWNAME the target file. KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." - (let ((trampbuf (get-buffer-create "*tramp output*"))) - (when keep-date + (let ((trampbuf (get-buffer-create "*tramp output*")) + (modtime (nth 5 (file-attributes filename)))) + (when (and keep-date (or (null modtime) (equal modtime '(0 0)))) (tramp-message 1 (concat "Warning: cannot preserve file time stamp" " with inline copying across machines"))) @@ -2646,7 +2752,12 @@ ;; `jka-compr-inhibit' to t. (let ((coding-system-for-write 'binary) (jka-compr-inhibit t)) - (write-region (point-min) (point-max) newname))) + (write-region (point-min) (point-max) newname)) + ;; KEEP-DATE handling. + (when (and keep-date + (not (null modtime)) + (not (equal modtime '(0 0)))) + (tramp-touch newname modtime))) ;; If the operation was `rename', delete the original file. (unless (eq op 'copy) (delete-file filename)))) @@ -2676,13 +2787,112 @@ "Copying directly failed, see buffer `%s' for details." (buffer-name))))) -(defun tramp-do-copy-or-rename-file-one-local - (op filename newname keep-date) +(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) "Invoke rcp program to copy. One of FILENAME and NEWNAME must be a Tramp name, the other must be a local filename. The method used must be an out-of-band method." - ;; CCC - ) + (let ((trampbuf (get-buffer-create "*tramp output*")) + (t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + v1-multi-method v1-method v1-user v1-host v1-localname + v2-multi-method v2-method v2-user v2-host v2-localname + method copy-program copy-args source target) + + ;; Check which ones of source and target are Tramp files. + ;; We cannot invoke `with-parsed-tramp-file-name'; + ;; it fails if the file isn't a Tramp file name. + (if t1 + (with-parsed-tramp-file-name filename l + (setq v1-multi-method l-multi-method + v1-method l-method + v1-user l-user + v1-host l-host + v1-localname l-localname + method (tramp-find-method + v1-multi-method v1-method v1-user v1-host) + copy-program (tramp-get-method-parameter + v1-multi-method method + v1-user v1-host 'tramp-copy-program) + copy-args (tramp-get-method-parameter + v1-multi-method method + v1-user v1-host 'tramp-copy-args))) + (setq v1-localname filename)) + + (if t2 + (with-parsed-tramp-file-name newname l + (setq v2-multi-method l-multi-method + v2-method l-method + v2-user l-user + v2-host l-host + v2-localname l-localname + method (tramp-find-method + v2-multi-method v2-method v2-user v2-host) + copy-program (tramp-get-method-parameter + v2-multi-method method + v2-user v2-host 'tramp-copy-program) + copy-args (tramp-get-method-parameter + v2-multi-method method + v2-user v2-host 'tramp-copy-args))) + (setq v2-localname newname)) + + ;; The following should be changed. We need a more general + ;; mechanism to parse extra host args. + (if (not t1) + (setq source v1-localname) + (when (string-match "\\([^#]*\\)#\\(.*\\)" v1-host) + (setq copy-args (cons "-P" (cons (match-string 2 v1-host) copy-args))) + (setq v1-host (match-string 1 v1-host))) + (setq source + (tramp-make-copy-program-file-name + v1-user v1-host + (tramp-shell-quote-argument v1-localname)))) + + (if (not t2) + (setq target v2-localname) + (when (string-match "\\([^#]*\\)#\\(.*\\)" v2-host) + (setq copy-args (cons "-P" (cons (match-string 2 v2-host) copy-args))) + (setq v2-host (match-string 1 v2-host))) + (setq target + (tramp-make-copy-program-file-name + v2-user v2-host + (tramp-shell-quote-argument v2-localname)))) + + ;; Handle keep-date argument + (when keep-date + (if t1 + (setq copy-args + (cons (tramp-get-method-parameter + v1-multi-method method + v1-user v1-host 'tramp-copy-keep-date-arg) + copy-args)) + (setq copy-args + (cons (tramp-get-method-parameter + v2-multi-method method + v2-user v2-host 'tramp-copy-keep-date-arg) + copy-args)))) + + (setq copy-args (append copy-args (list source target))) + + ;; Use rcp-like program for file transfer. + (tramp-message + 5 "Transferring %s to file %s..." filename newname) + (save-excursion (set-buffer trampbuf) (erase-buffer)) + (unless (equal + 0 + (apply #'call-process copy-program + nil trampbuf nil copy-args)) + (pop-to-buffer trampbuf) + (error + (concat + "tramp-do-copy-or-rename-file-out-of-band: `%s' didn't work, " + "see buffer `%s' for details") + copy-program trampbuf)) + (tramp-message + 5 "Transferring %s to file %s...done" filename newname) + + ;; If the operation was `rename', delete the original file. + (unless (eq op 'copy) + (delete-file filename)))) ;; mkdir (defun tramp-handle-make-directory (dir &optional parents) @@ -2745,7 +2955,6 @@ (and (tramp-handle-file-exists-p filename) (error "Failed to recusively delete %s" filename)))) - (defun tramp-handle-dired-call-process (program discard &rest arguments) "Like `dired-call-process' for tramp files." (with-parsed-tramp-file-name default-directory nil @@ -2767,6 +2976,59 @@ (tramp-send-command-and-check multi-method method user host nil) (tramp-send-command multi-method method user host "cd") (tramp-wait-for-output))))) + +(defun tramp-handle-dired-compress-file (file &rest ok-flag) + "Like `dired-compress-file' for tramp files." + ;; OK-FLAG is valid for XEmacs only, but not implemented. + ;; Code stolen mainly from dired-aux.el. + (with-parsed-tramp-file-name file nil + (save-excursion + (let ((suffixes + (if (not (featurep 'xemacs)) + ;; Emacs case + (symbol-value 'dired-compress-file-suffixes) + ;; XEmacs has `dired-compression-method-alist', which is + ;; transformed into `dired-compress-file-suffixes' structure. + (mapcar + '(lambda (x) + (list (concat (regexp-quote (nth 1 x)) "\\'") + nil + (mapconcat 'identity (nth 3 x) " "))) + (symbol-value 'dired-compression-method-alist)))) + suffix) + ;; See if any suffix rule matches this file name. + (while suffixes + (let (case-fold-search) + (if (string-match (car (car suffixes)) localname) + (setq suffix (car suffixes) suffixes nil)) + (setq suffixes (cdr suffixes)))) + + (cond ((file-symlink-p file) + nil) + ((and suffix (nth 2 suffix)) + ;; We found an uncompression rule. + (message "Uncompressing %s..." file) + (when (zerop (tramp-send-command-and-check + multi-method method user host + (concat (nth 2 suffix) " " localname))) + (message "Uncompressing %s...done" file) + (dired-remove-file file) + (string-match (car suffix) file) + (concat (substring file 0 (match-beginning 0))))) + (t + ;; We don't recognize the file as compressed, so compress it. + ;; Try gzip. + (message "Compressing %s..." file) + (when (zerop (tramp-send-command-and-check + multi-method method user host + (concat "gzip -f " localname))) + (message "Compressing %s...done" file) + (dired-remove-file file) + (cond ((file-exists-p (concat file ".gz")) + (concat file ".gz")) + ((file-exists-p (concat file ".z")) + (concat file ".z")) + (t nil))))))))) ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm ;; not sure at all that this is the right way to do it, but let's hope @@ -2961,17 +3223,40 @@ ;; Remote commands. +(defvar tramp-async-proc nil + "Global variable keeping asyncronous process object. +Used in `tramp-handle-shell-command'") + (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for tramp files. This will break if COMMAND prints a newline, followed by the value of `tramp-end-of-output', followed by another newline." + ;; Asynchronous processes are far from being perfect. But it works at least + ;; for `find-grep-dired' and `find-name-dired' in Emacs 21.4. (if (tramp-tramp-file-p default-directory) (with-parsed-tramp-file-name default-directory nil - (let (status) - (when (string-match "&[ \t]*\\'" command) - (error "Tramp doesn't grok asynchronous shell commands, yet")) -;; (when error-buffer -;; (error "Tramp doesn't grok optional third arg ERROR-BUFFER, yet")) + (let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + status) + (unless output-buffer + (setq output-buffer + (get-buffer-create + (if asynchronous + "*Async Shell Command*" + "*Shell Command Output*"))) + (set-buffer output-buffer) + (erase-buffer)) + (unless (bufferp output-buffer) + (setq output-buffer (current-buffer))) + (set-buffer output-buffer) + ;; Tramp doesn't handle the asynchronous case by an asynchronous + ;; process. Instead of, another asynchronous process is opened + ;; which gets the output of the (synchronous) Tramp process + ;; via process-filter. ERROR-BUFFER is disabled. + (when asynchronous + (setq command (substring command 0 (match-beginning 0)) + error-buffer nil + tramp-async-proc (start-process (buffer-name output-buffer) + output-buffer "cat"))) (save-excursion (tramp-barf-unless-okay multi-method method user host @@ -2979,23 +3264,39 @@ nil 'file-error "tramp-handle-shell-command: Couldn't `cd %s'" (tramp-shell-quote-argument localname)) + ;; Define the process filter + (when asynchronous + (set-process-filter + (get-buffer-process + (tramp-get-buffer multi-method method user host)) + '(lambda (process string) + ;; Write the output into the Tramp Process + (save-current-buffer + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert string)) + ;; Hand-over output to asynchronous process. + (let ((end + (string-match + (regexp-quote tramp-end-of-output) string))) + (when end + (setq string + (substring string 0 (1- (match-beginning 0))))) + (process-send-string tramp-async-proc string) + (when end + (set-process-filter process nil) + (process-send-eof tramp-async-proc)))))) + ;; Send the command (tramp-send-command multi-method method user host (if error-buffer (format "( %s ) 2>/tmp/tramp.$$.err; tramp_old_status=$?" command) - (format "%s ;tramp_old_status=$?" command))) - ;; This will break if the shell command prints "/////" - ;; somewhere. Let's just hope for the best... - (tramp-wait-for-output)) - (unless output-buffer - (setq output-buffer (get-buffer-create "*Shell Command Output*")) - (set-buffer output-buffer) - (erase-buffer)) - (unless (bufferp output-buffer) - (setq output-buffer (current-buffer))) - (set-buffer output-buffer) - (insert-buffer (tramp-get-buffer multi-method method user host)) + (format "%s; tramp_old_status=$?" command))) + (unless asynchronous + (tramp-wait-for-output))) + (unless asynchronous + (insert-buffer (tramp-get-buffer multi-method method user host))) (when error-buffer (save-excursion (unless (bufferp error-buffer) @@ -3010,17 +3311,19 @@ multi-method method user host "rm -f /tmp/tramp.$$.err"))) (save-excursion (tramp-send-command multi-method method user host "cd") - (tramp-wait-for-output) + (unless asynchronous + (tramp-wait-for-output)) (tramp-send-command multi-method method user host (concat "tramp_set_exit_status $tramp_old_status;" " echo tramp_exit_status $?")) - (tramp-wait-for-output) - (goto-char (point-max)) - (unless (search-backward "tramp_exit_status " nil t) - (error "Couldn't find exit status of `%s'" command)) - (skip-chars-forward "^ ") - (setq status (read (current-buffer)))) + (unless asynchronous + (tramp-wait-for-output) + (goto-char (point-max)) + (unless (search-backward "tramp_exit_status " nil t) + (error "Couldn't find exit status of `%s'" command)) + (skip-chars-forward "^ ") + (setq status (read (current-buffer))))) (unless (zerop (buffer-size)) (display-buffer output-buffer)) status)) @@ -3041,16 +3344,7 @@ (defun tramp-handle-file-local-copy (filename) "Like `file-local-copy' for tramp files." (with-parsed-tramp-file-name filename nil - (let ((output-buf (get-buffer-create "*tramp output*")) - (tramp-buf (tramp-get-buffer multi-method method user host)) - (copy-program (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-program)) - (copy-args (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-args)) + (let ((tramp-buf (tramp-get-buffer multi-method method user host)) ;; We used to bind the following as late as possible. ;; loc-enc and loc-dec were bound directly before the if ;; statement that checks them. But the functions @@ -3066,37 +3360,12 @@ (error "Cannot make local copy of non-existing file `%s'" filename)) (setq tmpfil (tramp-make-temp-file)) - (cond (copy-program - ;; The following should be changed. We need a more general - ;; mechanism to parse extra host args. - (when (string-match "\\([^#]*\\)#\\(.*\\)" host) - (setq copy-args (cons "-p" (cons (match-string 2 host) - rsh-args))) - (setq host (match-string 1 host))) - ;; Use rcp-like program for file transfer. - (tramp-message-for-buffer - multi-method method user host - 5 "Fetching %s to tmp file %s..." filename tmpfil) - (save-excursion (set-buffer output-buf) (erase-buffer)) - (unless (equal - 0 - (apply #'call-process - copy-program - nil output-buf nil - (append copy-args - (list - (tramp-make-copy-program-file-name - user host - (tramp-shell-quote-argument localname)) - tmpfil)))) - (pop-to-buffer output-buf) - (error - (concat "tramp-handle-file-local-copy: `%s' didn't work, " - "see buffer `%s' for details") - copy-program output-buf)) - (tramp-message-for-buffer - multi-method method user host - 5 "Fetching %s to tmp file %s...done" filename tmpfil)) + + + (cond ((tramp-method-out-of-band-p multi-method method user host) + ;; `copy-file' handles out-of-band methods + (copy-file filename tmpfil t t)) + ((and rem-enc rem-dec) ;; Use inline encoding for file transfer. (save-excursion @@ -3225,14 +3494,6 @@ (error "File not overwritten"))) (with-parsed-tramp-file-name filename nil (let ((curbuf (current-buffer)) - (copy-program (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-program)) - (copy-args (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-args)) (rem-enc (tramp-get-remote-encoding multi-method method user host)) (rem-dec (tramp-get-remote-decoding multi-method method user host)) (loc-enc (tramp-get-local-encoding multi-method method user host)) @@ -3267,44 +3528,10 @@ ;; decoding command must be specified. However, if the method ;; _also_ specifies an encoding function, then that is used for ;; encoding the contents of the tmp file. - (cond (copy-program - ;; The following should be changed. We need a more general - ;; mechanism to parse extra host args. - (when (string-match "\\([^#]*\\)#\\(.*\\)" host) - (setq copy-args (cons "-p" (cons (match-string 2 host) - rsh-args))) - (setq host (match-string 1 host))) - - ;; use rcp-like program for file transfer - (let ((argl (append copy-args - (list - tmpfil - (tramp-make-copy-program-file-name - user host - (tramp-shell-quote-argument localname)))))) - (tramp-message-for-buffer - multi-method method user host - 6 "Writing tmp file using `%s'..." copy-program) - (save-excursion (set-buffer trampbuf) (erase-buffer)) - (when tramp-debug-buffer - (save-excursion - (set-buffer (tramp-get-debug-buffer multi-method - method user host)) - (goto-char (point-max)) - (tramp-insert-with-face - 'bold (format "$ %s %s\n" copy-program - (mapconcat 'identity argl " "))))) - (unless (equal 0 - (apply #'call-process - copy-program nil trampbuf nil argl)) - (pop-to-buffer trampbuf) - (error - "Cannot write region to file `%s', command `%s' failed" - filename copy-program)) - (tramp-message-for-buffer - multi-method method user host - 6 "Transferring file using `%s'...done" - copy-program))) + (cond ((tramp-method-out-of-band-p multi-method method user host) + ;; `copy-file' handles out-of-band methods + (copy-file tmpfil filename t t)) + ((and rem-enc rem-dec) ;; Use inline file transfer (let ((tmpbuf (get-buffer-create " *tramp file transfer*"))) @@ -3319,7 +3546,8 @@ (progn (tramp-message-for-buffer multi-method method user host - 6 "Encoding region using function...") + 6 "Encoding region using function `%s'..." + (symbol-name loc-enc)) (insert-file-contents-literally tmpfil) ;; CCC. The following `let' is a workaround for ;; the base64.el that comes with pgnus-0.84. If @@ -3685,11 +3913,12 @@ ;; shouldn't have partial tramp file name syntax. Maybe another variable should ;; be introduced overwriting this check in such cases. Or we change tramp ;; file name syntax in order to avoid ambiguities, like in XEmacs ... -;; In case of XEmacs it can be always true (and wouldn't be necessary). +;; In case of non unified file names it can be always true (and wouldn't be +;; necessary, because there are different regexp). (defun tramp-completion-mode (file) "Checks whether method / user name / host name completion is active." (cond - ((featurep 'xemacs) t) + ((not tramp-unified-filenames) t) ((string-match "^/.*:.*:$" file) nil) ((string-match (concat tramp-prefix-regexp @@ -3697,11 +3926,21 @@ file) (member (match-string 1 file) (mapcar 'car tramp-methods))) ((or (equal last-input-event 'tab) + ;; Emacs (and (integerp last-input-event) (not (event-modifiers last-input-event)) (or (char-equal last-input-event ?\?) (char-equal last-input-event ?\t) ; handled by 'tab already? - (char-equal last-input-event ?\ )))) + (char-equal last-input-event ?\ ))) + ;; XEmacs + (and (featurep 'xemacs) + (not (event-modifiers last-input-event)) + (or (char-equal + (funcall 'event-to-character last-input-event) ?\?) + (char-equal + (funcall 'event-to-character last-input-event) ?\t) + (char-equal + (funcall 'event-to-character last-input-event) ?\ )))) t))) (defun tramp-completion-handle-file-exists-p (filename) @@ -4050,6 +4289,35 @@ (forward-line 1)) result)) +(defun tramp-parse-shostkeys (dirname) + "Return a list of (user host) tuples allowed to access. +User is always nil." + + (let ((regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")) + (files (when (file-directory-p dirname) (directory-files dirname))) + result) + + (while files + (when (string-match regexp (car files)) + (push (list nil (match-string 1 (car files))) result)) + (setq files (cdr files))) + result)) + +(defun tramp-parse-sknownhosts (dirname) + "Return a list of (user host) tuples allowed to access. +User is always nil." + + (let ((regexp (concat "^\\(" tramp-host-regexp + "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")) + (files (when (file-directory-p dirname) (directory-files dirname))) + result) + + (while files + (when (string-match regexp (car files)) + (push (list nil (match-string 1 (car files))) result)) + (setq files (cdr files))) + result)) + (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -4206,14 +4474,29 @@ (or switch "") (tramp-shell-quote-argument localname2)))))) +(defun tramp-touch (file time) + "Set the last-modified timestamp of the given file. +TIME is an Emacs internal time value as returned by `current-time'." + (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time))) + (with-parsed-tramp-file-name file nil + (let ((buf (tramp-get-buffer multi-method method user host))) + (unless (zerop (tramp-send-command-and-check + multi-method method user host + (format "touch -t %s %s" + touch-time + localname))) + (pop-to-buffer buf) + (error "tramp-touch: touch failed, see buffer `%s' for details" + buf)))))) + (defun tramp-buffer-name (multi-method method user host) "A name for the connection buffer for USER at HOST using METHOD." (if multi-method (tramp-buffer-name-multi-method "tramp" multi-method method user host) (let ((method (tramp-find-method multi-method method user host))) (if user - (format "*tramp/%s %s@%s*" method user host)) - (format "*tramp/%s %s*" method host)))) + (format "*tramp/%s %s@%s*" method user host) + (format "*tramp/%s %s*" method host))))) (defun tramp-buffer-name-multi-method (prefix multi-method method user host) "A name for the multi method connection buffer. @@ -4482,11 +4765,6 @@ (defun tramp-action-password (p multi-method method user host) "Query the user for a password." (let ((pw-prompt (match-string 0))) - (when (tramp-method-out-of-band-p multi-method method user host) - (kill-process (get-buffer-process (current-buffer))) - (error (concat "Out of band method `%s' not applicable " - "for remote shell asking for a password") - method)) (tramp-message 9 "Sending password") (tramp-enter-password p pw-prompt))) @@ -4597,6 +4875,7 @@ p multi-method method user host actions) nil))) (unless (eq exit 'ok) + (tramp-clear-passwd user host) (error "Login failed")))) ;; For multi-actions. @@ -4632,6 +4911,7 @@ (tramp-process-one-multi-action p method user host actions) nil))) (unless (eq exit 'ok) + (tramp-clear-passwd user host) (error "Login failed")))) ;; Functions to execute when we have seen the remote shell prompt but @@ -4768,7 +5048,7 @@ ;; The following should be changed. We need a more general ;; mechanism to parse extra host args. (when (string-match "\\([^#]*\\)#\\(.*\\)" host) - (setq login-args (cons "-p" (cons (match-string 2 host) rsh-args))) + (setq login-args (cons "-p" (cons (match-string 2 host) login-args))) (setq host (match-string 1 host))) (setenv "TERM" tramp-terminal-type) (let* ((default-directory (tramp-temporary-file-directory)) @@ -5308,10 +5588,7 @@ " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n" "}")) (tramp-wait-for-output) - (unless (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-program) + (unless (tramp-method-out-of-band-p multi-method method user host) (tramp-message 5 "Sending the Perl `mime-encode' implementations.") (tramp-send-string multi-method method user host @@ -5350,10 +5627,7 @@ (tramp-set-connection-property "ln" ln multi-method method user host))) (erase-buffer) ;; Find the right encoding/decoding commands to use. - (unless (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-copy-program) + (unless (tramp-method-out-of-band-p multi-method method user host) (tramp-find-inline-encoding multi-method method user host)) ;; If encoding/decoding command are given, test to see if they work. ;; CCC: Maybe it would be useful to run the encoder both locally and @@ -5566,11 +5840,12 @@ (unless (and p (processp p) (memq (process-status p) '(run open))) (when (and p (processp p)) (delete-process p)) - (funcall (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-connection-function) - multi-method method user host)))) + (let ((process-connection-type tramp-process-connection-type)) + (funcall (tramp-get-method-parameter + multi-method + (tramp-find-method multi-method method user host) + user host 'tramp-connection-function) + multi-method method user host))))) (defun tramp-send-command (multi-method method user host command &optional noerase neveropen) @@ -6223,10 +6498,28 @@ (defun tramp-read-passwd (prompt) "Read a password from user (compat function). -Invokes `read-passwd' if that is defined, else `ange-ftp-read-passwd'." - (apply - (if (fboundp 'read-passwd) #'read-passwd #'ange-ftp-read-passwd) - (list prompt))) +Invokes `password-read' if available, `read-passwd' else." + (if (functionp 'password-read) + (let* ((user (or tramp-current-user (user-login-name))) + (host (or tramp-current-host (system-name))) + (key (concat user "@" host)) + (password (apply #'password-read (list prompt key)))) + (apply #'password-cache-add (list key password)) + password) + (read-passwd prompt))) + +(defun tramp-clear-passwd (&optional user host) + "Clear password cache for connection related to current-buffer." + (interactive) + (let ((filename (or buffer-file-name list-buffers-directory ""))) + (when (and (functionp 'password-cache-remove) + (or (and user host) (tramp-tramp-file-p filename))) + (let* ((v (when (tramp-tramp-file-p filename) + (tramp-dissect-file-name filename))) + (luser (or user (tramp-file-name-user v) (user-login-name))) + (lhost (or host (tramp-file-name-host v) (system-name))) + (key (concat luser "@" lhost))) + (apply #'password-cache-remove (list key)))))) (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. @@ -6477,7 +6770,6 @@ ;;; TODO: -;; * tramp-copy-keep-date-arg is not used! ;; * Allow putting passwords in the filename. ;; This should be implemented via a general mechanism to add ;; parameters in filenames. There is currently a kludge for
--- a/lisp/net/trampver.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/net/trampver.el Mon Mar 01 14:27:16 2004 +0000 @@ -30,7 +30,7 @@ ;; are auto-frobbed from configure.ac, so you should edit that file and run ;; "autoconf && ./configure" to change them. -(defconst tramp-version "2.0.38" +(defconst tramp-version "2.0.39" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
--- a/lisp/progmodes/ebnf-abn.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/progmodes/ebnf-abn.el Mon Mar 01 14:27:16 2004 +0000 @@ -4,7 +4,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/02/23 22:38:59 vinicius> +;; Time-stamp: <2004/02/28 17:40:41 vinicius> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.0 @@ -41,6 +41,8 @@ ;; ----------- ;; ;; See the URL: +;; `http://www.ietf.org/rfc/rfc2234.txt' +;; or ;; `http://www.faqs.org/rfcs/rfc2234.html' ;; or ;; `http://www.rnp.br/ietf/rfc/rfc2234.txt'
--- a/lisp/progmodes/ebnf-bnf.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/progmodes/ebnf-bnf.el Mon Mar 01 14:27:16 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/02/22 14:25:06 vinicius> +;; Time-stamp: <2004/02/28 18:25:52 vinicius> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.8 @@ -54,7 +54,10 @@ ;; C D sequence (C occurs before D) ;; C | D alternative (C or D occurs) ;; A - B exception (A excluding B, B without any non-terminal) -;; n * A repetition (A repeats n (integer) times) +;; n * A repetition (A repeats at least n (integer) times) +;; n * n A repetition (A repeats exactly n (integer) times) +;; n * m A repetition (A repeats at least n (integer) and at most +;; m (integer) times) ;; (C) group (expression C is grouped together) ;; [C] optional (C may or not occurs) ;; C+ one or more occurrences of C @@ -78,7 +81,7 @@ ;; ;; exception = repeat [ "-" repeat]. ;; exception ;; -;; repeat = [ integer "*" ] term. ;; repetition +;; repeat = [ integer "*" [ integer ]] term. ;; repetition ;; ;; term = factor ;; | [factor] "+" ;; one-or-more @@ -96,14 +99,30 @@ ;; . ;; ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+". +;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper +;; ;; and lower), 8-bit accentuated characters, +;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":", +;; ;; "<", ">", "@", "\", "^", "_", "`" and "~". ;; ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+". +;; ;; that is, a valid terminal accepts any printable character (including +;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a +;; ;; terminal. Also, accepts escaped characters, that is, a character +;; ;; pair starting with `\' followed by a printable character, for +;; ;; example: \", \\. ;; -;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*". +;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*". +;; ;; that is, a valid special accepts any printable character (including +;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to +;; ;; delimit a special. ;; ;; integer = "[0-9]+". +;; ;; that is, an integer is a sequence of one or more decimal digits. ;; ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n". +;; ;; that is, a comment starts with the character `;' and terminates at end +;; ;; of line. Also, it only accepts printable characters (including 8-bit +;; ;; accentuated characters) and tabs. ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -234,15 +253,20 @@ )))) -;;; repeat = [ integer "*" ] term. +;;; repeat = [ integer "*" [ integer ]] term. (defun ebnf-repeat (token) (if (not (eq token 'integer)) (ebnf-term token) - (let ((times ebnf-bnf-lex)) + (let ((times ebnf-bnf-lex) + upper) (or (eq (ebnf-bnf-lex) 'repeat) (error "Missing `*'")) - (ebnf-token-repeat times (ebnf-term (ebnf-bnf-lex)))))) + (setq token (ebnf-bnf-lex)) + (when (eq token 'integer) + (setq upper ebnf-bnf-lex + token (ebnf-bnf-lex))) + (ebnf-token-repeat times (ebnf-term token) upper)))) ;;; term = factor
--- a/lisp/progmodes/ebnf2ps.el Sat Feb 28 04:52:40 2004 +0000 +++ b/lisp/progmodes/ebnf2ps.el Mon Mar 01 14:27:16 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/02/25 20:17:43 vinicius> +;; Time-stamp: <2004/02/29 14:06:59 vinicius> ;; Keywords: wp, ebnf, PostScript ;; Version: 4.0 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ @@ -28,7 +28,7 @@ ;; Boston, MA 02111-1307, USA. (defconst ebnf-version "4.0" - "ebnf2ps.el, v 4.0 <2004/02/24 vinicius> + "ebnf2ps.el, v 4.0 <2004/02/28 vinicius> Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. @@ -70,8 +70,8 @@ ;; Using ebnf2ps ;; ------------- ;; -;; ebnf2ps provides six commands for generating PostScript syntactic chart -;; images of Emacs buffers: +;; ebnf2ps provides the following commands for generating PostScript syntactic +;; chart images of Emacs buffers: ;; ;; ebnf-print-directory ;; ebnf-print-file @@ -193,7 +193,10 @@ ;; C D sequence (C occurs before D) ;; C | D alternative (C or D occurs) ;; A - B exception (A excluding B, B without any non-terminal) -;; n * A repetition (A repeats n (integer) times) +;; n * A repetition (A repeats at least n (integer) times) +;; n * n A repetition (A repeats exactly n (integer) times) +;; n * m A repetition (A repeats at least n (integer) and at most +;; m (integer) times) ;; (C) group (expression C is grouped together) ;; [C] optional (C may or not occurs) ;; C+ one or more occurrences of C @@ -217,7 +220,7 @@ ;; ;; exception = repeat [ "-" repeat]. ;; exception ;; -;; repeat = [ integer "*" ] term. ;; repetition +;; repeat = [ integer "*" [ integer ]] term. ;; repetition ;; ;; term = factor ;; | [factor] "+" ;; one-or-more @@ -302,7 +305,7 @@ ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. ;; ;; `abnf' ebnf2ps recognizes the syntax described in the URL: -;; `http://www.faqs.org/rfcs/rfc2234.html' +;; `http://www.ietf.org/rfc/rfc2234.txt' ;; ("Augmented BNF for Syntax Specifications: ABNF"). ;; ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: @@ -514,6 +517,12 @@ ;; ;; `ebnf-setup' returns the current setup. ;; +;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the +;; given directory. +;; +;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given +;; file. +;; ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current ;; buffer. ;; @@ -522,8 +531,9 @@ ;; ;; `ebnf-customize' activates a customization buffer for ebnf2ps options. ;; -;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound -;; to keys in the same way as `ebnf-' commands. +;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer', +;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same +;; way as `ebnf-' commands. ;; ;; ;; Hooks @@ -1654,7 +1664,7 @@ `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. `abnf' ebnf2ps recognizes the syntax described in the URL: - `http://www.faqs.org/rfcs/rfc2234.html' + `http://www.ietf.org/rfc/rfc2234.txt' (\"Augmented BNF for Syntax Specifications: ABNF\"). `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: @@ -2061,6 +2071,34 @@ ;;;###autoload +(defun ebnf-syntax-directory (&optional directory) + "Does a syntactic analysis of the files in DIRECTORY. + +If DIRECTORY is nil, it's used `default-directory'. + +The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are +processed. + +See also `ebnf-syntax-buffer'." + (interactive + (list (read-file-name "Directory containing EBNF files (syntax): " + nil default-directory))) + (ebnf-directory 'ebnf-syntax-buffer directory)) + + +;;;###autoload +(defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done) + "Does a syntactic analysis of the FILE. + +If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't +killed after syntax checking. + +See also `ebnf-syntax-buffer'." + (interactive "fEBNF file to check syntax: ") + (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done)) + + +;;;###autoload (defun ebnf-syntax-buffer () "Does a syntactic analysis of the current buffer." (interactive)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/thumbs.el Mon Mar 01 14:27:16 2004 +0000 @@ -0,0 +1,737 @@ +;;; thumbs.el --- Thumbnails previewer for images files +;;; +;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca> +;; +;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some time +;; The peoples at #emacs@freenode.net for numerous help +;; RMS for emacs and the GNU project. +;; +;; Keywords: Multimedia + +(defconst thumbs-version "2.0") + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package create two new mode: thumbs-mode and +;; thumbs-view-image-mode. It is used for images browsing and viewing +;; from within emacs. Minimal image manipulation functions are also +;; available via external programs. +;; +;; The 'convert' program from 'ImageMagick' +;; [URL:http://www.imagemagick.org/] is required. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; CHANGELOG +;; +;; This is version 2.0 +;; +;; USAGE +;; +;; Type M-x thumbs RET DIR RET to view the directory DIR in Thumbs mode. +;; That should be a directory containing image files. +;; from dired, C-t m enter in thumbs-mode with all marked files +;; C-t a enter in thumbs-mode with all files in current-directory +;; In thumbs-mode, pressing <return> on a image will bring you in image view mode +;; for that image. C-h m will give you a list of available keybinding. + +;;; History: +;; + +;;; Code: + +(require 'dired) + +;; Abort if in-line imaging isn't supported (i.e. Emacs-20.7) + +(when (not (display-images-p)) + (error "Your Emacs version (%S) doesn't support in-line images, +was not compiled with image support or is run in console mode. +Upgrade to Emacs 21.1 or newer, compile it with image support +or use a window-system" + emacs-version)) + +;; CUSTOMIZATIONS + +(defgroup thumbs nil + "Thumbnails previewer." + :group 'multimedia) + +(defcustom thumbs-thumbsdir + (expand-file-name "~/.emacs-thumbs") + "*Directory to store thumbnails." + :type 'directory + :group 'thumbs) + +(defcustom thumbs-geometry "100x100" + "*Size of thumbnails." + :type 'string + :group 'thumbs) + +(defcustom thumbs-per-line 5 + "*Number of thumbnails per line to show in directory." + :type 'string + :group 'thumbs) + +(defcustom thumbs-thumbsdir-max-size 50000000 + "Max size for thumbnails directory. +When it reach that size (in bytes), a warning is send." + :type 'string + :group 'thumbs) + +(defcustom thumbs-conversion-program + (if (equal 'windows-nt system-type) + "convert.exe" + (or (executable-find "convert") + "/usr/X11R6/bin/convert")) + "*Name of conversion program for thumbnails generation. +It must be 'convert'." + :type 'string + :group 'thumbs) + +(defcustom thumbs-setroot-command + "xloadimage -onroot -fullscreen *" + "Command to set the root window." + :type 'string + :group 'thumbs) + +(defcustom thumbs-relief 5 + "*Size of button-like border around thumbnails." + :type 'string + :group 'thumbs) + +(defcustom thumbs-margin 2 + "*Size of the margin around thumbnails. +This is where you see the cursor." + :type 'string + :group 'thumbs) + +(defcustom thumbs-thumbsdir-auto-clean t + "If set, delete older file in the thumbnails directory. +Deletion is done at load time when the directory size is bigger +than 'thumbs-thumbsdir-max-size'." + :type 'boolean + :group 'thumbs) + +(defcustom thumbs-image-resizing-step 10 + "Step by wich to resize image." + :type 'string + :group 'thumbs) + +(defcustom thumbs-temp-dir + "/tmp/" + "Temporary directory to use. +Leaving it to default '/tmp/' can let another user +see some of your images." + :type 'directory + :group 'thumbs) + +(defcustom thumbs-temp-prefix "emacsthumbs" + "Prefix to add to temp files." + :type 'string + :group 'thumbs) + +;; Initialize some variable, for later use. +(defvar thumbs-temp-file + (concat thumbs-temp-dir thumbs-temp-prefix) + "Temporary filesname for images.") + +(defvar thumbs-current-tmp-filename + nil + "Temporary filename of current image.") +(defvar thumbs-current-image-filename + nil + "Filename of current image.") +(defvar thumbs-current-image-size + nil + "Size of current image.") +(defvar thumbs-image-num + nil + "Number of current image.") +(defvar thumbs-current-dir + nil + "Current directory.") +(defvar thumbs-markedL + nil + "List of marked files.") + +;; Make sure auto-image-file-mode is ON. +(auto-image-file-mode t) + +;; Create the thumbs directory if it does not exists. +(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir)) + +(when (not (file-directory-p thumbs-thumbsdir)) + (progn + (make-directory thumbs-thumbsdir) + (message "Creating thumbnails directory"))) + +(when (not (fboundp 'ignore-errors)) + (defmacro ignore-errors (&rest body) + "Execute FORMS; if anz error occurs, return nil. +Otherwise, return result of last FORM." + (let ((err (thumbs-gensym))) + (list 'condition-case err (cons 'progn body) '(error nil))))) + +(when (not (fboundp 'time-less-p)) + (defun time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2)))))) + +(when (not (fboundp 'caddar)) + (defun caddar (x) + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (car (cdr (cdr (car x)))))) + +(defvar thumbs-gensym-counter 0) + +(defun thumbs-gensym (&optional arg) + "Generate a new uninterned symbol. +The name is made by appending a number to PREFIX, default \"Thumbs\"." + (let ((prefix (if (stringp arg) arg "Thumbs")) + (num (if (integerp arg) arg + (prog1 + thumbs-gensym-counter + (setq thumbs-gensym-counter (1+ thumbs-gensym-counter)))))) + (make-symbol (format "%s%d" prefix num)))) + +(defun thumbs-cleanup-thumbsdir () + "Clean the thumbnails directory. +If the total size of all files in 'thumbs-thumbsdir' is bigger than +'thumbs-thumbsdir-max-size', files are deleted until the max size is +reached." + (let* ((filesL + (sort + (mapcar + (lambda (f) + (let ((fattribsL (file-attributes f))) + `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f))) + (directory-files thumbs-thumbsdir t (image-file-name-regexp))) + '(lambda (l1 l2) (time-less-p (car l1)(car l2))))) + (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL)))) + (while (> dirsize thumbs-thumbsdir-max-size) + (progn + (message "Deleting file %s" (caddar filesL))) + (delete-file (caddar filesL)) + (setq dirsize (- dirsize (cadar filesL))) + (setq filesL (cdr filesL))))) + +;; Check the thumbsnail directory size and clean it if necessary. +(when thumbs-thumbsdir-auto-clean + (thumbs-cleanup-thumbsdir)) + +(defun thumbs-call-convert (filein fileout action + &optional arg output-format action-prefix) + "Call the convert program. +FILEIN is the input file, +FILEOUT is the output file, +ACTION is the command to send to convert. +Optional argument are: +ARG any arguments to the ACTION command, +OUTPUT-FORMAT is the file format to output, default is jpeg +ACTION-PREFIX is the symbol to place before the ACTION command + (default to '-' but can sometime be '+')." + (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\"" + thumbs-conversion-program + (or action-prefix "-") + action + (or arg "") + filein + (or output-format "jpeg") + fileout))) + (shell-command command))) + +(defun thumbs-increment-image-size-element (n d) + "Increment number N by D percent." + (round (+ n (/ (* d n) 100)))) + +(defun thumbs-decrement-image-size-element (n d) + "Decrement number N by D percent." + (round (- n (/ (* d n) 100)))) + +(defun thumbs-increment-image-size (s) + "Increment S (a cons of width x heigh)." + (cons + (thumbs-increment-image-size-element (car s) + thumbs-image-resizing-step) + (thumbs-increment-image-size-element (cdr s) + thumbs-image-resizing-step))) + +(defun thumbs-decrement-image-size (s) + "Decrement S (a cons of width x heigh)." + (cons + (thumbs-decrement-image-size-element (car s) + thumbs-image-resizing-step) + (thumbs-decrement-image-size-element (cdr s) + thumbs-image-resizing-step))) + +(defun thumbs-resize-image (&optional increment size) + "Resize image in current buffer. +if INCREMENT is set, make the image bigger, else smaller. +Or, alternatively, a SIZE may be specified." + (interactive) + ;; cleaning of old temp file + (ignore-errors + (apply 'delete-file + (directory-files + thumbs-temp-dir t + thumbs-temp-prefix))) + (let ((buffer-read-only nil) + (x (if size + size + (if increment + (thumbs-increment-image-size + thumbs-current-image-size) + (thumbs-decrement-image-size + thumbs-current-image-size)))) + (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) + (erase-buffer) + (thumbs-call-convert thumbs-current-image-filename + tmp "sample" + (concat (number-to-string (car x)) "x" + (number-to-string (cdr x)))) + (thumbs-insert-image tmp 'jpeg 0) + (setq thumbs-current-tmp-filename tmp))) + +(defun thumbs-resize-interactive (width height) + "Resize Image interactively to specified WIDTH and HEIGHT." + (interactive "nWidth: \nnHeight: ") + (thumbs-resize-image nil (cons width height))) + +(defun thumbs-resize-image-size-down () + "Resize image (smaller)." + (interactive) + (thumbs-resize-image nil)) + +(defun thumbs-resize-image-size-up () + "Resize image (bigger)." + (interactive) + (thumbs-resize-image t)) + +(defun thumbs-subst-char-in-string (orig rep string) + "Replace occurrences of character ORIG with character REP in STRING. +Return the resulting (new) string. -- (defun borowed to Dave Love)" + (let ((string (copy-sequence string)) + (l (length string)) + (i 0)) + (while (< i l) + (if (= (aref string i) orig) + (aset string i rep)) + (setq i (1+ i))) + string)) + +(defun thumbs-thumbname (img) + "Return a thumbnail name for the image IMG." + (concat thumbs-thumbsdir "/" + (thumbs-subst-char-in-string + ?\ ?\_ + (apply + 'concat + (split-string + (expand-file-name img) "/"))))) + +(defun thumbs-make-thumb (img) + "Create the thumbnail for IMG." + (let* ((fn (expand-file-name img)) + (tn (thumbs-thumbname img))) + (if (or (not (file-exists-p tn)) + (not (equal (thumbs-file-size tn) thumbs-geometry))) + (thumbs-call-convert fn tn "sample" thumbs-geometry)) + tn)) + +(defun thumbs-image-type (img) + "Return image type from filename IMG." + (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg) + ((string-match ".*\\.xpm\\'" img) 'xpm) + ((string-match ".*\\.xbm\\'" img) 'xbm) + ((string-match ".*\\.gif\\'" img) 'gif) + ((string-match ".*\\.bmp\\'" img) 'bmp) + ((string-match ".*\\.png\\'" img) 'png) + ((string-match ".*\\.tiff?\\'" img) 'tiff))) + +(defun thumbs-file-size (img) + (let ((i (image-size (find-image `((:type ,(thumbs-image-type img) :file ,img))) t))) + (concat (number-to-string (round (car i))) + "x" + (number-to-string (round (cdr i)))))) + +;;;###autoload +(defun thumbs-find-thumb (img) + "Display the thumbnail for IMG." + (interactive "f") + (find-file (thumbs-make-thumb img))) + +(defun thumbs-insert-image (img type relief &optional marked) + "Insert image IMG at point. +TYPE and RELIEF will be used in constructing the image; see `image' +in the emacs-lisp manual for further documentation. +if MARKED is non-nil, the image is marked." + (let ((i `(image :type ,type + :file ,img + :relief ,relief + :conversion ,(if marked 'disabled) + :margin ,thumbs-margin))) + (insert-image i) + (setq thumbs-current-image-size + (image-size i t)))) + +(defun thumbs-insert-thumb (img &optional marked) + "Insert the thumbnail for IMG at point. +if MARKED is non-nil, the image is marked" + (thumbs-insert-image + (thumbs-make-thumb img) 'jpeg thumbs-relief marked)) + +(defun thumbs-do-thumbs-insertion (L) + "Insert all thumbs in list L." + (setq thumbs-fileL nil) + (let ((i 0)) + (while L + (when (= 0 (mod (setq i (1+ i)) thumbs-per-line)) + (newline)) + (setq thumbs-fileL (cons (cons (point) + (car L)) + thumbs-fileL)) + (thumbs-insert-thumb (car L) + (member (car L) thumbs-markedL)) + (setq L (cdr L))))) + +(defun thumbs-show-thumbs-list (L &optional buffer-name same-window) + (funcall (if same-window 'switch-to-buffer 'pop-to-buffer) + (or buffer-name "*THUMB-View*")) + (let ((inhibit-read-only t)) + (erase-buffer) + (thumbs-mode) + (make-variable-buffer-local 'thumbs-fileL) + (setq thumbs-fileL nil) + (thumbs-do-thumbs-insertion L) + (goto-char (point-min)) + (setq thumbs-current-dir default-directory) + (make-variable-buffer-local 'thumbs-current-dir))) + +;;;###autoload +(defun thumbs-show-all-from-dir (dir &optional reg same-window) + "Make a preview buffer for all images in DIR. +Optional argument REG to select file matching a regexp, +and SAME-WINDOW to show thumbs in the same window." + (interactive "DDir: ") + (thumbs-show-thumbs-list + (directory-files dir t + (or reg (image-file-name-regexp))) + (concat "*Thumbs: " dir) same-window)) + +;;;###autoload +(defun thumbs-dired-show-marked () + "In Dired, make a thumbs buffer with all marked files." + (interactive) + (thumbs-show-thumbs-list (dired-get-marked-files) nil t)) + +;;;###autoload +(defun thumbs-dired-show-all () + "In dired, make a thumbs buffer with all files in current directory." + (interactive) + (thumbs-show-all-from-dir default-directory nil t)) + +;;;###autoload +(defalias 'thumbs 'thumbs-show-all-from-dir) + +(defun thumbs-find-image (img L &optional num otherwin) + (funcall + (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer) + (concat "*Image: " (file-name-nondirectory img) " - " + (number-to-string (or num 0)) "*")) + (thumbs-view-image-mode) + (let ((inhibit-read-only t)) + (setq thumbs-current-image-filename img + thumbs-current-tmp-filename nil + thumbs-image-num (or num 0)) + (make-variable-buffer-local 'thumbs-current-image-filename) + (make-variable-buffer-local 'thumbs-current-tmp-filename) + (make-variable-buffer-local 'thumbs-current-image-size) + (make-variable-buffer-local 'thumbs-image-num) + (make-variable-buffer-local 'thumbs-fileL) + (setq thumbs-fileL L) + (delete-region (point-min)(point-max)) + (thumbs-insert-image img (thumbs-image-type img) 0))) + +(defun thumbs-find-image-at-point (&optional img otherwin) + "Display image IMG for thumbnail at point. +use another window it OTHERWIN is t." + (interactive) + (let* ((L thumbs-fileL) + (n (point)) + (i (or img (cdr (assoc n L))))) + (thumbs-find-image i L n otherwin))) + +(defun thumbs-find-image-at-point-other-window () + "Display image for thumbnail at point in the preview buffer. +Open another window." + (interactive) + (thumbs-find-image-at-point nil t)) + +(defun thumbs-call-setroot-command (img) + "Call the setroot program for IMG." + (run-hooks 'thumbs-before-setroot-hook) + (shell-command (replace-regexp-in-string + "\\*" + (shell-quote-argument (expand-file-name img)) + thumbs-setroot-command nil t)) + (run-hooks 'thumbs-after-setroot-hook)) + +(defun thumbs-set-image-at-point-to-root-window () + "Set the image at point as the desktop wallpaper." + (interactive) + (thumbs-call-setroot-command (cdr (assoc (point) thumbs-fileL)))) + +(defun thumbs-set-root () + "Set the current image as root." + (interactive) + (thumbs-call-setroot-command + (or thumbs-current-tmp-filename + thumbs-current-image-filename))) + +(defun thumbs-delete-images () + "Delete the image at point (and it's thumbnail) (or marked files if any)." + (interactive) + (let ((f (or thumbs-markedL (list (cdr (assoc (point) thumbs-fileL)))))) + (if (yes-or-no-p "Really delete %d files?" (length f)) + (progn + (mapcar (lambda (x) + (setq thumbs-fileL (delete (rassoc x thumbs-fileL) thumbs-fileL)) + (delete-file x) + (delete-file (thumbs-thumbname x))) f) + (thumbs-redraw-buffer))))) + +(defun thumbs-kill-buffer () + "Kill the current buffer." + (interactive) + (let ((buffer (current-buffer))) + (ignore-errors (delete-window (selected-window))) + (kill-buffer buffer))) + +(defun thumbs-show-image-num (num) + "Show the image with number NUM." + (let ((inhibit-read-only t)) + (delete-region (point-min)(point-max)) + (let ((i (cdr (assoc num thumbs-fileL)))) + (thumbs-insert-image i (thumbs-image-type i) 0) + (sleep-for 2) + (rename-buffer (concat "*Image: " + (file-name-nondirectory i) + " - " + (number-to-string num) "*"))) + (setq thumbs-image-num num + thumbs-current-image-filename i))) + +(defun thumbs-next-image () + "Show next image." + (interactive) + (let* ((i (1+ thumbs-image-num)) + (l (caar thumbs-fileL)) + (num + (cond ((assoc i thumbs-fileL) i) + ((>= i l) 1) + (t (1+ i))))) + (thumbs-show-image-num num))) + +(defun thumbs-previous-image () + "Show the previous image." + (interactive) + (let* ((i (- thumbs-image-num 1)) + (l (caar thumbs-fileL)) + (num + (cond ((assoc i thumbs-fileL) i) + ((<= i 1) l) + (t (- i 1))))) + (thumbs-show-image-num num))) + +(defun thumbs-redraw-buffer () + "Redraw the current thumbs buffer." + (let ((p (point)) + (inhibit-read-only t)) + (delete-region (point-min)(point-max)) + (thumbs-do-thumbs-insertion (reverse (mapcar 'cdr thumbs-fileL))) + (goto-char (1+ p)))) + +(defun thumbs-mark () + "Mark the image at point." + (interactive) + (setq thumbs-markedL (cons (cdr (assoc (point) thumbs-fileL)) thumbs-markedL)) + (let ((inhibit-read-only t)) + (delete-char 1) + (thumbs-insert-thumb (cdr (assoc (point) thumbs-fileL)) t)) + (when (eolp)(forward-char))) + +;; Image modification routines + +(defun thumbs-modify-image (action &optional arg) + "Call convert to do ACTION on image with argument ARG. +ACTION and ARG should be legal convert command." + (interactive "sAction: \nsValue: ") + ;; cleaning of old temp file + (mapc 'delete-file + (directory-files + thumbs-temp-dir + t + thumbs-temp-prefix)) + (let ((buffer-read-only nil) + (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) + (erase-buffer) + (thumbs-call-convert thumbs-current-image-filename + tmp + action + (or arg "")) + (thumbs-insert-image tmp 'jpeg 0) + (setq thumbs-current-tmp-filename tmp))) + +(defun thumbs-emboss-image (emboss) + "Emboss the image with value EMBOSS." + (interactive "nEmboss value: ") + (if (or (< emboss 3)(> emboss 31)(evenp emboss)) + (error "Arg must be a odd number between 3 and 31")) + (thumbs-modify-image "emboss" (number-to-string emboss))) + +(defun thumbs-monochrome-image () + "Turn the image to monochrome." + (interactive) + (thumbs-modify-image "monochrome")) + +(defun thumbs-negate-image () + "Negate the image." + (interactive) + (thumbs-modify-image "negate")) + +(defun thumbs-rotate-left () + "Rotate the image 90 degrees counter-clockwise." + (interactive) + (thumbs-modify-image "rotate" "270")) + +(defun thumbs-rotate-right () + "Rotate the image 90 degrees clockwise." + (interactive) + (thumbs-modify-image "rotate" "90")) + +(defun thumbs-forward-char () + "Move forward one image." + (interactive) + (forward-char) + (when (eolp)(forward-char)) + (thumbs-show-name)) + +(defun thumbs-backward-char () + "Move backward one image." + (interactive) + (forward-char -1) + (thumbs-show-name)) + +(defun thumbs-forward-line () + "Move down one line." + (interactive) + (forward-line 1) + (thumbs-show-name)) + +(defun thumbs-backward-line () + "Move up one line." + (interactive) + (forward-line -1) + (thumbs-show-name)) + +(defun thumbs-show-name () + "Show the name of the current file." + (interactive) + (let ((f (cdr (assoc (point) thumbs-fileL)))) + (message "%s [%s]" f (thumbs-file-size f)))) + +(defun thumbs-save-current-image () + "Save the current image." + (interactive) + (let ((f (or thumbs-current-tmp-filename + thumbs-current-image-filename)) + (sa (read-from-minibuffer "save file as: " + thumbs-current-image-filename))) + (copy-file f sa))) + +(defun thumbs-dired () + "Use `dired' on the current thumbs directory." + (interactive) + (dired thumbs-current-dir)) + +;; thumbs-mode + +(defvar thumbs-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [return] 'thumbs-find-image-at-point) + (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window) + (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window) + (define-key map [delete] 'thumbs-delete-images) + (define-key map [right] 'thumbs-forward-char) + (define-key map [left] 'thumbs-backward-char) + (define-key map [up] 'thumbs-backward-line) + (define-key map [down] 'thumbs-forward-line) + (define-key map "d" 'thumbs-dired) + (define-key map "m" 'thumbs-mark) + (define-key map "s" 'thumbs-show-name) + (define-key map "q" 'thumbs-kill-buffer) + map) + "Keymap for `thumbs-mode'.") + +(define-derived-mode thumbs-mode + fundamental-mode "thumbs" + "Preview images in a thumbnails buffer" + (make-variable-buffer-local 'thumbs-markedL) + (setq thumbs-markedL nil)) + +(defvar thumbs-view-image-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [prior] 'thumbs-previous-image) + (define-key map [next] 'thumbs-next-image) + (define-key map "-" 'thumbs-resize-image-size-down) + (define-key map "+" 'thumbs-resize-image-size-up) + (define-key map "<" 'thumbs-rotate-left) + (define-key map ">" 'thumbs-rotate-right) + (define-key map "e" 'thumbs-emboss-image) + (define-key map "r" 'thumbs-resize-interactive) + (define-key map "s" 'thumbs-save-current-image) + (define-key map "q" 'thumbs-kill-buffer) + (define-key map "w" 'thunbs-set-root) + map) + "Keymap for `thumbs-view-image-mode'.") + +;; thumbs-view-image-mode +(define-derived-mode thumbs-view-image-mode + fundamental-mode "image-view-mode") + +;;;###autoload +(defun thumbs-dired-setroot () + "In dired, Call the setroot program on the image at point." + (interactive) + (thumbs-call-setroot-command (dired-get-filename))) + +;; Modif to dired mode map +(define-key dired-mode-map "\C-ta" 'thumbs-dired-show-all) +(define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked) +(define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot) + +(provide 'thumbs) + +;;; thumbs.el ends here + + +;;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c
--- a/lispintro/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/lispintro/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,4 +1,9 @@ -2003-11-16 Kevin Ryde <user42@zip.com.au> +2004-02-29 Juanma Barranquero <lektu@terra.es> + + * makefile.w32-in (mostlyclean, clean, maintainer-clean): Use + $(DEL) instead of rm, and ignore exit code. + +2003-11-16 Kevin Ryde <user42@zip.com.au> * emacs-lisp-intro.texi: [CVS commitment by <bob@rattlesnake.com>] Corrections to cross references,
--- a/lispintro/makefile.w32-in Sat Feb 28 04:52:40 2004 +0000 +++ b/lispintro/makefile.w32-in Mon Mar 01 14:27:16 2004 +0000 @@ -56,15 +56,15 @@ $(DVIPS) $< -o $@ mostlyclean: - rm -f *.log *.cp *.fn *.ky *.pg *.vr *.tp + - $(DEL) *.log *.cp *.fn *.ky *.pg *.vr *.tp clean: mostlyclean - rm -f *.dvi $(infodir)/eintr* + - $(DEL) *.dvi $(infodir)/eintr* distclean: clean maintainer-clean: distclean - rm -f *.aux *.cps *.fns *.kys *.pgs *.vrs *.toc + - $(DEL) *.aux *.cps *.fns *.kys *.pgs *.vrs *.toc # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded.
--- a/lispref/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/lispref/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,3 +1,8 @@ +2004-02-29 Juanma Barranquero <lektu@terra.es> + + * makefile.w32-in (clean, maintainer-clean): Use $(DEL) instead of + rm, and ignore exit code. + 2004-02-27 Dan Nicolaescu <dann@ics.uci.edu> * display.texi (Defining Faces): Add description for min-colors. @@ -490,7 +495,7 @@ arguments. (String Conversion): More completely describe argument BASE in `string-to-number'. - (Formatting Strings): `%s' and `%S" in `format' do require + (Formatting Strings): `%s' and `%S' in `format' do require corresponding object. Clarify behavior of numeric prefix after `%' in `format'. (Case Conversion): The argument to `upcase-initials' can be a
--- a/lispref/makefile.w32-in Sat Feb 28 04:52:40 2004 +0000 +++ b/lispref/makefile.w32-in Mon Mar 01 14:27:16 2004 +0000 @@ -110,14 +110,14 @@ $(texinputdir) $(TEX) $(srcdir)/elisp.texi clean: - rm -f *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ - *.vr *.vrs *.pg *.pgs *.ky *.kys - rm -f make.out core - rm -f $(infodir)/elisp* + - $(DEL) *.toc *.aux *.log *.cp *.cps *.fn *.fns *.tp *.tps \ + *.vr *.vrs *.pg *.pgs *.ky *.kys + - $(DEL) make.out core + - $(DEL) $(infodir)/elisp* distclean: clean maintainer-clean: clean - rm -f elisp elisp-* elisp.dvi elisp.oaux + - $(DEL) elisp elisp-* elisp.dvi elisp.oaux # arch-tag: da68f1c2-536d-4d41-9150-7b01434eda3f
--- a/man/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/man/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,6 +1,36 @@ +2004-02-29 Simon Josefsson <jas@extundo.com> + + * smtpmail.texi (Authentication): Changed the list of supported + authentication mechanisms from CRAM-MD5, PLAIN and LOGIN-MD5 to + CRAM-MD5 and LOGIN, tiny patch from Andreas Voegele + <voegelas@gmx.net>. + +2004-02-29 Juanma Barranquero <lektu@terra.es> + + * makefile.w32-in (mostlyclean, clean, maintainer-clean): Use + $(DEL) instead of rm, and ignore exit code. + +2004-02-29 Kai Grossjohann <kgrossjo@eu.uu.net> + + Tramp version 2.0.39 released. + +2004-02-29 Michael Albinus <Michael.Albinus@alcatel.de> + + * tramp.texi (Customizing Completion): Explain new functions + `tramp-parse-shostkeys' and `tramp-parse-sknownhosts'. + (all): Savannah URLs unified to "http://savannah.nongnu.org". + (Top): Refer to Savannah mailing list as the major one. Mention + older mailing lists in HTML mode only. + (Auto-save and Backup): Add auto-save. Based on wording of Kai. + (Frequently Asked Questions): Remote hosts must not be Unix-like + for "smb" method. + (Password caching): New node. + (External transfer methods): Refer to password caching for "smb" + method. + 2004-02-23 Nick Roberts <nick@nick.uklinux.net> - * building.texi (Watch Expressions): Update. + * building.texi (Watch Expressions): Update. 2004-02-21 Juri Linkov <juri@jurta.org> @@ -41,7 +71,7 @@ * calendar.texi (Appointments): Update section. -2003-12-29 Kevin Ryde <user42@zip.com.au> +2003-12-29 Kevin Ryde <user42@zip.com.au> * viper.texi (Vi Macros): Fix reference to the Emacs manual. @@ -59,6 +89,7 @@ <acm@muc.de>. 2003-11-30 Kai Grossjohann <kai.grossjohann@gmx.net> + Tramp version 2.0.38 released. * tramp.texi (Remote shell setup): Warn of environment variables @@ -316,6 +347,7 @@ * buffers.texi (List Buffers): Fix previous change. 2003-07-20 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net> + Tramp version 2.0.36 released. * tramp.texi (Remote shell setup): Explain about problems with @@ -478,11 +510,11 @@ (Installation): Explain what to do if files from the tramp/contrib directory are needed. -2003-02-23 Alex Schroeder <alex@emacswiki.org> +2003-02-23 Alex Schroeder <alex@emacswiki.org> * smtpmail.texi (How Mail Works): New. -2003-02-22 Alex Schroeder <alex@emacswiki.org> +2003-02-22 Alex Schroeder <alex@emacswiki.org> * cmdargs.texi (General Variables): Document SMTPSERVER. @@ -494,7 +526,7 @@ * Makefile.in: Build SMTP manual. -2003-02-22 Alex Schroeder <alex@emacswiki.org> +2003-02-22 Alex Schroeder <alex@emacswiki.org> * sending.texi (Sending via SMTP): Explain MTA/MUA. @@ -589,7 +621,7 @@ 2002-08-27 Carsten Dominik <dominik@sand.science.uva.nl> - * reftex.texi: Update to RefTeX 4.19 + * reftex.texi: Update to RefTeX 4.19. 2002-06-17 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
--- a/man/makefile.w32-in Sat Feb 28 04:52:40 2004 +0000 +++ b/man/makefile.w32-in Mon Mar 01 14:27:16 2004 +0000 @@ -292,30 +292,30 @@ $(ENVADD) $(TEXI2DVI) $(srcdir)/smtpmail.texi mostlyclean: - rm -f *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.* + - $(DEL) *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.* clean: mostlyclean - rm -f *.dvi - rm -f $(infodir)/emacs* $(infodir)/ccmode* \ - $(infodir)/cl* $(infodir)/dired-x* \ - $(infodir)/ediff* $(infodir)/forms* \ - $(infodir)/gnus* $(infodir)/info* \ - $(infodir)/message* $(infodir)/mh-e* \ - $(infodir)/reftex* $(infodir)/sc* \ - $(infodir)/vip* $(infodir)/viper* \ - $(infodir)/widget* $(infodir)/efaq* \ - $(infodir)/ada-mode* $(infodir)/autotype* \ - $(infodir)/calc* $(infodir)/idlwave* \ - $(infodir)/eudc* $(infodir)/ebrowse* \ - $(infodir)/pcl-cvs* $(infodir)/woman* \ - $(infodir)/emacs-mime* $(infodir)/eshell* \ - $(infodir)/speedbar* $(infodir)/tramp* \ - $(infodir)/ses* $(infodir)/smtpmail* + - $(DEL) *.dvi + - $(DEL) $(infodir)/emacs* $(infodir)/ccmode* \ + $(infodir)/cl* $(infodir)/dired-x* \ + $(infodir)/ediff* $(infodir)/forms* \ + $(infodir)/gnus* $(infodir)/info* \ + $(infodir)/message* $(infodir)/mh-e* \ + $(infodir)/reftex* $(infodir)/sc* \ + $(infodir)/vip* $(infodir)/viper* \ + $(infodir)/widget* $(infodir)/efaq* \ + $(infodir)/ada-mode* $(infodir)/autotype* \ + $(infodir)/calc* $(infodir)/idlwave* \ + $(infodir)/eudc* $(infodir)/ebrowse* \ + $(infodir)/pcl-cvs* $(infodir)/woman* \ + $(infodir)/emacs-mime* $(infodir)/eshell* \ + $(infodir)/speedbar* $(infodir)/tramp* \ + $(infodir)/ses* $(infodir)/smtpmail* distclean: clean maintainer-clean: distclean - rm -f *.aux *.cps *.fns *.kys *.pgs *.vrs *.toc + - $(DEL) *.aux *.cps *.fns *.kys *.pgs *.vrs *.toc # Don't delete these, because they are outside the current directory. # for file in $(INFO_TARGETS); do rm -f $${file}*; done
--- a/man/smtpmail.texi Sat Feb 28 04:52:40 2004 +0000 +++ b/man/smtpmail.texi Mon Mar 01 14:27:16 2004 +0000 @@ -3,7 +3,7 @@ @settitle Emacs SMTP Library @syncodeindex vr fn @copying -Copyright @copyright{} 2003 Free Software Foundation, Inc. +Copyright @copyright{} 2003, 2004 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -207,7 +207,6 @@ @cindex SASL @cindex CRAM-MD5 -@cindex PLAIN @cindex LOGIN @cindex STARTTLS Many environments require SMTP clients to authenticate themselves @@ -215,15 +214,14 @@ variables contains the authentication information needed for this. The first variable, @code{smtpmail-auth-credentials}, instructs the SMTP library to use a SASL authentication step, currently only the -CRAM-MD5, PLAIN and LOGIN-MD5 mechanisms are supported and will be -selected in that order if the server supports them. The second -variable, @code{smtpmail-starttls-credentials}, instructs the SMTP -library to connect to the server using STARTTLS. This means the -protocol exchange can be integrity protected and confidential by using -TLS, and optionally also authentication of the client. It is common -to use both these mechanisms, e.g., to use STARTTLS to achieve -integrity and confidentiality and then use SASL for client -authentication. +CRAM-MD5 and LOGIN mechanisms are supported and will be selected in +that order if the server supports them. The second variable, +@code{smtpmail-starttls-credentials}, instructs the SMTP library to +connect to the server using STARTTLS. This means the protocol +exchange can be integrity protected and confidential by using TLS, and +optionally also authentication of the client. It is common to use +both these mechanisms, e.g., to use STARTTLS to achieve integrity and +confidentiality and then use SASL for client authentication. @table @code @item smtpmail-auth-credentials
--- a/man/tramp.texi Sat Feb 28 04:52:40 2004 +0000 +++ b/man/tramp.texi Mon Mar 01 14:27:16 2004 +0000 @@ -30,7 +30,7 @@ @end macro @copying -Copyright @copyright{} 1999, 2000, 2001, 2002, 2003 Free Software +Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. @quotation @@ -54,10 +54,10 @@ @end copying @c Entries for @command{install-info} to use -@dircategory Emacs +@dircategory @value{emacs-name} @direntry * TRAMP: (tramp). Transparent Remote Access, Multiple Protocol - Emacs remote file access via rsh and rcp. + @value{emacs-name} remote file access via rsh and rcp. @end direntry @tex @@ -108,18 +108,27 @@ @end ifset The latest release of @tramp{} is available for -@uref{http://savannah.gnu.org/download/tramp/, +@uref{http://savannah.nongnu.org/download/tramp/, download}, or you may see @ref{Obtaining @tramp{}} for more details, including the CVS server details. -@tramp{} also has a @uref{https://savannah.gnu.org/projects/tramp/, +@tramp{} also has a @uref{http://savannah.nongnu.org/projects/tramp/, Savannah Project Page}. @end ifhtml There is a mailing list for @tramp{}, available at @email{tramp-devel@@mail.freesoftware.fsf.org}, and archived at -@uref{http://www.mail-archive.com/emacs-rcp@@ls6.cs.uni-dortmund.de/} as -well as the usual Savannah archives. +@uref{http://savannah.nongnu.org/mail/?group=tramp, Savannah Mail +Archive}. +@ifhtml +Older archives are located at +@uref{http://sourceforge.net/mailarchive/forum.php?forum=tramp-devel, +SourceForge Mail Archive} and +@uref{http://www.mail-archive.com/emacs-rcp@@ls6.cs.uni-dortmund.de/, +The Mail Archive}. +@c in HTML output, there's no new paragraph. +@*@* +@end ifhtml @insertcopying @@ -168,6 +177,7 @@ * Default Method:: Selecting a default method. * Customizing Methods:: Using Non-Standard Methods. * Customizing Completion:: Selecting config files for user/host name completion. +* Password caching:: Reusing passwords for several connections. * Remote Programs:: How @tramp{} finds and uses programs on the remote machine. * Remote shell setup:: Remote shell setup hints. * Windows setup hints:: Issues with Cygwin ssh. @@ -383,20 +393,15 @@ at the top. @noindent -@uref{http://savannah.gnu.org/projects/tramp/} +@uref{http://savannah.nongnu.org/projects/tramp/} @noindent Or follow the example session below: @example ] @strong{cd ~/@value{emacs-dir}} -] @strong{cvs -d:pserver:anoncvs@@subversions.gnu.org:/cvsroot/tramp login} - -(Logging in to anoncvs@@subversions.gnu.org) -CVS password: @strong{(just hit RET here)} -@dots{} - -] @strong{cvs -z3 -d:pserver:anoncvs@@subversions.gnu.org:/cvsroot/tramp co tramp} +] @strong{export CVS_RSH="ssh"} +] @strong{cvs -z3 -d:ext:anoncvs@@savannah.nongnu.org:/cvsroot/tramp co tramp} @end example @noindent @@ -406,6 +411,7 @@ @example ] @strong{cd ~/@value{emacs-dir}/tramp} +] @strong{export CVS_RSH="ssh"} ] @strong{cvs update -d} @end example @@ -480,6 +486,7 @@ is right for them. * Customizing Methods:: Using Non-Standard Methods. * Customizing Completion:: Selecting config files for user/host name completion. +* Password caching:: Reusing passwords for several connections. * Remote Programs:: How @tramp{} finds and uses programs on the remote machine. * Remote shell setup:: Remote shell setup hints. * Windows setup hints:: Issues with Cygwin ssh. @@ -554,9 +561,9 @@ hosts, see below.) These methods depend on the existence of a suitable encoding and -decoding command on remote machine. Locally, @tramp{} may be able to use -features of Emacs to decode and encode the files or it may require -access to external commands to perform that task. +decoding command on remote machine. Locally, @tramp{} may be able to +use features of @value{emacs-name} to decode and encode the files or +it may require access to external commands to perform that task. @cindex uuencode @cindex mimencode @@ -662,11 +669,11 @@ in without such questions. This is also useful for Windows users where @command{ssh}, when -invoked from an Emacs buffer, tells them that it is not allocating a -pseudo tty. When this happens, the login shell is wont to not print -any shell prompt, which confuses @tramp{} mightily. For reasons -unknown, some Windows ports for @command{ssh} (maybe the Cygwin one) -require the doubled @samp{-t} option. +invoked from an @value{emacs-name} buffer, tells them that it is not +allocating a pseudo tty. When this happens, the login shell is wont +to not print any shell prompt, which confuses @tramp{} mightily. For +reasons unknown, some Windows ports for @command{ssh} (maybe the +Cygwin one) require the doubled @samp{-t} option. This supports the @samp{-p} kludge. @@ -820,10 +827,10 @@ with. This is also useful for Windows users where @command{ssh}, when -invoked from an Emacs buffer, tells them that it is not allocating a -pseudo tty. When this happens, the login shell is wont to not print -any shell prompt, which confuses @tramp{} mightily. Maybe this -applies to the Cygwin port of SSH. +invoked from an @value{emacs-name} buffer, tells them that it is not +allocating a pseudo tty. When this happens, the login shell is wont +to not print any shell prompt, which confuses @tramp{} mightily. +Maybe this applies to the Cygwin port of SSH. This method supports the @samp{-p} hack. @@ -864,19 +871,21 @@ @cindex method fsh @cindex fsh method + There is no inline method using @command{fsh} as the multiplexing provided by the program is not very useful in our context. @tramp{} opens just one connection to the remote host and then keeps it open, anyway. -@ifset emacs @item @option{ftp} @cindex method ftp @cindex ftp method This is not a native @tramp{} method. Instead of, it forwards all requests to @value{ftp-package-name}. +@ifset xemacs +This works only for unified filenames, see @ref{Issues}. @end ifset @@ -899,7 +908,7 @@ Since authorization is done on share level, you will be prompted always for a password if you access another share on the same host. -Due to security reasons, the password is not cached. +This can be suppressed by @ref{Password caching}. MS Windows uses for authorization both a user name and a domain name. Because of this, the @tramp{} syntax has been extended: you can @@ -917,10 +926,11 @@ The @option{smb} method supports the @samp{-p} hack. -@strong{Please note:} If Emacs runs locally under MS Windows, this -method isn't available. Instead of, you can use UNC file names like -@file{//melancholia/daniel$$/.emacs}. The only disadvantage is that -there's no possibility to specify another user name. +@strong{Please note:} If @value{emacs-name} runs locally under MS +Windows, this method isn't available. Instead of, you can use UNC +file names like @file{//melancholia/daniel$$/.emacs}. The only +disadvantage is that there's no possibility to specify another user +name. @end table @@ -1197,6 +1207,21 @@ This function returns the host nicknames defined by @code{Host} entries in @file{~/.ssh/config} style files. +@item @code{tramp-parse-shostkeys} +@findex tramp-parse-shostkeys + +SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*} and +@file{~/ssh2/hostkeys/*}. Hosts are coded in file names +@file{hostkey_PORTNUMBER_HOST-NAME.pub}. User names are always nil. + +@item @code{tramp-parse-sknownhosts} +@findex tramp-parse-shostkeys + +Another SSH2 style parsing of directories like +@file{/etc/ssh2/knownhosts/*} and @file{~/ssh2/knownhosts/*}. This +case, hosts names are coded in file names +@file{HOST-NAME.ALGORITHM.pub}. User names are always nil. + @item @code{tramp-parse-hosts} @findex tramp-parse-hosts @@ -1233,6 +1258,49 @@ @end defun +@node Password caching +@section Reusing passwords for several connections. +@cindex passwords + +Sometimes it is necessary to connect to the same remote host several +times. Reentering passwords again and again would be annoying, when +the choosen method does not support access without password prompt +throught own configuration. + +By default, @tramp{} caches the passwords entered by you. They will +be reused next time if a connection needs them for the same user name +and host name, independant of the connection method. + +@vindex password-cache-expiry +Passwords are not saved permanently, that means the password caching +is limited to the lifetime of your @value{emacs-name} session. You +can influence the lifetime of password caching by customizing the +variable @code{password-cache-expiry}. The value is the number of +seconds how long passwords are cached. Setting it to @code{nil} +disables the expiration. + +@findex tramp-clear-passwd +A password is removed from the cache if a connection isn't established +successfully. You can remove a password from the cache also by +executing @kbd{M-x tramp-clear-passwd} in a buffer containing a +related remote file or directory. + +@vindex password-cache +If you don't like this feature for security reasons, password caching +can be disabled totally by customizing the variable +@code{password-cache} (setting it to @code{nil}). + +Implementation Note: password caching is based on the package +password.el in No Gnus. For the time being, it is activated only when +this package is seen in the @code{load-path} while loading @tramp{}. +@ifset tramp-inst +If you don't use No Gnus, you can take password.el from the @tramp{} +@file{contrib} directory, see @ref{Installation parameters}. +@end ifset +It will be activated mandatory once No Gnus has found its way into +@value{emacs-name}. + + @node Remote Programs @section How @tramp{} finds and uses programs on the remote machine. @@ -1426,16 +1494,15 @@ @cindex backup @vindex backup-directory-alist -Explaining auto-save is still to do. - -Normally, Emacs writes backup files to the same directory as the -original files, but this behavior can be changed via the variable -@code{backup-directory-alist}. In connection with @tramp{}, this can -have unexpected side effects. Suppose that you specify that all backups -should go to the directory @file{~/.emacs.d/backups/}, and then you edit -the file @file{/su:root@@localhost:/etc/secretfile}. The effect is that -the backup file will be owned by you and not by root, thus possibly -enabling others to see it even if they were not intended to see it. +Normally, @value{emacs-name} writes backup files to the same directory +as the original files, but this behavior can be changed via the +variable @code{backup-directory-alist}. In connection with @tramp{}, +this can have unexpected side effects. Suppose that you specify that +all backups should go to the directory @file{~/.emacs.d/backups/}, and +then you edit the file @file{/su:root@@localhost:/etc/secretfile}. +The effect is that the backup file will be owned by you and not by +root, thus possibly enabling others to see it even if they were not +intended to see it. When @code{backup-directory-alist} is nil (the default), such problems do not occur. @@ -1451,6 +1518,29 @@ (cons tramp-file-name-regexp nil)) @end lisp +The same problem can happen with auto-saving files. +@ifset emacs +Since @value{emacs-name} 21, the variable +@code{auto-save-file-name-transforms} keeps information, on which +directory an auto-saved file should go. By default, it is initialized +for @tramp{} files to the local temporary directory. + +On some versions of @value{emacs-name}, namely the version built for +Debian Linux, the variable @code{auto-save-file-name-transforms} +contains the directory where @value{emacs-name} was built. A +workaround is to manually set the variable to a sane value. + +If auto-saved files should go into the same directory as the original +files, @code{auto-save-file-name-transforms} should be set to nil. + +Another possibility is to set the variable +@code{tramp-auto-save-directory} to a proper value. +@end ifset +@ifset xemacs +For this purpose you can set the variable +@code{tramp-auto-save-directory} to a proper value. +@end ifset + @node Windows setup hints @section Issues with Cygwin ssh @@ -1468,29 +1558,30 @@ @cindex method scpx with Cygwin @cindex scpx method with Cygwin If you wish to use the @code{scpx} connection method, then you might -have the problem that Emacs calls @code{scp} with a Windows filename -such as @code{c:/foo}. The Cygwin version of @code{scp} does not know -about Windows filenames and interprets this as a remote filename on the -host @code{c}. +have the problem that @value{emacs-name} calls @code{scp} with a +Windows filename such as @code{c:/foo}. The Cygwin version of +@code{scp} does not know about Windows filenames and interprets this +as a remote filename on the host @code{c}. One possible workaround is to write a wrapper script for @code{scp} which converts the Windows filename to a Cygwinized filename. -I guess that another workaround is to run Emacs under Cygwin, or to run -a Cygwinized Emacs. +I guess that another workaround is to run @value{emacs-name} under +Cygwin, or to run a Cygwinized @value{emacs-name}. @cindex Cygwin and ssh-agent -@cindex SSH_AUTH_SOCK and Emacs on Windows +@cindex SSH_AUTH_SOCK and @value{emacs-name} on Windows If you want to use either @code{ssh} based method on Windows, then you might encounter problems with @code{ssh-agent}. Using this program, you can avoid typing the pass-phrase every time you log in (and the @code{scpx} method more or less requires you to use @code{ssh-agent} because it does not allow you to type a password or pass-phrase). -However, if you start Emacs from a desktop shortcut, then the -environment variable @code{SSH_AUTH_SOCK} is not set and so Emacs and -thus @tramp{} and thus @code{ssh} and @code{scp} started from @tramp{} -cannot communicate with @code{ssh-agent}. It works better to start -Emacs from the shell. +However, if you start @value{emacs-name} from a desktop shortcut, then +the environment variable @code{SSH_AUTH_SOCK} is not set and so +@value{emacs-name} and thus @tramp{} and thus @code{ssh} and +@code{scp} started from @tramp{} cannot communicate with +@code{ssh-agent}. It works better to start @value{emacs-name} from +the shell. If anyone knows how to start @code{ssh-agent} under Windows in such a way that desktop shortcuts can profit, please holler. I don't really @@ -1510,15 +1601,15 @@ by the @value{ftp-package-name} package. @cindex type-ahead -Something that might happen which surprises you is that Emacs -remembers all your keystrokes, so if you see a password prompt from -Emacs, say, and hit @kbd{@key{RET}} twice instead of once, then the -second keystroke will be processed by Emacs after @tramp{} has done -its thing. Why, this type-ahead is normal behavior, you say. Right -you are, but be aware that opening a remote file might take quite a -while, maybe half a minute when a connection needs to be opened. -Maybe after half a minute you have already forgotten that you hit that -key! +Something that might happen which surprises you is that +@value{emacs-name} remembers all your keystrokes, so if you see a +password prompt from @value{emacs-name}, say, and hit @kbd{@key{RET}} +twice instead of once, then the second keystroke will be processed by +@value{emacs-name} after @tramp{} has done its thing. Why, this +type-ahead is normal behavior, you say. Right you are, but be aware +that opening a remote file might take quite a while, maybe half a +minute when a connection needs to be opened. Maybe after half a +minute you have already forgotten that you hit that key! @menu * Filename Syntax:: @tramp{} filename conventions. @@ -1606,7 +1697,7 @@ The syntax of multi-hop file names is necessarily slightly different than the syntax of other @tramp{} file names. Here's an example -multi-hop file name, first in Emacs syntax and then in XEmacs syntax: +multi-hop file name: @example @value{tramp-prefix}multi@value{tramp-postfix-single-hop}rsh@value{tramp-postfix-multi-hop}out@@gate@value{tramp-postfix-single-hop}telnet@value{tramp-postfix-multi-hop}kai@@real.host@value{tramp-postfix}/path/to.file @@ -1769,7 +1860,7 @@ There is also a Savannah project page. @noindent -@uref{https://savannah.gnu.org/projects/tramp/} +@uref{http://savannah.nongnu.org/projects/tramp/} @item Which systems does it work on? @@ -1779,8 +1870,9 @@ @file{tramp.el}. I don't think anybody has really tried it on Emacs 19. The package was intended to work on Unix, and it really expects a -Unix-like system on the remote end, but some people seemed to have some -success getting it to work on NT Emacs. +Unix-like system on the remote end (except the @option{smb} method), +but some people seemed to have some success getting it to work on NT +Emacs. There is some informations on @tramp{} on NT at the following URL; many thanks to Joe Stoy for providing the information: @@ -1888,8 +1980,9 @@ @item How can I get notified when @tramp{} file transfers are complete? -The following snippet can be put in your @file{~/.emacs} file. It makes -Emacs beep after reading from or writing to the remote host. +The following snippet can be put in your @file{~/.emacs} file. It +makes @value{emacs-name} beep after reading from or writing to the +remote host. @lisp (defadvice tramp-handle-write-region @@ -2036,10 +2129,11 @@ @node Remote File Ownership @subsection How VC determines who owns a workfile -Emacs provides the @code{user-full-name} function to return the login name -of the current user as well as mapping from arbitrary user id values -back to login names. The VC code uses this functionality to map from the -uid of the owner of a workfile to the login name in some circumstances. +@value{emacs-name} provides the @code{user-full-name} function to +return the login name of the current user as well as mapping from +arbitrary user id values back to login names. The VC code uses this +functionality to map from the uid of the owner of a workfile to the +login name in some circumstances. This will not, for obvious reasons, work if the remote system has a different set of logins. As such, it is necessary to delegate to the @@ -2157,6 +2251,29 @@ installed from the start. If the filenames were unified, @tramp{} would have to be installed from the start, too. +@ifset xemacs +@strong{Note:} If you'ld like to use a similar syntax like +@value{ftp-package-name}, you need the following settings in your init +file: + +@lisp +(setq tramp-unified-filenames t) +(require 'tramp) +@end lisp + +The autoload of the @value{emacs-name} @tramp{} package must be +disabled. This can be achieved by setting file permissions @code{000} +to the files @file{.../xemacs-packages/lisp/tramp/auto-autoloads.el*}. + +In case of unified filenames, all @value{emacs-name} download sites +are added to @code{tramp-default-method-alist} with default method +@code{ftp} @xref{Default Method}. These settings shouldn't be touched +for proper working of the @value{emacs-name} package system. + +The syntax for unified filenames is described in the @tramp{} manual +for @value{emacs-other-name}. +@end ifset + @end itemize @node Concept Index
--- a/man/trampver.texi Sat Feb 28 04:52:40 2004 +0000 +++ b/man/trampver.texi Mon Mar 01 14:27:16 2004 +0000 @@ -5,7 +5,7 @@ @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. @macro trampver{} -2.0.38 +2.0.39 @end macro @c Other flags from configuration @@ -59,7 +59,6 @@ @c standalone. That's why it is included from `trampinst.texi'. @c Otherwise, '/dev/null/' is taken, which leaves this part empty. - @ignore arch-tag: e0fe322c-e06b-46eb-bb5b-d091b521f41c @end ignore
--- a/src/ChangeLog Sat Feb 28 04:52:40 2004 +0000 +++ b/src/ChangeLog Mon Mar 01 14:27:16 2004 +0000 @@ -1,3 +1,22 @@ +2004-02-28 Kim F. Storm <storm@cua.dk> + + * dispnew.c (update_window): Update header line also if there are + no other changes in window (move code after set_cursor label). + + * lisp.h (mark_window_display_accurate): Remove prototype. + + * window.c (window_loop, Fforce_window_update): Force mode line + updates by setting prevent_redisplay_optimizations_p and + update_mode_lines. + +2004-02-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xfns.c (x_window): Fixed indentation. + + * xterm.c (x_calc_absolute_position): Call x_real_positions + to get WM window sizes and use those to calculate position. + (x_set_offset): Removed code commented out. + 2004-02-28 Miles Bader <miles@gnu.org> * keyboard.c (adjust_point_for_property): #ifdef-out dodgy xassert.
--- a/src/xfns.c Sat Feb 28 04:52:40 2004 +0000 +++ b/src/xfns.c Mon Mar 01 14:27:16 2004 +0000 @@ -2838,7 +2838,7 @@ #ifdef HAVE_X_I18N FRAME_XIC (f) = NULL; -if (use_xim) + if (use_xim) { BLOCK_INPUT; create_frame_xic (f);
--- a/src/xterm.c Sat Feb 28 04:52:40 2004 +0000 +++ b/src/xterm.c Mon Mar 01 14:27:16 2004 +0000 @@ -8151,65 +8151,24 @@ Window child; int win_x = 0, win_y = 0; int flags = f->size_hint_flags; - int this_window; /* We have nothing to do if the current position is already for the top-left corner. */ if (! ((flags & XNegative) || (flags & YNegative))) return; - this_window = FRAME_OUTER_WINDOW (f); - - /* Find the position of the outside upper-left corner of + /* Find the offsets of the outside upper-left corner of the inner window, with respect to the outer window. But do this only if we will need the results. */ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window) - { - int count; - - BLOCK_INPUT; - count = x_catch_errors (FRAME_X_DISPLAY (f)); - while (1) - { - x_clear_errors (FRAME_X_DISPLAY (f)); - XTranslateCoordinates (FRAME_X_DISPLAY (f), - - /* From-window, to-window. */ - this_window, - f->output_data.x->parent_desc, - - /* From-position, to-position. */ - 0, 0, &win_x, &win_y, - - /* Child of win. */ - &child); - if (x_had_errors_p (FRAME_X_DISPLAY (f))) - { - Window newroot, newparent = 0xdeadbeef; - Window *newchildren; - unsigned int nchildren; - - if (! XQueryTree (FRAME_X_DISPLAY (f), this_window, &newroot, - &newparent, &newchildren, &nchildren)) - break; - - XFree ((char *) newchildren); - - f->output_data.x->parent_desc = newparent; - } - else - break; - } - - x_uncatch_errors (FRAME_X_DISPLAY (f), count); - UNBLOCK_INPUT; - } + /* This is to get *_pixels_outer_diff. */ + x_real_positions (f, &win_x, &win_y); /* Treat negative positions as relative to the leftmost bottommost position that fits on the screen. */ if (flags & XNegative) f->left_pos = (FRAME_X_DISPLAY_INFO (f)->width - - 2 * f->border_width - win_x + - 2 * FRAME_X_OUTPUT (f)->x_pixels_outer_diff - FRAME_PIXEL_WIDTH (f) + f->left_pos); @@ -8234,8 +8193,12 @@ if (flags & YNegative) f->top_pos = (FRAME_X_DISPLAY_INFO (f)->height - - 2 * f->border_width - - win_y + - FRAME_X_OUTPUT (f)->y_pixels_outer_diff + + /* Assume the window manager decorations are the same size on + three sides, i.e. left, right and bottom. This is to + compensate for the bottom part. */ + - FRAME_X_OUTPUT (f)->x_pixels_outer_diff - height + f->top_pos); } @@ -8279,17 +8242,6 @@ modified_left = f->left_pos; modified_top = f->top_pos; -#if 0 /* Running on psilocin (Debian), and displaying on the NCD X-terminal, - this seems to be unnecessary and incorrect. rms, 4/17/97. */ - /* It is a mystery why we need to add the border_width here - when the frame is already visible, but experiment says we do. */ - if (change_gravity != 0) - { - modified_left += f->border_width; - modified_top += f->border_width; - } -#endif - if (FRAME_X_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A) { /* Some WMs (twm, wmaker at least) has an offset that is smaller