comparison lisp/files.el @ 89943:4c90ffeb71c5

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS
author Miles Bader <miles@gnu.org>
date Mon, 28 Jun 2004 07:56:49 +0000
parents 68c22ea6027c fdd6cb3fe998
children 59dcbfe97385
comparison
equal deleted inserted replaced
89942:9cb747ae49af 89943:4c90ffeb71c5
291 Normally auto-save files are written under other names." 291 Normally auto-save files are written under other names."
292 :type 'boolean 292 :type 'boolean
293 :group 'auto-save) 293 :group 'auto-save)
294 294
295 (defcustom auto-save-file-name-transforms 295 (defcustom auto-save-file-name-transforms
296 `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" 296 `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
297 ;; Don't put "\\2" inside expand-file-name, since it will be 297 ;; Don't put "\\2" inside expand-file-name, since it will be
298 ;; transformed to "/2" on DOS/Windows. 298 ;; transformed to "/2" on DOS/Windows.
299 ,(concat temporary-file-directory "\\2") t)) 299 ,(concat temporary-file-directory "\\2") t))
300 "*Transforms to apply to buffer file name before making auto-save file name. 300 "*Transforms to apply to buffer file name before making auto-save file name.
301 Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): 301 Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
479 (inhibit-file-name-operation op)) 479 (inhibit-file-name-operation op))
480 (apply op args)))) 480 (apply op args))))
481 481
482 (defun convert-standard-filename (filename) 482 (defun convert-standard-filename (filename)
483 "Convert a standard file's name to something suitable for the current OS. 483 "Convert a standard file's name to something suitable for the current OS.
484 This function's standard definition is trivial; it just returns the argument. 484 This means to guarantee valid names and perhaps to canonicalize
485 However, on some systems, the function is redefined with a definition 485 certain patterns.
486 that really does change some file names to canonicalize certain 486
487 patterns and to guarantee valid names." 487 This function's standard definition is trivial; it just returns
488 the argument. However, on Windows and DOS, replace invalid
489 characters. On DOS, make sure to obey the 8.3 limitations. On
490 Windows, turn Cygwin names into native names, and also turn
491 slashes into backslashes if the shell requires it (see
492 `w32-shell-dos-semantics')."
488 filename) 493 filename)
489 494
490 (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) 495 (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
491 "Read directory name, prompting with PROMPT and completing in directory DIR. 496 "Read directory name, prompting with PROMPT and completing in directory DIR.
492 Value is not expanded---you must call `expand-file-name' yourself. 497 Value is not expanded---you must call `expand-file-name' yourself.
519 (defvar cd-path nil 524 (defvar cd-path nil
520 "Value of the CDPATH environment variable, as a list. 525 "Value of the CDPATH environment variable, as a list.
521 Not actually set up until the first time you use it.") 526 Not actually set up until the first time you use it.")
522 527
523 (defun parse-colon-path (cd-path) 528 (defun parse-colon-path (cd-path)
524 "Explode a colon-separated search path into a list of directory names. 529 "Explode a search path into a list of directory names.
525 \(For values of `colon' equal to `path-separator'.)" 530 Directories are separated by occurrences of `path-separator'
531 \(which is colon in GNU and GNU-like systems)."
526 ;; We could use split-string here. 532 ;; We could use split-string here.
527 (and cd-path 533 (and cd-path
528 (let (cd-list (cd-start 0) cd-colon) 534 (let (cd-list (cd-start 0) cd-colon)
529 (setq cd-path (concat cd-path path-separator)) 535 (setq cd-path (concat cd-path path-separator))
530 (while (setq cd-colon (string-match path-separator cd-path cd-start)) 536 (while (setq cd-colon (string-match path-separator cd-path cd-start))
553 (setq default-directory dir) 559 (setq default-directory dir)
554 (error "Cannot cd to %s: Permission denied" dir)))) 560 (error "Cannot cd to %s: Permission denied" dir))))
555 561
556 (defun cd (dir) 562 (defun cd (dir)
557 "Make DIR become the current buffer's default directory. 563 "Make DIR become the current buffer's default directory.
558 If your environment includes a `CDPATH' variable, try each one of that 564 If your environment includes a `CDPATH' variable, try each one of
559 colon-separated list of directories when resolving a relative directory name." 565 that list of directories (separated by occurrences of
566 `path-separator') when resolving a relative directory name.
567 The path separator is colon in GNU and GNU-like systems."
560 (interactive 568 (interactive
561 (list (read-directory-name "Change default directory: " 569 (list (read-directory-name "Change default directory: "
562 default-directory default-directory 570 default-directory default-directory
563 (and (member cd-path '(nil ("./"))) 571 (and (member cd-path '(nil ("./")))
564 (null (getenv "CDPATH")))))) 572 (null (getenv "CDPATH"))))))
614 (read-file-name-internal string nil action) 622 (read-file-name-internal string nil action)
615 (let ((names nil) 623 (let ((names nil)
616 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) 624 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
617 (string-dir (file-name-directory string))) 625 (string-dir (file-name-directory string)))
618 (dolist (dir (car path-and-suffixes)) 626 (dolist (dir (car path-and-suffixes))
627 (unless dir
628 (setq dir default-directory))
619 (if string-dir (setq dir (expand-file-name string-dir dir))) 629 (if string-dir (setq dir (expand-file-name string-dir dir)))
620 (when (file-directory-p dir) 630 (when (file-directory-p dir)
621 (dolist (file (file-name-all-completions 631 (dolist (file (file-name-all-completions
622 (file-name-nondirectory string) dir)) 632 (file-name-nondirectory string) dir))
623 (push (if string-dir (concat string-dir file) file) names) 633 (push (if string-dir (concat string-dir file) file) names)
638 (cons load-path load-suffixes)))) 648 (cons load-path load-suffixes))))
639 (load library)) 649 (load library))
640 650
641 (defun file-remote-p (file) 651 (defun file-remote-p (file)
642 "Test whether FILE specifies a location on a remote system." 652 "Test whether FILE specifies a location on a remote system."
643 (let ((handler (find-file-name-handler file 'file-local-copy))) 653 (let ((handler (find-file-name-handler file 'file-remote-p)))
644 (if handler 654 (if handler
645 (get handler 'file-remote-p)))) 655 (funcall handler 'file-remote-p file)
656 nil)))
646 657
647 (defun file-local-copy (file) 658 (defun file-local-copy (file)
648 "Copy the file FILE into a temporary file on this machine. 659 "Copy the file FILE into a temporary file on this machine.
649 Returns the name of the local copy, or nil, if FILE is directly 660 Returns the name of the local copy, or nil, if FILE is directly
650 accessible." 661 accessible."
659 "Return the truename of FILENAME, which should be absolute. 670 "Return the truename of FILENAME, which should be absolute.
660 The truename of a file name is found by chasing symbolic links 671 The truename of a file name is found by chasing symbolic links
661 both at the level of the file and at the level of the directories 672 both at the level of the file and at the level of the directories
662 containing it, until no links are left at any level. 673 containing it, until no links are left at any level.
663 674
664 The arguments COUNTER and PREV-DIRS are used only in recursive calls. 675 \(fn FILENAME)"
665 Do not specify them in other calls." 676 ;; COUNTER and PREV-DIRS are only used in recursive calls.
666 ;; COUNTER can be a cons cell whose car is the count of how many more links 677 ;; COUNTER can be a cons cell whose car is the count of how many
667 ;; to chase before getting an error. 678 ;; more links to chase before getting an error.
668 ;; PREV-DIRS can be a cons cell whose car is an alist 679 ;; PREV-DIRS can be a cons cell whose car is an alist
669 ;; of truenames we've just recently computed. 680 ;; of truenames we've just recently computed.
670 681 (cond ((or (string= filename "") (string= filename "~"))
671 ;; The last test looks dubious, maybe `+' is meant here? --simon. 682 (setq filename (expand-file-name filename))
672 (if (or (string= filename "") (string= filename "~") 683 (if (string= filename "")
673 (and (string= (substring filename 0 1) "~") 684 (setq filename "/")))
674 (string-match "~[^/]*" filename))) 685 ((and (string= (substring filename 0 1) "~")
675 (progn 686 (string-match "~[^/]*/?" filename))
676 (setq filename (expand-file-name filename)) 687 (let ((first-part
677 (if (string= filename "") 688 (substring filename 0 (match-end 0)))
678 (setq filename "/")))) 689 (rest (substring filename (match-end 0))))
690 (setq filename (concat (expand-file-name first-part) rest)))))
691
679 (or counter (setq counter (list 100))) 692 (or counter (setq counter (list 100)))
680 (let (done 693 (let (done
681 ;; For speed, remove the ange-ftp completion handler from the list. 694 ;; For speed, remove the ange-ftp completion handler from the list.
682 ;; We know it's not needed here. 695 ;; We know it's not needed here.
683 ;; For even more speed, do this only on the outermost call. 696 ;; For even more speed, do this only on the outermost call.
899 Interactively, the default if you just type RET is the current directory, 912 Interactively, the default if you just type RET is the current directory,
900 but the visited file name is available through the minibuffer history: 913 but the visited file name is available through the minibuffer history:
901 type M-n to pull it into the minibuffer. 914 type M-n to pull it into the minibuffer.
902 915
903 Interactively, or if WILDCARDS is non-nil in a call from Lisp, 916 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
904 expand wildcards (if any) and visit multiple files. Wildcard expansion 917 expand wildcards (if any) and visit multiple files. You can
905 can be suppressed by setting `find-file-wildcards'." 918 suppress wildcard expansion by setting `find-file-wildcards'.
919
920 To visit a file without any kind of conversion and without
921 automatically choosing a major mode, use \\[find-file-literally]."
906 (interactive 922 (interactive
907 (find-file-read-args "Find file: " nil)) 923 (find-file-read-args "Find file: " nil))
908 (let ((value (find-file-noselect filename nil nil wildcards))) 924 (let ((value (find-file-noselect filename nil nil wildcards)))
909 (if (listp value) 925 (if (listp value)
910 (mapcar 'switch-to-buffer (nreverse value)) 926 (mapcar 'switch-to-buffer (nreverse value))
1351 ;; find-file-noselect-1 may use a different buffer. 1367 ;; find-file-noselect-1 may use a different buffer.
1352 (find-file-noselect-1 buf filename nowarn 1368 (find-file-noselect-1 buf filename nowarn
1353 rawfile truename number)))))) 1369 rawfile truename number))))))
1354 1370
1355 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number) 1371 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
1356 (let ((inhibit-read-only t) 1372 (let (error)
1357 error)
1358 (with-current-buffer buf 1373 (with-current-buffer buf
1359 (kill-local-variable 'find-file-literally) 1374 (kill-local-variable 'find-file-literally)
1360 ;; Needed in case we are re-visiting the file with a different 1375 ;; Needed in case we are re-visiting the file with a different
1361 ;; text representation. 1376 ;; text representation.
1362 (kill-local-variable 'buffer-file-coding-system) 1377 (kill-local-variable 'buffer-file-coding-system)
1363 (kill-local-variable 'cursor-type) 1378 (kill-local-variable 'cursor-type)
1364 (erase-buffer) 1379 (let ((inhibit-read-only t))
1380 (erase-buffer))
1365 (and (default-value 'enable-multibyte-characters) 1381 (and (default-value 'enable-multibyte-characters)
1366 (not rawfile) 1382 (not rawfile)
1367 (set-buffer-multibyte t)) 1383 (set-buffer-multibyte t))
1368 (if rawfile 1384 (if rawfile
1369 (condition-case () 1385 (condition-case ()
1370 (insert-file-contents-literally filename t) 1386 (let ((inhibit-read-only t))
1387 (insert-file-contents-literally filename t))
1371 (file-error 1388 (file-error
1372 (when (and (file-exists-p filename) 1389 (when (and (file-exists-p filename)
1373 (not (file-readable-p filename))) 1390 (not (file-readable-p filename)))
1374 (kill-buffer buf) 1391 (kill-buffer buf)
1375 (signal 'file-error (list "File is not readable" 1392 (signal 'file-error (list "File is not readable"
1376 filename))) 1393 filename)))
1377 ;; Unconditionally set error 1394 ;; Unconditionally set error
1378 (setq error t))) 1395 (setq error t)))
1379 (condition-case () 1396 (condition-case ()
1380 (insert-file-contents filename t) 1397 (let ((inhibit-read-only t))
1398 (insert-file-contents filename t))
1381 (file-error 1399 (file-error
1382 (when (and (file-exists-p filename) 1400 (when (and (file-exists-p filename)
1383 (not (file-readable-p filename))) 1401 (not (file-readable-p filename)))
1384 (kill-buffer buf) 1402 (kill-buffer buf)
1385 (signal 'file-error (list "File is not readable" 1403 (signal 'file-error (list "File is not readable"
2323 :group 'editing-basics) 2341 :group 'editing-basics)
2324 2342
2325 (defun set-visited-file-name (filename &optional no-query along-with-file) 2343 (defun set-visited-file-name (filename &optional no-query along-with-file)
2326 "Change name of file visited in current buffer to FILENAME. 2344 "Change name of file visited in current buffer to FILENAME.
2327 The next time the buffer is saved it will go in the newly specified file. 2345 The next time the buffer is saved it will go in the newly specified file.
2328 nil or empty string as argument means make buffer not be visiting any file. 2346 FILENAME nil or an empty string means make buffer not be visiting any file.
2329 Remember to delete the initial contents of the minibuffer 2347 Remember to delete the initial contents of the minibuffer
2330 if you wish to pass an empty string as the argument. 2348 if you wish to pass an empty string as the argument.
2331 2349
2332 The optional second argument NO-QUERY, if non-nil, inhibits asking for 2350 The optional second argument NO-QUERY, if non-nil, inhibits asking for
2333 confirmation in the case where another buffer is already visiting FILENAME. 2351 confirmation in the case where another buffer is already visiting FILENAME.
2895 (save-match-data 2913 (save-match-data
2896 (setq directory 2914 (setq directory
2897 (file-name-as-directory (expand-file-name (or directory 2915 (file-name-as-directory (expand-file-name (or directory
2898 default-directory)))) 2916 default-directory))))
2899 (setq filename (expand-file-name filename)) 2917 (setq filename (expand-file-name filename))
2900 (let ((hf (find-file-name-handler filename 'file-local-copy)) 2918 (let ((hf (find-file-name-handler filename 'file-remote-p))
2901 (hd (find-file-name-handler directory 'file-local-copy))) 2919 (hd (find-file-name-handler directory 'file-remote-p)))
2902 (when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
2903 (when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
2904 (if ;; Conditions for separate trees 2920 (if ;; Conditions for separate trees
2905 (or 2921 (or
2906 ;; Test for different drives on DOS/Windows 2922 ;; Test for different drives on DOS/Windows
2907 (and 2923 (and
2908 ;; Should `cygwin' really be included here? --stef 2924 ;; Should `cygwin' really be included here? --stef
3008 (defvar auto-save-hook nil 3024 (defvar auto-save-hook nil
3009 "Normal hook run just before auto-saving.") 3025 "Normal hook run just before auto-saving.")
3010 3026
3011 (defcustom before-save-hook nil 3027 (defcustom before-save-hook nil
3012 "Normal hook that is run before a buffer is saved to its file." 3028 "Normal hook that is run before a buffer is saved to its file."
3013 :options '(copyright-update) 3029 :options '(copyright-update time-stamp)
3014 :type 'hook 3030 :type 'hook
3015 :group 'files) 3031 :group 'files)
3016 3032
3017 (defcustom after-save-hook nil 3033 (defcustom after-save-hook nil
3018 "Normal hook that is run after a buffer is saved to its file." 3034 "Normal hook that is run after a buffer is saved to its file."
3464 this function is called. 3480 this function is called.
3465 3481
3466 The idea behind the NOCONFIRM argument is that it should be 3482 The idea behind the NOCONFIRM argument is that it should be
3467 non-nil if the buffer is going to be reverted without asking the 3483 non-nil if the buffer is going to be reverted without asking the
3468 user. In such situations, one has to be careful with potentially 3484 user. In such situations, one has to be careful with potentially
3469 time consuming operations.") 3485 time consuming operations.
3486
3487 For more information on how this variable is used by Auto Revert mode,
3488 see Info node `(emacs-xtra)Supporting additional buffers'.")
3470 3489
3471 (defvar before-revert-hook nil 3490 (defvar before-revert-hook nil
3472 "Normal hook for `revert-buffer' to run before reverting. 3491 "Normal hook for `revert-buffer' to run before reverting.
3473 If `revert-buffer-function' is used to override the normal revert 3492 If `revert-buffer-function' is used to override the normal revert
3474 mechanism, this hook is not used.") 3493 mechanism, this hook is not used.")
4017 4036
4018 (defun file-expand-wildcards (pattern &optional full) 4037 (defun file-expand-wildcards (pattern &optional full)
4019 "Expand wildcard pattern PATTERN. 4038 "Expand wildcard pattern PATTERN.
4020 This returns a list of file names which match the pattern. 4039 This returns a list of file names which match the pattern.
4021 4040
4022 If PATTERN is written as an absolute relative file name, 4041 If PATTERN is written as an absolute file name,
4023 the values are absolute also. 4042 the values are absolute also.
4024 4043
4025 If PATTERN is written as a relative file name, it is interpreted 4044 If PATTERN is written as a relative file name, it is interpreted
4026 relative to the current default directory, `default-directory'. 4045 relative to the current default directory, `default-directory'.
4027 The file names returned are normally also relative to the current 4046 The file names returned are normally also relative to the current
4228 4247
4229 This works by running a directory listing program 4248 This works by running a directory listing program
4230 whose name is in the variable `insert-directory-program'. 4249 whose name is in the variable `insert-directory-program'.
4231 If WILDCARD, it also runs the shell specified by `shell-file-name'. 4250 If WILDCARD, it also runs the shell specified by `shell-file-name'.
4232 4251
4233 When SWITCHES contains the long `--dired' option,this function 4252 When SWITCHES contains the long `--dired' option, this function
4234 treats it specially, for the sake of dired. However, the 4253 treats it specially, for the sake of dired. However, the
4235 normally equivalent short `-D' option is just passed on to 4254 normally equivalent short `-D' option is just passed on to
4236 `insert-directory-program', as any other option." 4255 `insert-directory-program', as any other option."
4237 ;; We need the directory in order to find the right handler. 4256 ;; We need the directory in order to find the right handler.
4238 (let ((handler (find-file-name-handler (expand-file-name file) 4257 (let ((handler (find-file-name-handler (expand-file-name file)
4305 (concat (file-name-as-directory file) ".") 4324 (concat (file-name-as-directory file) ".")
4306 file)))))))) 4325 file))))))))
4307 4326
4308 ;; If `insert-directory-program' failed, signal an error. 4327 ;; If `insert-directory-program' failed, signal an error.
4309 (unless (eq 0 result) 4328 (unless (eq 0 result)
4329 ;; Delete the error message it may have output.
4330 (delete-region beg (point))
4310 ;; On non-Posix systems, we cannot open a directory, so 4331 ;; On non-Posix systems, we cannot open a directory, so
4311 ;; don't even try, because that will always result in 4332 ;; don't even try, because that will always result in
4312 ;; the ubiquitous "Access denied". Instead, show the 4333 ;; the ubiquitous "Access denied". Instead, show the
4313 ;; command line so the user can try to guess what went wrong. 4334 ;; command line so the user can try to guess what went wrong.
4314 (if (and (file-directory-p file) 4335 (if (and (file-directory-p file)
4327 (member "--dired" switches)) 4348 (member "--dired" switches))
4328 (forward-line -2) 4349 (forward-line -2)
4329 (when (looking-at "//SUBDIRED//") 4350 (when (looking-at "//SUBDIRED//")
4330 (delete-region (point) (progn (forward-line 1) (point))) 4351 (delete-region (point) (progn (forward-line 1) (point)))
4331 (forward-line -1)) 4352 (forward-line -1))
4332 (let ((end (line-end-position))) 4353 (if (looking-at "//DIRED//")
4333 (forward-word 1) 4354 (let ((end (line-end-position)))
4334 (forward-char 3) 4355 (forward-word 1)
4335 (while (< (point) end) 4356 (forward-char 3)
4336 (let ((start (+ beg (read (current-buffer)))) 4357 (while (< (point) end)
4337 (end (+ beg (read (current-buffer))))) 4358 (let ((start (+ beg (read (current-buffer))))
4338 (if (= (char-after end) ?\n) 4359 (end (+ beg (read (current-buffer)))))
4339 (put-text-property start end 'dired-filename t) 4360 (if (= (char-after end) ?\n)
4340 ;; It seems that we can't trust ls's output as to 4361 (put-text-property start end 'dired-filename t)
4341 ;; byte positions of filenames. 4362 ;; It seems that we can't trust ls's output as to
4342 (put-text-property beg (point) 'dired-filename nil) 4363 ;; byte positions of filenames.
4343 (end-of-line)))) 4364 (put-text-property beg (point) 'dired-filename nil)
4344 (goto-char end) 4365 (end-of-line))))
4345 (beginning-of-line) 4366 (goto-char end)
4346 (delete-region (point) (progn (forward-line 2) (point))))) 4367 (beginning-of-line)
4368 (delete-region (point) (progn (forward-line 2) (point))))
4369 (forward-line 1)
4370 (if (looking-at "//DIRED-OPTIONS//")
4371 (delete-region (point) (progn (forward-line 1) (point)))
4372 (forward-line 1))))
4347 4373
4348 ;; Now decode what read if necessary. 4374 ;; Now decode what read if necessary.
4349 (let ((coding (or coding-system-for-read 4375 (let ((coding (or coding-system-for-read
4350 file-name-coding-system 4376 file-name-coding-system
4351 default-file-name-coding-system 4377 default-file-name-coding-system
4414 If nil, the default, don't ask at all. If the value is non-nil, it should 4440 If nil, the default, don't ask at all. If the value is non-nil, it should
4415 be a predicate function such as `yes-or-no-p'." 4441 be a predicate function such as `yes-or-no-p'."
4416 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p) 4442 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
4417 (const :tag "Ask with y-or-n-p" y-or-n-p) 4443 (const :tag "Ask with y-or-n-p" y-or-n-p)
4418 (const :tag "Don't confirm" nil)) 4444 (const :tag "Don't confirm" nil))
4419 :group 'emacs 4445 :group 'convenience
4420 :version "21.1") 4446 :version "21.1")
4421 4447
4422 (defun save-buffers-kill-emacs (&optional arg) 4448 (defun save-buffers-kill-emacs (&optional arg)
4423 "Offer to save each buffer, then kill this Emacs process. 4449 "Offer to save each buffer, then kill this Emacs process.
4424 With prefix arg, silently save all file-visiting buffers, then kill." 4450 With prefix arg, silently save all file-visiting buffers, then kill."
4468 (unhandled-file-name-directory default-directory))) 4494 (unhandled-file-name-directory default-directory)))
4469 default-directory)) 4495 default-directory))
4470 ;; Get a list of the indices of the args which are file names. 4496 ;; Get a list of the indices of the args which are file names.
4471 (file-arg-indices 4497 (file-arg-indices
4472 (cdr (or (assq operation 4498 (cdr (or (assq operation
4473 ;; The first five are special because they 4499 ;; The first six are special because they
4474 ;; return a file name. We want to include the /: 4500 ;; return a file name. We want to include the /:
4475 ;; in the return value. 4501 ;; in the return value.
4476 ;; So just avoid stripping it in the first place. 4502 ;; So just avoid stripping it in the first place.
4477 '((expand-file-name . nil) 4503 '((expand-file-name . nil)
4478 (file-name-directory . nil) 4504 (file-name-directory . nil)
4479 (file-name-as-directory . nil) 4505 (file-name-as-directory . nil)
4480 (directory-file-name . nil) 4506 (directory-file-name . nil)
4481 (file-name-sans-versions . nil) 4507 (file-name-sans-versions . nil)
4508 (find-backup-file-name . nil)
4482 ;; `identity' means just return the first arg 4509 ;; `identity' means just return the first arg
4483 ;; as stripped of its quoting. 4510 ;; not stripped of its quoting.
4484 (substitute-in-file-name . identity) 4511 (substitute-in-file-name identity)
4512 ;; `add' means add "/:" to the result.
4513 (file-truename add 0)
4514 ;; `quote' means add "/:" to buffer-file-name.
4515 (insert-file-contents quote 0)
4516 ;; `unquote-then-quote' means set buffer-file-name
4517 ;; temporarily to unquoted filename.
4518 (verify-visited-file-modtime unquote-then-quote)
4519 ;; List the arguments which are filenames.
4485 (file-name-completion 1) 4520 (file-name-completion 1)
4486 (file-name-all-completions 1) 4521 (file-name-all-completions 1)
4522 (write-region 2 5)
4487 (rename-file 0 1) 4523 (rename-file 0 1)
4488 (copy-file 0 1) 4524 (copy-file 0 1)
4489 (make-symbolic-link 0 1) 4525 (make-symbolic-link 0 1)
4490 (add-name-to-file 0 1))) 4526 (add-name-to-file 0 1)))
4491 ;; For all other operations, treat the first argument only 4527 ;; For all other operations, treat the first argument only
4492 ;; as the file name. 4528 ;; as the file name.
4493 '(nil 0)))) 4529 '(nil 0))))
4530 method
4494 ;; Copy ARGUMENTS so we can replace elements in it. 4531 ;; Copy ARGUMENTS so we can replace elements in it.
4495 (arguments (copy-sequence arguments))) 4532 (arguments (copy-sequence arguments)))
4496 ;; Strip off the /: from the file names that have this handler. 4533 (if (symbolp (car file-arg-indices))
4534 (setq method (pop file-arg-indices)))
4535 ;; Strip off the /: from the file names that have it.
4497 (save-match-data 4536 (save-match-data
4498 (while (consp file-arg-indices) 4537 (while (consp file-arg-indices)
4499 (let ((pair (nthcdr (car file-arg-indices) arguments))) 4538 (let ((pair (nthcdr (car file-arg-indices) arguments)))
4500 (and (car pair) 4539 (and (car pair)
4501 (string-match "\\`/:" (car pair)) 4540 (string-match "\\`/:" (car pair))
4502 (setcar pair 4541 (setcar pair
4503 (if (= (length (car pair)) 2) 4542 (if (= (length (car pair)) 2)
4504 "/" 4543 "/"
4505 (substring (car pair) 2))))) 4544 (substring (car pair) 2)))))
4506 (setq file-arg-indices (cdr file-arg-indices)))) 4545 (setq file-arg-indices (cdr file-arg-indices))))
4507 (if (eq file-arg-indices 'identity) 4546 (cond ((eq method 'identity)
4508 (car arguments) 4547 (car arguments))
4509 (apply operation arguments)))) 4548 ((eq method 'add)
4549 (concat "/:" (apply operation arguments)))
4550 ((eq method 'quote)
4551 (prog1 (apply operation arguments)
4552 (setq buffer-file-name (concat "/:" buffer-file-name))))
4553 ((eq method 'unquote-then-quote)
4554 (let (res)
4555 (setq buffer-file-name (substring buffer-file-name 2))
4556 (setq res (apply operation arguments))
4557 (setq buffer-file-name (concat "/:" buffer-file-name))
4558 res))
4559 (t
4560 (apply operation arguments)))))
4510 4561
4511 (define-key ctl-x-map "\C-f" 'find-file) 4562 (define-key ctl-x-map "\C-f" 'find-file)
4512 (define-key ctl-x-map "\C-r" 'find-file-read-only) 4563 (define-key ctl-x-map "\C-r" 'find-file-read-only)
4513 (define-key ctl-x-map "\C-v" 'find-alternate-file) 4564 (define-key ctl-x-map "\C-v" 'find-alternate-file)
4514 (define-key ctl-x-map "\C-s" 'save-buffer) 4565 (define-key ctl-x-map "\C-s" 'save-buffer)