aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog56
-rw-r--r--lisp/net/ange-ftp.el155
2 files changed, 112 insertions, 99 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e55f8f84d03..58f562be79d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12005-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * net/ange-ftp.el: Use \\` and \\' instead of ^ and $ in regexps.
4 (ange-ftp-send-cmd): Revert last change, and expand
5 the comment explaining the problem.
6
12005-08-10 Luc Teirlinck <teirllm@auburn.edu> 72005-08-10 Luc Teirlinck <teirllm@auburn.edu>
2 8
3 * ldefs-boot.el: Update. 9 * ldefs-boot.el: Update.
@@ -9,13 +15,14 @@
9 (display-time-string-forms): Shorten first line of docstrings. 15 (display-time-string-forms): Shorten first line of docstrings.
10 16
112005-08-10 Lars Hansen <larsh@soem.dk> 172005-08-10 Lars Hansen <larsh@soem.dk>
12 * desktop.el (desktop-buffer-mode-handlers): Make 18
13 non-customizable. Add autoload cookie. Change initial value to 19 * desktop.el (desktop-buffer-mode-handlers):
20 Make non-customizable. Add autoload cookie. Change initial value to
14 nil; add elements in respective modules instead. Fix doc string. 21 nil; add elements in respective modules instead. Fix doc string.
15 (desktop-load-file): New function. 22 (desktop-load-file): New function.
16 (desktop-minor-mode-handlers): New autoloaded variable. 23 (desktop-minor-mode-handlers): New autoloaded variable.
17 (desktop-create-buffer): Call minor mode handlers. Use 24 (desktop-create-buffer): Call minor mode handlers.
18 desktop-load-file to load major and minor mode modules prior to 25 Use desktop-load-file to load major and minor mode modules prior to
19 checking for a handler. 26 checking for a handler.
20 (desktop-save): Don't add nil to desktop-minor-modes for minor 27 (desktop-save): Don't add nil to desktop-minor-modes for minor
21 modes with nil function in desktop-minor-mode-table. Don't delete 28 modes with nil function in desktop-minor-mode-table. Don't delete
@@ -28,8 +35,7 @@
28 (desktop-clear): Allow desktop-clear-preserve-buffers to contain 35 (desktop-clear): Allow desktop-clear-preserve-buffers to contain
29 regexps. Don't use desktop-clear-preserve-buffers-regexp. 36 regexps. Don't use desktop-clear-preserve-buffers-regexp.
30 (desktop-clear-preserve-buffers-regexp): Delete. 37 (desktop-clear-preserve-buffers-regexp): Delete.
31 (desktop-clear-preserve-buffers): Update initial value and 38 (desktop-clear-preserve-buffers): Update initial value and docstring.
32 docstring.
33 (desktop-save-buffer): Fix doc string. 39 (desktop-save-buffer): Fix doc string.
34 40
35 * hilit-chg.el: Add handler to desktop-minor-mode-handlers. 41 * hilit-chg.el: Add handler to desktop-minor-mode-handlers.
@@ -81,8 +87,7 @@
81 (compilation-info-text-face): Delete face variables. 87 (compilation-info-text-face): Delete face variables.
82 (compilation-text-face): Delete function. 88 (compilation-text-face): Delete function.
83 89
84 * progmodes/grep.el (grep-regexp-alist): Use `.+?' instead of 90 * progmodes/grep.el (grep-regexp-alist): Use `.+?' instead of `[^:\n]+'.
85 `[^:\n]+'.
86 (grep-mode-font-lock-keywords): Use `.+?' instead of `[^\n-]+'. 91 (grep-mode-font-lock-keywords): Use `.+?' instead of `[^\n-]+'.
87 (grep-error-face): Set to `compilation-error' instead of 92 (grep-error-face): Set to `compilation-error' instead of
88 `compilation-error-face' (which is redefined to `grep-hit-face' in 93 `compilation-error-face' (which is redefined to `grep-hit-face' in
@@ -228,7 +233,7 @@
228 233
229 * mail/reporter.el (reporter-dump-state): Use insert-buffer-substring. 234 * mail/reporter.el (reporter-dump-state): Use insert-buffer-substring.
230 235
231 * net/net-utils.el (run-dig): Renamed from `dig'. 236 * net/net-utils.el (run-dig): Rename from `dig'.
232 237
233 * play/gametree.el (gametree-mode): Use make-local-variable, 238 * play/gametree.el (gametree-mode): Use make-local-variable,
234 not make-variable-buffer-local. 239 not make-variable-buffer-local.
@@ -308,23 +313,21 @@
308 (tramp-completion-handle-expand-file-name): Discard call of 313 (tramp-completion-handle-expand-file-name): Discard call of
309 `tramp-drop-volume-letter'. It is not necessary, and there have 314 `tramp-drop-volume-letter'. It is not necessary, and there have
310 been problems with (expand-file-name "~/.netrc" "/") in ange-ftp. 315 been problems with (expand-file-name "~/.netrc" "/") in ange-ftp.
311 Reported by Richard G. Bielawski 316 Reported by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>.
312 <Richard.G.Bielawski@wellsfargo.com>.
313 (tramp-do-copy-or-rename-file-out-of-band): Transfer message 317 (tramp-do-copy-or-rename-file-out-of-band): Transfer message
314 should always be visible. 318 should always be visible.
315 (tramp-handle-insert-directory, tramp-setup-complete) 319 (tramp-handle-insert-directory, tramp-setup-complete)
316 (tramp-set-process-query-on-exit-flag) 320 (tramp-set-process-query-on-exit-flag)
317 (tramp-append-tramp-buffers): Pacify byte-compiler. 321 (tramp-append-tramp-buffers): Pacify byte-compiler.
318 (tramp-bug): Delete non-existing variables from list. Apply 322 (tramp-bug): Delete non-existing variables from list.
319 `tramp-load-report-modules' as pre-hook. Mask 323 Apply `tramp-load-report-modules' as pre-hook.
320 `tramp-password-prompt-regexp', `tramp-shell-prompt-pattern' and 324 Mask `tramp-password-prompt-regexp', `tramp-shell-prompt-pattern' and
321 `shell-prompt-pattern' because of non-7bit characters. Reported 325 `shell-prompt-pattern' because of non-7bit characters.
322 by Sebastian Luque <sluque@mun.ca>. 326 Reported by Sebastian Luque <sluque@mun.ca>.
323 (tramp-reporter-dump-variable, tramp-load-report-modules): New 327 (tramp-reporter-dump-variable, tramp-load-report-modules): New defuns.
324 defuns.
325 (tramp-match-string-list): Remove function. 328 (tramp-match-string-list): Remove function.
326 (tramp-wait-for-regexp): Remove call of that function. Suggested 329 (tramp-wait-for-regexp): Remove call of that function.
327 by Kim F. Storm <storm@cua.dk>. 330 Suggested by Kim F. Storm <storm@cua.dk>.
328 (tramp-set-auto-save-file-modes): Use octal integer code #o600 331 (tramp-set-auto-save-file-modes): Use octal integer code #o600
329 instead of octal character code ?\600. The latter resulted in a 332 instead of octal character code ?\600. The latter resulted in a
330 syntax error with XEmacs. 333 syntax error with XEmacs.
@@ -399,8 +402,8 @@
399 (scheme-get-process): New function, extracted from `scheme-proc'. 402 (scheme-get-process): New function, extracted from `scheme-proc'.
400 (run-scheme): Call `scheme-start-file' to get start file, and pass 403 (run-scheme): Call `scheme-start-file' to get start file, and pass
401 it to `make-comint'. 404 it to `make-comint'.
402 (switch-to-scheme, scheme-proc): Call 405 (switch-to-scheme, scheme-proc):
403 `scheme-interactively-start-process' if no Scheme buffer/process 406 Call `scheme-interactively-start-process' if no Scheme buffer/process
404 is available. 407 is available.
405 408
4062005-08-06 Juri Linkov <juri@jurta.org> 4092005-08-06 Juri Linkov <juri@jurta.org>
@@ -463,8 +466,7 @@
463 (thumbs-image-num): Make automatically buffer local. 466 (thumbs-image-num): Make automatically buffer local.
464 (thumbs-show-thumbs-list): Use `make-local-variable', not 467 (thumbs-show-thumbs-list): Use `make-local-variable', not
465 `make-variable-buffer-local'. 468 `make-variable-buffer-local'.
466 (thumbs-insert-image): Make `thumbs-current-image-size' 469 (thumbs-insert-image): Make `thumbs-current-image-size' buffer-local.
467 buffer-local.
468 470
469 * play/doctor.el (doctor-type-symbol): "?\ " -> "?\s". 471 * play/doctor.el (doctor-type-symbol): "?\ " -> "?\s".
470 (**mad**, *debug*, *print-space*, *print-upcase*, abuselst) 472 (**mad**, *debug*, *print-space*, *print-upcase*, abuselst)
@@ -506,12 +508,12 @@
5062005-08-01 Nick Roberts <nickrob@snap.net.nz> 5082005-08-01 Nick Roberts <nickrob@snap.net.nz>
507 509
508 Update copyright notices of files in progmodes directory for 510 Update copyright notices of files in progmodes directory for
509 release of Emacs 22.1. 511 release of Emacs 22.1.
510 512
511 * progmodes/gdb-ui.el (gdb-enable-debug-log): Add autoload cookie. 513 * progmodes/gdb-ui.el (gdb-enable-debug-log): Add autoload cookie.
512 514
513 * progmodes/gud.el (gud-tooltip-mode): Add autoload cookie. Don't 515 * progmodes/gud.el (gud-tooltip-mode): Add autoload cookie.
514 barf if the GUD buffer has been killed. 516 Don't barf if the GUD buffer has been killed.
515 517
5162005-08-01 Kim F. Storm <storm@cua.dk> 5182005-08-01 Kim F. Storm <storm@cua.dk>
517 519
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index d4b48323e4c..5d205f575b8 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -686,7 +686,7 @@
686 :prefix "ange-ftp-") 686 :prefix "ange-ftp-")
687 687
688(defcustom ange-ftp-name-format 688(defcustom ange-ftp-name-format
689 '("^/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4)) 689 '("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
690 "*Format of a fully expanded remote file name. 690 "*Format of a fully expanded remote file name.
691 691
692This is a list of the form \(REGEXP HOST USER NAME\), 692This is a list of the form \(REGEXP HOST USER NAME\),
@@ -863,10 +863,11 @@ If nil, prompt the user for a password."
863 string)) 863 string))
864 864
865(defcustom ange-ftp-binary-file-name-regexp 865(defcustom ange-ftp-binary-file-name-regexp
866 (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" 866 (concat "TAGS\\'\\|\\.\\(?:"
867 "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|" 867 (eval-when-compile
868 "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|" 868 (regexp-opt '("z" "Z" "lzh" "arc" "zip" "zoo" "tar" "dvi"
869 "\\.taz$\\|\\.tgz$") 869 "ps" "elc" "gif" "gz" "taz" "tgz")))
870 "\\|EXE\\(;[0-9]+\\)?\\|[zZ]-part-..\\)\\'")
870 "*If a file matches this regexp then it is transferred in binary mode." 871 "*If a file matches this regexp then it is transferred in binary mode."
871 :group 'ange-ftp 872 :group 'ange-ftp
872 :type 'regexp) 873 :type 'regexp)
@@ -1130,7 +1131,7 @@ If the optional parameter NEW is given and the non-directory parts match,
1130only return the directory part of FILE." 1131only return the directory part of FILE."
1131 (save-match-data 1132 (save-match-data
1132 (if (and default-directory 1133 (if (and default-directory
1133 (string-match (concat "^" 1134 (string-match (concat "\\`"
1134 (regexp-quote default-directory) 1135 (regexp-quote default-directory)
1135 ".") file)) 1136 ".") file))
1136 (setq file (substring file (1- (match-end 0))))) 1137 (setq file (substring file (1- (match-end 0)))))
@@ -1200,7 +1201,7 @@ only return the directory part of FILE."
1200 (save-match-data 1201 (save-match-data
1201 (maphash 1202 (maphash
1202 (lambda (key value) 1203 (lambda (key value)
1203 (if (string-match "^[^/]*\\(/\\).*$" key) 1204 (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
1204 (let ((host (substring key 0 (match-beginning 1)))) 1205 (let ((host (substring key 0 (match-beginning 1))))
1205 (if (and (string-equal user (substring key (match-end 1))) 1206 (if (and (string-equal user (substring key (match-end 1)))
1206 value) 1207 value)
@@ -1415,7 +1416,7 @@ only return the directory part of FILE."
1415 (let (res) 1416 (let (res)
1416 (maphash 1417 (maphash
1417 (lambda (key value) 1418 (lambda (key value)
1418 (if (string-match "^[^/]*\\(/\\).*$" key) 1419 (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
1419 (let ((host (substring key 0 (match-beginning 1))) 1420 (let ((host (substring key 0 (match-beginning 1)))
1420 (user (substring key (match-end 1)))) 1421 (user (substring key (match-end 1))))
1421 (push (concat user "@" host ":") res)))) 1422 (push (concat user "@" host ":") res))))
@@ -1655,7 +1656,7 @@ good, skip, fatal, or unknown."
1655 1656
1656 ;; handle hash mark printing 1657 ;; handle hash mark printing
1657 (and ange-ftp-process-busy 1658 (and ange-ftp-process-busy
1658 (string-match "^#+$" str) 1659 (string-match "\\`#+\\'" str)
1659 (setq str (ange-ftp-process-handle-hash str))) 1660 (setq str (ange-ftp-process-handle-hash str)))
1660 (comint-output-filter proc str) 1661 (comint-output-filter proc str)
1661 ;; Replace STR by the result of the comint processing. 1662 ;; Replace STR by the result of the comint processing.
@@ -1678,7 +1679,7 @@ good, skip, fatal, or unknown."
1678 (seen-prompt nil)) 1679 (seen-prompt nil))
1679 (setq ange-ftp-process-string (substring ange-ftp-process-string 1680 (setq ange-ftp-process-string (substring ange-ftp-process-string
1680 (match-end 0))) 1681 (match-end 0)))
1681 (while (string-match "^ftp> *" line) 1682 (while (string-match "\\`ftp> *" line)
1682 (setq seen-prompt t) 1683 (setq seen-prompt t)
1683 (setq line (substring line (match-end 0)))) 1684 (setq line (substring line (match-end 0))))
1684 (if (not (and seen-prompt ange-ftp-pending-error-line)) 1685 (if (not (and seen-prompt ange-ftp-pending-error-line))
@@ -1863,7 +1864,7 @@ been queued with no result. CONT will still be called, however."
1863 (move-marker comint-last-input-start (point)) 1864 (move-marker comint-last-input-start (point))
1864 ;; don't insert the password into the buffer on the USER command. 1865 ;; don't insert the password into the buffer on the USER command.
1865 (save-match-data 1866 (save-match-data
1866 (if (string-match "^user \"[^\"]*\"" cmd) 1867 (if (string-match "\\`user \"[^\"]*\"" cmd)
1867 (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n") 1868 (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
1868 (insert cmd))) 1869 (insert cmd)))
1869 (move-marker comint-last-input-end (point)) 1870 (move-marker comint-last-input-end (point))
@@ -2069,7 +2070,7 @@ host specified in `ange-ftp-gateway-host'."
2069PROC is the process to the FTP-client. HOST may have an optional 2070PROC is the process to the FTP-client. HOST may have an optional
2070suffix of the form #PORT to specify a non-default port" 2071suffix of the form #PORT to specify a non-default port"
2071 (save-match-data 2072 (save-match-data
2072 (string-match "^\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host) 2073 (string-match "\\`\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
2073 (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host))) 2074 (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
2074 (port (match-string 3 host)) 2075 (port (match-string 3 host))
2075 (result (ange-ftp-raw-send-cmd 2076 (result (ange-ftp-raw-send-cmd
@@ -2148,6 +2149,8 @@ suffix of the form #PORT to specify a non-default port"
2148 (or ange-ftp-binary-hash-mark-size 2149 (or ange-ftp-binary-hash-mark-size
2149 (setq ange-ftp-binary-hash-mark-size size))))))))) 2150 (setq ange-ftp-binary-hash-mark-size size)))))))))
2150 2151
2152(defvar ange-ftp-process-startup-hook nil)
2153
2151(defun ange-ftp-get-process (host user) 2154(defun ange-ftp-get-process (host user)
2152 "Return an FTP subprocess connected to HOST and logged in as USER. 2155 "Return an FTP subprocess connected to HOST and logged in as USER.
2153Create a new process if needed." 2156Create a new process if needed."
@@ -2309,7 +2312,7 @@ and NOWAIT."
2309 ;; resolve symlinks to directories on SysV machines. (Sebastian will 2312 ;; resolve symlinks to directories on SysV machines. (Sebastian will
2310 ;; be happy.) 2313 ;; be happy.)
2311 (and (eq host-type 'unix) 2314 (and (eq host-type 'unix)
2312 (string-match "/$" cmd1) 2315 (string-match "/\\'" cmd1)
2313 (not (string-match "R" cmd3)) 2316 (not (string-match "R" cmd3))
2314 (setq cmd1 (concat cmd1 "."))) 2317 (setq cmd1 (concat cmd1 ".")))
2315 2318
@@ -2326,15 +2329,22 @@ and NOWAIT."
2326 (unless (memq host-type ange-ftp-dumb-host-types) 2329 (unless (memq host-type ange-ftp-dumb-host-types)
2327 (setq cmd0 'ls) 2330 (setq cmd0 'ls)
2328 ;; We cd and then use `ls' with no directory argument. 2331 ;; We cd and then use `ls' with no directory argument.
2329 ;; This works around a misfeature of some versions of netbsd ftpd. 2332 ;; This works around a misfeature of some versions of netbsd ftpd
2333 ;; where `ls' can only take one argument: either one set of flags
2334 ;; or a file/directory name.
2335 ;; FIXME: if we're trying to `ls' a single file, this fails since we
2336 ;; can't cd to a file. We can't fix this problem here, tho, because
2337 ;; at this point we don't know whether the argument is a file or
2338 ;; a directory. Such an `ls' is only every used (apparently) from
2339 ;; `insert-directory' when the `full-directory-p' argument is nil
2340 ;; (which seems to only be used by dired when updating its display
2341 ;; after operating on a set of files). We should change
2342 ;; ange-ftp-insert-directory so that this case is handled by getting
2343 ;; a full listing of the directory and extracting the line
2344 ;; corresponding to the requested file.
2330 (unless (equal cmd1 ".") 2345 (unless (equal cmd1 ".")
2331 (setq result (ange-ftp-cd host user 2346 (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
2332 ;; Make sure the target to which 2347 (setq cmd1 cmd3)))
2333 ;; `cd' is performed is a directory.
2334 (file-name-directory (nth 1 cmd))
2335 'noerror)))
2336 ;; Concatenate the switches and the target to be used with `ls'.
2337 (setq cmd1 (concat "\"" cmd3 " " cmd1 "\""))))
2338 2348
2339 ;; First argument is the remote name 2349 ;; First argument is the remote name
2340 ((progn 2350 ((progn
@@ -2770,10 +2780,10 @@ The main reason for this alist is to deal with file versions in VMS.")
2770 ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX) 2780 ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
2771 ;; and others don't. (sigh...) Beware, that some Unix's don't 2781 ;; and others don't. (sigh...) Beware, that some Unix's don't
2772 ;; seem to believe in the F-switch 2782 ;; seem to believe in the F-switch
2773 (if (or (and symlink (string-match "@$" file)) 2783 (if (or (and symlink (string-match "@\\'" file))
2774 (and directory (string-match "/$" file)) 2784 (and directory (string-match "/\\'" file))
2775 (and executable (string-match "*$" file)) 2785 (and executable (string-match "*\\'" file))
2776 (and socket (string-match "=$" file))) 2786 (and socket (string-match "=\\'" file)))
2777 (setq file (substring file 0 -1))))) 2787 (setq file (substring file 0 -1)))))
2778 (puthash file (or symlink directory) tbl) 2788 (puthash file (or symlink directory) tbl)
2779 (forward-line 1)) 2789 (forward-line 1))
@@ -3117,22 +3127,24 @@ logged in as user USER and cd'd to directory DIR."
3117 3127
3118 ;; See if remote name is absolute. If so then just expand it and 3128 ;; See if remote name is absolute. If so then just expand it and
3119 ;; replace the name component of the overall name. 3129 ;; replace the name component of the overall name.
3120 (cond ((string-match "^/" name) 3130 (cond ((string-match "\\`/" name)
3121 name) 3131 name)
3122 3132
3123 ;; Name starts with ~ or ~user. Resolve that part of the name 3133 ;; Name starts with ~ or ~user. Resolve that part of the name
3124 ;; making it absolute then re-expand it. 3134 ;; making it absolute then re-expand it.
3125 ((string-match "^~[^/]*" name) 3135 ((string-match "\\`~[^/]*" name)
3126 (let* ((tilda (match-string 0 name)) 3136 (let* ((tilda (match-string 0 name))
3127 (rest (substring name (match-end 0))) 3137 (rest (substring name (match-end 0)))
3128 (dir (ange-ftp-expand-dir host user tilda))) 3138 (dir (ange-ftp-expand-dir host user tilda)))
3129 (if dir 3139 (if dir
3130 (setq name (cond ((string-equal rest "") 3140 ;; C-x d /ftp:anonymous@ftp.gnu.org:~/ RET
3131 dir) 3141 ;; seems to cause `rest' to sometimes be empty.
3132 ((string-equal dir "/") 3142 ;; Maybe it's an error for `rest' to be empty here,
3133 rest) 3143 ;; but until we figure this out, this quick fix
3134 (t 3144 ;; seems to do the trick.
3135 (concat dir rest)))) 3145 (setq name (cond ((string-equal rest "") dir)
3146 ((string-equal dir "/") rest)
3147 (t (concat dir rest))))
3136 (error "User \"%s\" is not known" 3148 (error "User \"%s\" is not known"
3137 (substring tilda 1))))) 3149 (substring tilda 1)))))
3138 3150
@@ -3146,19 +3158,18 @@ logged in as user USER and cd'd to directory DIR."
3146 (error "Unable to obtain CWD"))))) 3158 (error "Unable to obtain CWD")))))
3147 3159
3148 ;; If name starts with //, preserve that, for apollo system. 3160 ;; If name starts with //, preserve that, for apollo system.
3149 (if (not (string-match "^//" name)) 3161 (unless (string-match "\\`//" name)
3150 (progn 3162 (if (not (eq system-type 'windows-nt))
3151 (if (not (eq system-type 'windows-nt)) 3163 (setq name (ange-ftp-real-expand-file-name name))
3152 (setq name (ange-ftp-real-expand-file-name name)) 3164 ;; Windows UNC default dirs do not make sense for ftp.
3153 ;; Windows UNC default dirs do not make sense for ftp. 3165 (setq name (if (string-match "\\`//" default-directory)
3154 (if (string-match "^//" default-directory) 3166 (ange-ftp-real-expand-file-name name "c:/")
3155 (setq name (ange-ftp-real-expand-file-name name "c:/")) 3167 (ange-ftp-real-expand-file-name name)))
3156 (setq name (ange-ftp-real-expand-file-name name))) 3168 ;; Strip off possible drive specifier.
3157 ;; Strip off possible drive specifier. 3169 (if (string-match "\\`[a-zA-Z]:" name)
3158 (if (string-match "^[a-zA-Z]:" name) 3170 (setq name (substring name 2))))
3159 (setq name (substring name 2)))) 3171 (if (string-match "\\`//" name)
3160 (if (string-match "^//" name) 3172 (setq name (substring name 1))))
3161 (setq name (substring name 1)))))
3162 3173
3163 ;; Now substitute the expanded name back into the overall filename. 3174 ;; Now substitute the expanded name back into the overall filename.
3164 (ange-ftp-replace-name-component n name)) 3175 (ange-ftp-replace-name-component n name))
@@ -3182,8 +3193,8 @@ logged in as user USER and cd'd to directory DIR."
3182 (eq (string-to-char name) ?\\)) 3193 (eq (string-to-char name) ?\\))
3183 (ange-ftp-canonize-filename name)) 3194 (ange-ftp-canonize-filename name))
3184 ((and (eq system-type 'windows-nt) 3195 ((and (eq system-type 'windows-nt)
3185 (or (string-match "^[a-zA-Z]:" name) 3196 (or (string-match "\\`[a-zA-Z]:" name)
3186 (string-match "^[a-zA-Z]:" default))) 3197 (string-match "\\`[a-zA-Z]:" default)))
3187 (ange-ftp-real-expand-file-name name default)) 3198 (ange-ftp-real-expand-file-name name default))
3188 ((zerop (length name)) 3199 ((zerop (length name))
3189 (ange-ftp-canonize-filename default)) 3200 (ange-ftp-canonize-filename default))
@@ -3216,7 +3227,7 @@ system TYPE.")
3216 (if parsed 3227 (if parsed
3217 (let ((filename (nth 2 parsed))) 3228 (let ((filename (nth 2 parsed)))
3218 (if (save-match-data 3229 (if (save-match-data
3219 (string-match "^~[^/]*$" filename)) 3230 (string-match "\\`~[^/]*\\'" filename))
3220 name 3231 name
3221 (ange-ftp-replace-name-component 3232 (ange-ftp-replace-name-component
3222 name 3233 name
@@ -3229,7 +3240,7 @@ system TYPE.")
3229 (if parsed 3240 (if parsed
3230 (let ((filename (nth 2 parsed))) 3241 (let ((filename (nth 2 parsed)))
3231 (if (save-match-data 3242 (if (save-match-data
3232 (string-match "^~[^/]*$" filename)) 3243 (string-match "\\`~[^/]*\\'" filename))
3233 "" 3244 ""
3234 (ange-ftp-real-file-name-nondirectory filename))) 3245 (ange-ftp-real-file-name-nondirectory filename)))
3235 (ange-ftp-real-file-name-nondirectory name)))) 3246 (ange-ftp-real-file-name-nondirectory name))))
@@ -3971,7 +3982,7 @@ E.g.,
3971 ;; Maybe we should use something more like 3982 ;; Maybe we should use something more like
3972 ;; (equal dir (file-name-directory (directory-file-name dir))) -stef 3983 ;; (equal dir (file-name-directory (directory-file-name dir))) -stef
3973 (or (and (eq system-type 'windows-nt) 3984 (or (and (eq system-type 'windows-nt)
3974 (string-match "^[a-zA-Z]:[/\\]$" dir)) 3985 (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
3975 (string-equal "/" dir))) 3986 (string-equal "/" dir)))
3976 3987
3977(defun ange-ftp-file-name-all-completions (file dir) 3988(defun ange-ftp-file-name-all-completions (file dir)
@@ -4015,8 +4026,8 @@ E.g.,
4015 (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir)) 4026 (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
4016 (ange-ftp-completion-ignored-pattern 4027 (ange-ftp-completion-ignored-pattern
4017 (mapconcat (lambda (s) (if (stringp s) 4028 (mapconcat (lambda (s) (if (stringp s)
4018 (concat (regexp-quote s) "$") 4029 (concat (regexp-quote s) "$")
4019 "/")) ; / never in filename 4030 "/")) ; / never in filename
4020 completion-ignored-extensions 4031 completion-ignored-extensions
4021 "\\|"))) 4032 "\\|")))
4022 (save-match-data 4033 (save-match-data
@@ -4939,7 +4950,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
4939(defun ange-ftp-fix-name-for-vms (name &optional reverse) 4950(defun ange-ftp-fix-name-for-vms (name &optional reverse)
4940 (save-match-data 4951 (save-match-data
4941 (if reverse 4952 (if reverse
4942 (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) 4953 (if (string-match "\\`\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)\\'" name)
4943 (let (drive dir file) 4954 (let (drive dir file)
4944 (setq drive (match-string 1 name)) 4955 (setq drive (match-string 1 name))
4945 (setq dir (match-string 2 name)) 4956 (setq dir (match-string 2 name))
@@ -4953,7 +4964,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
4953 file)) 4964 file))
4954 (error "name %s didn't match" name)) 4965 (error "name %s didn't match" name))
4955 (let (drive dir file tmp) 4966 (let (drive dir file tmp)
4956 (if (string-match "^/[^:]+:/" name) 4967 (if (string-match "\\`/[^:]+:/" name)
4957 (setq drive (substring name 1 4968 (setq drive (substring name 1
4958 (1- (match-end 0))) 4969 (1- (match-end 0)))
4959 name (substring name (match-end 0)))) 4970 name (substring name (match-end 0))))
@@ -4991,7 +5002,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
4991 ;; them. 5002 ;; them.
4992 (cond ((string-equal dir-name "/") 5003 (cond ((string-equal dir-name "/")
4993 (error "Cannot get listing for fictitious \"/\" directory")) 5004 (error "Cannot get listing for fictitious \"/\" directory"))
4994 ((string-match "^/[-A-Z0-9_$]+:/$" dir-name) 5005 ((string-match "\\`/[-A-Z0-9_$]+:/\\'" dir-name)
4995 (error "Cannot get listing for device")) 5006 (error "Cannot get listing for device"))
4996 ((ange-ftp-fix-name-for-vms dir-name)))) 5007 ((ange-ftp-fix-name-for-vms dir-name))))
4997 5008
@@ -5045,7 +5056,7 @@ Other orders of $ and _ seem to all work just fine.")
5045 ;; deal with directories 5056 ;; deal with directories
5046 (puthash (substring file 0 (match-beginning 0)) t tbl) 5057 (puthash (substring file 0 (match-beginning 0)) t tbl)
5047 (puthash file nil tbl) 5058 (puthash file nil tbl)
5048 (if (string-match ";[0-9]+$" file) ; deal with extension 5059 (if (string-match ";[0-9]+\\'" file) ; deal with extension
5049 ;; sans extension 5060 ;; sans extension
5050 (puthash (substring file 0 (match-beginning 0)) nil tbl))) 5061 (puthash (substring file 0 (match-beginning 0)) nil tbl)))
5051 (forward-line 1)) 5062 (forward-line 1))
@@ -5071,7 +5082,7 @@ Other orders of $ and _ seem to all work just fine.")
5071 (ange-ftp-internal-delete-file-entry name t) 5082 (ange-ftp-internal-delete-file-entry name t)
5072 (save-match-data 5083 (save-match-data
5073 (let ((file (ange-ftp-get-file-part name))) 5084 (let ((file (ange-ftp-get-file-part name)))
5074 (if (string-match ";[0-9]+$" file) 5085 (if (string-match ";[0-9]+\\'" file)
5075 ;; In VMS you can't delete a file without an explicit 5086 ;; In VMS you can't delete a file without an explicit
5076 ;; version number, or wild-card (e.g. FOO;*) 5087 ;; version number, or wild-card (e.g. FOO;*)
5077 ;; For now, we give up on wildcards. 5088 ;; For now, we give up on wildcards.
@@ -5109,7 +5120,7 @@ Other orders of $ and _ seem to all work just fine.")
5109 (if files 5120 (if files
5110 (let ((file (ange-ftp-get-file-part name))) 5121 (let ((file (ange-ftp-get-file-part name)))
5111 (save-match-data 5122 (save-match-data
5112 (if (string-match ";[0-9]+$" file) 5123 (if (string-match ";[0-9]+\\'" file)
5113 (puthash (substring file 0 (match-beginning 0)) nil files) 5124 (puthash (substring file 0 (match-beginning 0)) nil files)
5114 ;; Need to figure out what version of the file 5125 ;; Need to figure out what version of the file
5115 ;; is being added. 5126 ;; is being added.
@@ -5152,7 +5163,7 @@ Other orders of $ and _ seem to all work just fine.")
5152 5163
5153(defun ange-ftp-vms-file-name-as-directory (name) 5164(defun ange-ftp-vms-file-name-as-directory (name)
5154 (save-match-data 5165 (save-match-data
5155 (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name) 5166 (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?\\'" name)
5156 (setq name (substring name 0 (match-beginning 0)))) 5167 (setq name (substring name 0 (match-beginning 0))))
5157 (ange-ftp-real-file-name-as-directory name))) 5168 (ange-ftp-real-file-name-as-directory name)))
5158 5169
@@ -5273,15 +5284,15 @@ Other orders of $ and _ seem to all work just fine.")
5273 5284
5274(defun ange-ftp-vms-make-compressed-filename (name &optional reverse) 5285(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
5275 (cond 5286 (cond
5276 ((string-match "-Z;[0-9]+$" name) 5287 ((string-match "-Z;[0-9]+\\'" name)
5277 (list nil (substring name 0 (match-beginning 0)))) 5288 (list nil (substring name 0 (match-beginning 0))))
5278 ((string-match ";[0-9]+$" name) 5289 ((string-match ";[0-9]+\\'" name)
5279 (list nil (substring name 0 (match-beginning 0)))) 5290 (list nil (substring name 0 (match-beginning 0))))
5280 ((string-match "-Z$" name) 5291 ((string-match "-Z\\'" name)
5281 (list nil (substring name 0 -2))) 5292 (list nil (substring name 0 -2)))
5282 (t 5293 (t
5283 (list t 5294 (list t
5284 (if (string-match ";[0-9]+$" name) 5295 (if (string-match ";[0-9]+\\'" name)
5285 (concat (substring name 0 (match-beginning 0)) 5296 (concat (substring name 0 (match-beginning 0))
5286 "-Z") 5297 "-Z")
5287 (concat name "-Z")))))) 5298 (concat name "-Z"))))))
@@ -5314,7 +5325,7 @@ Other orders of $ and _ seem to all work just fine.")
5314 5325
5315(defun ange-ftp-vms-sans-version (name &rest args) 5326(defun ange-ftp-vms-sans-version (name &rest args)
5316 (save-match-data 5327 (save-match-data
5317 (if (string-match ";[0-9]+$" name) 5328 (if (string-match ";[0-9]+\\'" name)
5318 (substring name 0 (match-beginning 0)) 5329 (substring name 0 (match-beginning 0))
5319 name))) 5330 name)))
5320 5331
@@ -5470,14 +5481,14 @@ Other orders of $ and _ seem to all work just fine.")
5470(defun ange-ftp-fix-name-for-mts (name &optional reverse) 5481(defun ange-ftp-fix-name-for-mts (name &optional reverse)
5471 (save-match-data 5482 (save-match-data
5472 (if reverse 5483 (if reverse
5473 (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) 5484 (if (string-match "\\`\\([^:]+:\\)?\\(.*\\)\\'" name)
5474 (let (acct file) 5485 (let (acct file)
5475 (setq acct (match-string 1 name)) 5486 (setq acct (match-string 1 name))
5476 (setq file (match-string 2 name)) 5487 (setq file (match-string 2 name))
5477 (concat (and acct (concat "/" acct "/")) 5488 (concat (and acct (concat "/" acct "/"))
5478 file)) 5489 file))
5479 (error "name %s didn't match" name)) 5490 (error "name %s didn't match" name))
5480 (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name) 5491 (if (string-match "\\`/\\([^:]+:\\)/\\(.*\\)\\'" name)
5481 (concat (match-string 1 name) (match-string 2 name)) 5492 (concat (match-string 1 name) (match-string 2 name))
5482 ;; Let's hope that mts will recognize it anyway. 5493 ;; Let's hope that mts will recognize it anyway.
5483 name)))) 5494 name))))
@@ -5496,7 +5507,7 @@ Other orders of $ and _ seem to all work just fine.")
5496 (cond 5507 (cond
5497 ((string-equal dir-name "") 5508 ((string-equal dir-name "")
5498 "?") 5509 "?")
5499 ((string-match ":$" dir-name) 5510 ((string-match ":\\'" dir-name)
5500 (concat dir-name "?")) 5511 (concat dir-name "?"))
5501 (dir-name))))) ; It's just a single file. 5512 (dir-name))))) ; It's just a single file.
5502 5513
@@ -5633,7 +5644,7 @@ Other orders of $ and _ seem to all work just fine.")
5633 ;; stores directories without the trailing /. Is this 5644 ;; stores directories without the trailing /. Is this
5634 ;; consistent? 5645 ;; consistent?
5635 (concat "/" name) 5646 (concat "/" name)
5636 (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" 5647 (if (string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'"
5637 name) 5648 name)
5638 (let ((minidisk (match-string 1 name))) 5649 (let ((minidisk (match-string 1 name)))
5639 (if (match-beginning 2) 5650 (if (match-beginning 2)
@@ -5678,7 +5689,7 @@ Other orders of $ and _ seem to all work just fine.")
5678 (cond 5689 (cond
5679 ((string-equal "/" dir-name) 5690 ((string-equal "/" dir-name)
5680 (error "Cannot get listing for fictitious \"/\" directory")) 5691 (error "Cannot get listing for fictitious \"/\" directory"))
5681 ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name) 5692 ((string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'" dir-name)
5682 (let* ((minidisk (match-string 1 dir-name)) 5693 (let* ((minidisk (match-string 1 dir-name))
5683 ;; host and user are bound in the call to ange-ftp-send-cmd 5694 ;; host and user are bound in the call to ange-ftp-send-cmd
5684 (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user)) 5695 (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
@@ -5836,7 +5847,7 @@ Other orders of $ and _ seem to all work just fine.")
5836;; ange-ftp-dired-move-to-end-of-filename-alist))) 5847;; ange-ftp-dired-move-to-end-of-filename-alist)))
5837 5848
5838(defun ange-ftp-cms-make-compressed-filename (name &optional reverse) 5849(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
5839 (if (string-match "-Z$" name) 5850 (if (string-match "-Z\\'" name)
5840 (list nil (substring name 0 -2)) 5851 (list nil (substring name 0 -2))
5841 (list t (concat name "-Z")))) 5852 (list t (concat name "-Z"))))
5842 5853
@@ -6087,5 +6098,5 @@ be recognized automatically (they are all valid BS2000 hosts too)."
6087 6098
6088(provide 'ange-ftp) 6099(provide 'ange-ftp)
6089 6100
6090;;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316 6101;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316
6091;;; ange-ftp.el ends here 6102;;; ange-ftp.el ends here