642 |
|
|
643 |
(defun file-remote-p (file) |
(defun file-remote-p (file) |
644 |
"Test whether FILE specifies a location on a remote system." |
"Test whether FILE specifies a location on a remote system." |
645 |
(let ((handler (find-file-name-handler file 'file-local-copy))) |
(let ((handler (find-file-name-handler file 'file-remote-p))) |
646 |
(if handler |
(if handler |
647 |
(get handler 'file-remote-p)))) |
(funcall handler 'file-remote-p file) |
648 |
|
nil))) |
649 |
|
|
650 |
(defun file-local-copy (file) |
(defun file-local-copy (file) |
651 |
"Copy the file FILE into a temporary file on this machine. |
"Copy the file FILE into a temporary file on this machine. |
1366 |
(kill-local-variable 'buffer-file-coding-system) |
(kill-local-variable 'buffer-file-coding-system) |
1367 |
(kill-local-variable 'cursor-type) |
(kill-local-variable 'cursor-type) |
1368 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
1369 |
(erase-buffer) |
(erase-buffer)) |
1370 |
(and (default-value 'enable-multibyte-characters) |
(and (default-value 'enable-multibyte-characters) |
1371 |
(not rawfile) |
(not rawfile) |
1372 |
(set-buffer-multibyte t)) |
(set-buffer-multibyte t)) |
1373 |
(if rawfile |
(if rawfile |
1374 |
(condition-case () |
(condition-case () |
1375 |
(insert-file-contents-literally filename t) |
(let ((inhibit-read-only t)) |
1376 |
(file-error |
(insert-file-contents-literally filename t)) |
1377 |
(when (and (file-exists-p filename) |
(file-error |
1378 |
(not (file-readable-p filename))) |
(when (and (file-exists-p filename) |
1379 |
(kill-buffer buf) |
(not (file-readable-p filename))) |
1380 |
(signal 'file-error (list "File is not readable" |
(kill-buffer buf) |
1381 |
filename))) |
(signal 'file-error (list "File is not readable" |
1382 |
;; Unconditionally set error |
filename))) |
1383 |
|
;; Unconditionally set error |
1384 |
|
(setq error t))) |
1385 |
|
(condition-case () |
1386 |
|
(let ((inhibit-read-only t)) |
1387 |
|
(insert-file-contents filename t)) |
1388 |
|
(file-error |
1389 |
|
(when (and (file-exists-p filename) |
1390 |
|
(not (file-readable-p filename))) |
1391 |
|
(kill-buffer buf) |
1392 |
|
(signal 'file-error (list "File is not readable" |
1393 |
|
filename))) |
1394 |
|
;; Run find-file-not-found-hooks until one returns non-nil. |
1395 |
|
(or (run-hook-with-args-until-success 'find-file-not-found-functions) |
1396 |
|
;; If they fail too, set error. |
1397 |
(setq error t))))) |
(setq error t))))) |
|
(condition-case () |
|
|
(let ((inhibit-read-only t)) |
|
|
(insert-file-contents filename t)) |
|
|
(file-error |
|
|
(when (and (file-exists-p filename) |
|
|
(not (file-readable-p filename))) |
|
|
(kill-buffer buf) |
|
|
(signal 'file-error (list "File is not readable" |
|
|
filename))) |
|
|
;; Run find-file-not-found-hooks until one returns non-nil. |
|
|
(or (run-hook-with-args-until-success 'find-file-not-found-functions) |
|
|
;; If they fail too, set error. |
|
|
(setq error t)))) |
|
1398 |
;; Record the file's truename, and maybe use that as visited name. |
;; Record the file's truename, and maybe use that as visited name. |
1399 |
(if (equal filename buffer-file-name) |
(if (equal filename buffer-file-name) |
1400 |
(setq buffer-file-truename truename) |
(setq buffer-file-truename truename) |
2904 |
(file-name-as-directory (expand-file-name (or directory |
(file-name-as-directory (expand-file-name (or directory |
2905 |
default-directory)))) |
default-directory)))) |
2906 |
(setq filename (expand-file-name filename)) |
(setq filename (expand-file-name filename)) |
2907 |
(let ((hf (find-file-name-handler filename 'file-local-copy)) |
(let ((hf (find-file-name-handler filename 'file-remote-p)) |
2908 |
(hd (find-file-name-handler directory 'file-local-copy))) |
(hd (find-file-name-handler directory 'file-remote-p))) |
|
(when (and hf (not (get hf 'file-remote-p))) (setq hf nil)) |
|
|
(when (and hd (not (get hd 'file-remote-p))) (setq hd nil)) |
|
2909 |
(if ;; Conditions for separate trees |
(if ;; Conditions for separate trees |
2910 |
(or |
(or |
2911 |
;; Test for different drives on DOS/Windows |
;; Test for different drives on DOS/Windows |
4336 |
(when (looking-at "//SUBDIRED//") |
(when (looking-at "//SUBDIRED//") |
4337 |
(delete-region (point) (progn (forward-line 1) (point))) |
(delete-region (point) (progn (forward-line 1) (point))) |
4338 |
(forward-line -1)) |
(forward-line -1)) |
4339 |
(let ((end (line-end-position))) |
(if (looking-at "//DIRED//") |
4340 |
(forward-word 1) |
(let ((end (line-end-position))) |
4341 |
(forward-char 3) |
(forward-word 1) |
4342 |
(while (< (point) end) |
(forward-char 3) |
4343 |
(let ((start (+ beg (read (current-buffer)))) |
(while (< (point) end) |
4344 |
(end (+ beg (read (current-buffer))))) |
(let ((start (+ beg (read (current-buffer)))) |
4345 |
(if (= (char-after end) ?\n) |
(end (+ beg (read (current-buffer))))) |
4346 |
(put-text-property start end 'dired-filename t) |
(if (= (char-after end) ?\n) |
4347 |
;; It seems that we can't trust ls's output as to |
(put-text-property start end 'dired-filename t) |
4348 |
;; byte positions of filenames. |
;; It seems that we can't trust ls's output as to |
4349 |
(put-text-property beg (point) 'dired-filename nil) |
;; byte positions of filenames. |
4350 |
(end-of-line)))) |
(put-text-property beg (point) 'dired-filename nil) |
4351 |
(goto-char end) |
(end-of-line)))) |
4352 |
(beginning-of-line) |
(goto-char end) |
4353 |
(delete-region (point) (progn (forward-line 2) (point))))) |
(beginning-of-line) |
4354 |
|
(delete-region (point) (progn (forward-line 2) (point)))) |
4355 |
|
(forward-line 1) |
4356 |
|
(if (looking-at "//DIRED-OPTIONS//") |
4357 |
|
(delete-region (point) (progn (forward-line 1) (point))) |
4358 |
|
(forward-line 1)))) |
4359 |
|
|
4360 |
;; Now decode what read if necessary. |
;; Now decode what read if necessary. |
4361 |
(let ((coding (or coding-system-for-read |
(let ((coding (or coding-system-for-read |
4482 |
;; Get a list of the indices of the args which are file names. |
;; Get a list of the indices of the args which are file names. |
4483 |
(file-arg-indices |
(file-arg-indices |
4484 |
(cdr (or (assq operation |
(cdr (or (assq operation |
4485 |
;; The first five are special because they |
;; The first six are special because they |
4486 |
;; return a file name. We want to include the /: |
;; return a file name. We want to include the /: |
4487 |
;; in the return value. |
;; in the return value. |
4488 |
;; So just avoid stripping it in the first place. |
;; So just avoid stripping it in the first place. |
4491 |
(file-name-as-directory . nil) |
(file-name-as-directory . nil) |
4492 |
(directory-file-name . nil) |
(directory-file-name . nil) |
4493 |
(file-name-sans-versions . nil) |
(file-name-sans-versions . nil) |
4494 |
|
(find-backup-file-name . nil) |
4495 |
;; `identity' means just return the first arg |
;; `identity' means just return the first arg |
4496 |
;; not stripped of its quoting. |
;; not stripped of its quoting. |
4497 |
(substitute-in-file-name identity) |
(substitute-in-file-name identity) |
4498 |
|
;; `add' means add "/:" to the result. |
4499 |
|
(file-truename add 0) |
4500 |
|
;; `quote' means add "/:" to buffer-file-name. |
4501 |
|
(insert-file-contents quote 0) |
4502 |
|
;; `unquote-then-quote' means set buffer-file-name |
4503 |
|
;; temporarily to unquoted filename. |
4504 |
|
(verify-visited-file-modtime unquote-then-quote) |
4505 |
|
;; List the arguments which are filenames. |
4506 |
(file-name-completion 1) |
(file-name-completion 1) |
4507 |
(file-name-all-completions 1) |
(file-name-all-completions 1) |
4508 |
;; t means add "/:" to the result. |
(write-region 2 5) |
|
(file-truename t 0) |
|
4509 |
(rename-file 0 1) |
(rename-file 0 1) |
4510 |
(copy-file 0 1) |
(copy-file 0 1) |
4511 |
(make-symbolic-link 0 1) |
(make-symbolic-link 0 1) |
4531 |
(setq file-arg-indices (cdr file-arg-indices)))) |
(setq file-arg-indices (cdr file-arg-indices)))) |
4532 |
(cond ((eq method 'identity) |
(cond ((eq method 'identity) |
4533 |
(car arguments)) |
(car arguments)) |
4534 |
(method |
((eq method 'add) |
4535 |
(concat "/:" (apply operation arguments))) |
(concat "/:" (apply operation arguments))) |
4536 |
|
((eq method 'quote) |
4537 |
|
(prog1 (apply operation arguments) |
4538 |
|
(setq buffer-file-name (concat "/:" buffer-file-name)))) |
4539 |
|
((eq method 'unquote-then-quote) |
4540 |
|
(let (res) |
4541 |
|
(setq buffer-file-name (substring buffer-file-name 2)) |
4542 |
|
(setq res (apply operation arguments)) |
4543 |
|
(setq buffer-file-name (concat "/:" buffer-file-name)) |
4544 |
|
res)) |
4545 |
(t |
(t |
4546 |
(apply operation arguments))))) |
(apply operation arguments))))) |
4547 |
|
|