X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/18cd1f1a08833b0baad21c1d7b13a6845d95cf57..5ee66afc6dd6db4a2c238dad54e9c4321dbb38c9:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index 6b0bd26efe..0dc8ba20b2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2,16 +2,16 @@ ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, ;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 Free Software Foundation, Inc. +;; 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -19,9 +19,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -213,16 +211,25 @@ have fast storage with limited space, such as a RAM disk." ;; The system null device. (Should reference NULL_DEVICE from C.) (defvar null-device "/dev/null" "The system null device.") +(declare-function msdos-long-file-names "msdos.c") +(declare-function w32-long-file-name "w32proc.c") +(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) +(declare-function dired-unmark "dired" (arg)) +(declare-function dired-do-flagged-delete "dired" (&optional nomessage)) +(declare-function dos-8+3-filename "dos-fns" (filename)) +(declare-function vms-read-directory "vms-patch" (dirname switches buffer)) +(declare-function view-mode-disable "view" ()) + (defvar file-name-invalid-regexp (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names))) (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters - "[\000-\031]\\|" ; control characters + "[\000-\037]\\|" ; control characters "\\(/\\.\\.?[^/]\\)\\|" ; leading dots "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot ((memq system-type '(ms-dos windows-nt cygwin)) (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive - "[|<>\"?*\000-\031]")) ; invalid characters + "[|<>\"?*\000-\037]")) ; invalid characters (t "[\000]")) "Regexp recognizing file names which aren't allowed by the filesystem.") @@ -395,6 +402,7 @@ The functions are called in the order given until one of them returns non-nil.") ;;;It is not useful to make this a local variable. ;;;(put 'find-file-hooks 'permanent-local t) +(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1") (defcustom find-file-hook nil "List of functions to be called after a buffer is loaded from a file. The buffer's local variables (if any) will have been processed before the @@ -403,7 +411,6 @@ functions are called." :type 'hook :options '(auto-insert) :version "22.1") -(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1") (defvar write-file-functions nil "List of functions to be called before writing out a buffer to a file. @@ -450,7 +457,7 @@ use `before-save-hook'.") (defcustom enable-local-variables t "Control use of local variables in files you visit. -The value can be t, nil, :safe, or something else. +The value can be t, nil, :safe, :all, or something else. A value of t means file local variables specifications are obeyed if all the specified variable values are safe; if any values are @@ -516,7 +523,10 @@ using \\[toggle-read-only]." :group 'view) (defvar file-name-history nil - "History list of file names entered in the minibuffer.") + "History list of file names entered in the minibuffer. + +Maximum length of the history list is determined by the value +of `history-length', which see.") (put 'ange-ftp-completion-hook-function 'safe-magic t) (defun ange-ftp-completion-hook-function (op &rest args) @@ -623,9 +633,10 @@ Directories are separated by occurrences of `path-separator' (if (file-exists-p dir) (error "%s is not a directory" dir) (error "%s: no such directory" dir)) - (if (file-executable-p dir) - (setq default-directory dir) - (error "Cannot cd to %s: Permission denied" dir)))) + (unless (file-executable-p dir) + (error "Cannot cd to %s: Permission denied" dir)) + (setq default-directory dir) + (set (make-local-variable 'list-buffers-directory) dir))) (defun cd (dir) "Make DIR become the current buffer's default directory. @@ -688,15 +699,15 @@ one or more of those symbols." (if (memq 'readable predicate) 4 0)))) (locate-file-internal filename path suffixes predicate)) -(defun locate-file-completion (string path-and-suffixes action) - "Do completion for file names passed to `locate-file'. -PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." +(defun locate-file-completion-table (dirs suffixes string pred action) + "Do completion for file names passed to `locate-file'." (if (file-name-absolute-p string) - (read-file-name-internal string nil action) + (let ((read-file-name-predicate pred)) + (read-file-name-internal string nil action)) (let ((names nil) - (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) + (suffix (concat (regexp-opt suffixes t) "\\'")) (string-dir (file-name-directory string))) - (dolist (dir (car path-and-suffixes)) + (dolist (dir dirs) (unless dir (setq dir default-directory)) (if string-dir (setq dir (expand-file-name string-dir dir))) @@ -707,26 +718,36 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." (when (string-match suffix file) (setq file (substring file 0 (match-beginning 0))) (push (if string-dir (concat string-dir file) file) names))))) - (cond - ((eq action t) (all-completions string names)) - ((null action) (try-completion string names)) - (t (test-completion string names)))))) + (complete-with-action action names string pred)))) + +(defun locate-file-completion (string path-and-suffixes action) + "Do completion for file names passed to `locate-file'. +PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." + (locate-file-completion-table (car path-and-suffixes) + (cdr path-and-suffixes) + string nil action)) +(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1") (defun locate-dominating-file (file regexp) "Look up the directory hierarchy from FILE for a file matching REGEXP." - (while (and file (not (file-directory-p file))) - (setq file (file-name-directory (directory-file-name file)))) (catch 'found - (let ((user (nth 2 (file-attributes file))) + ;; `user' is not initialized yet because `file' may not exist, so we may + ;; have to walk up part of the hierarchy before we find the "initial UID". + (let ((user nil) ;; Abbreviate, so as to stop when we cross ~/. (dir (abbreviate-file-name (file-name-as-directory file))) files) - ;; As a heuristic, we stop looking up the hierarchy of directories as - ;; soon as we find a directory belonging to another user. This should - ;; save us from looking in things like /net and /afs. This assumes - ;; that all the files inside a project belong to the same user. - (while (and dir (equal user (nth 2 (file-attributes dir)))) - (if (setq files (directory-files dir 'full regexp)) + (while (and dir + ;; As a heuristic, we stop looking up the hierarchy of + ;; directories as soon as we find a directory belonging to + ;; another user. This should save us from looking in + ;; things like /net and /afs. This assumes that all the + ;; files inside a project belong to the same user. + (let ((prev-user user)) + (setq user (nth 2 (file-attributes file))) + (or (null prev-user) (equal user prev-user)))) + (if (setq files (and (file-directory-p dir) + (directory-files dir 'full regexp))) (throw 'found (car files)) (if (equal dir (setq dir (file-name-directory @@ -746,18 +767,19 @@ Return nil if COMMAND is not found anywhere in `exec-path'." This is an interface to the function `load'." (interactive (list (completing-read "Load library: " - 'locate-file-completion - (cons load-path (get-load-suffixes))))) + (apply-partially 'locate-file-completion-table + load-path + (get-load-suffixes))))) (load library)) (defun file-remote-p (file &optional identification connected) "Test whether FILE specifies a location on a remote system. -Return an identification of the system if the location is indeed -remote. The identification of the system may comprise a method -to access the system and its hostname, amongst other things. - -For example, the filename \"/user@host:/foo\" specifies a location -on the system \"/user@host:\". +Returns nil or a string identifying the remote connection (ideally +a prefix of FILE). For example, the remote identification for filename +\"/user@host:/foo\" could be \"/user@host:\". +A file is considered \"remote\" if accessing it is likely to be slower or +less reliable than accessing local files. +Furthermore, relative file names do not work across remote connections. IDENTIFICATION specifies which part of the identification shall be returned as string. IDENTIFICATION can be the symbol @@ -1016,6 +1038,16 @@ use with M-x." (rename-file encoded new-encoded ok-if-already-exists) newname)) +(defun read-buffer-to-switch (prompt) + "Read the name of a buffer to switch to and return as a string. +It is intended for `switch-to-buffer' family of commands since they +need to omit the name of current buffer from the list of completions +and default values." + (let ((rbts-completion-table (internal-complete-buffer-except))) + (minibuffer-with-setup-hook + (lambda () (setq minibuffer-completion-table rbts-completion-table)) + (read-buffer prompt (other-buffer (current-buffer)))))) + (defun switch-to-buffer-other-window (buffer &optional norecord) "Select buffer BUFFER in another window. If BUFFER does not identify an existing buffer, then this function @@ -1030,7 +1062,8 @@ This function returns the buffer it switched to. This uses the function `display-buffer' as a subroutine; see its documentation for additional customization information." - (interactive "BSwitch to buffer in other window: ") + (interactive + (list (read-buffer-to-switch "Switch to buffer in other window: "))) (let ((pop-up-windows t) ;; Don't let these interfere. same-window-buffer-names same-window-regexps) @@ -1040,14 +1073,17 @@ documentation for additional customization information." "Switch to buffer BUFFER in another frame. Optional second arg NORECORD non-nil means do not put this buffer at the front of the list of recently selected ones. +This function returns the buffer it switched to. This uses the function `display-buffer' as a subroutine; see its documentation for additional customization information." - (interactive "BSwitch to buffer in other frame: ") + (interactive + (list (read-buffer-to-switch "Switch to buffer in other frame: "))) (let ((pop-up-frames t) same-window-buffer-names same-window-regexps) - (pop-to-buffer buffer t norecord) - (raise-frame (window-frame (selected-window))))) + (prog1 + (pop-to-buffer buffer t norecord) + (raise-frame (window-frame (selected-window)))))) (defun display-buffer-other-frame (buffer) "Switch to buffer BUFFER in another frame. @@ -1059,9 +1095,18 @@ documentation for additional customization information." (old-window (selected-window)) new-window) (setq new-window (display-buffer buffer t)) - (lower-frame (window-frame new-window)) - (make-frame-invisible (window-frame old-window)) - (make-frame-visible (window-frame old-window)))) + ;; This may have been here in order to prevent the new frame from hiding + ;; the old frame. But it does more harm than good. + ;; Maybe we should call `raise-window' on the old-frame instead? --Stef + ;;(lower-frame (window-frame new-window)) + + ;; This may have been here in order to make sure the old-frame gets the + ;; focus. But not only can it cause an annoying flicker, with some + ;; window-managers it just makes the window invisible, with no easy + ;; way to recover it. --Stef + ;;(make-frame-invisible (window-frame old-window)) + ;;(make-frame-visible (window-frame old-window)) + )) (defvar find-file-default nil "Used within `find-file-read-args'.") @@ -1078,7 +1123,7 @@ Recursive uses of the minibuffer will not be affected." ;; Clear out this hook so it does not interfere ;; with any recursive minibuffer usage. (remove-hook 'minibuffer-setup-hook ,hook) - (,fun))) + (funcall ,fun))) (unwind-protect (progn (add-hook 'minibuffer-setup-hook ,hook) @@ -1479,6 +1524,17 @@ When nil, never request confirmation." :version "22.1" :type '(choice integer (const :tag "Never request confirmation" nil))) +(defun abort-if-file-too-large (size op-type) + "If file SIZE larger than `large-file-warning-threshold', allow user to abort. +OP-TYPE specifies the file operation being performed (for message to user)." + (when (and large-file-warning-threshold size + (> size large-file-warning-threshold) + (not (y-or-n-p + (format "File %s is large (%dMB), really %s? " + (file-name-nondirectory filename) + (/ size 1048576) op-type)))) + (error "Aborted"))) + (defun find-file-noselect (filename &optional nowarn rawfile wildcards) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but @@ -1530,16 +1586,8 @@ the various files." (if (or find-file-existing-other-name find-file-visit-truename) (setq buf other)))) ;; Check to see if the file looks uncommonly large. - (when (and large-file-warning-threshold (nth 7 attributes) - ;; Don't ask again if we already have the file or - ;; if we're asked to be quiet. - (not (or buf nowarn)) - (> (nth 7 attributes) large-file-warning-threshold) - (not (y-or-n-p - (format "File %s is large (%dMB), really open? " - (file-name-nondirectory filename) - (/ (nth 7 attributes) 1048576))))) - (error "Aborted")) + (when (not (or buf nowarn)) + (abort-if-file-too-large (nth 7 attributes) "open")) (if buf ;; We are using an existing buffer. (let (nonexistent) @@ -1753,7 +1801,7 @@ This function ensures that none of these modifications will take place." (symbol-function 'find-buffer-file-type) nil)) (inhibit-file-name-handlers - (append '(jka-compr-handler image-file-handler) + (append '(jka-compr-handler image-file-handler epa-file-handler) inhibit-file-name-handlers)) (inhibit-file-name-operation 'insert-file-contents)) (unwind-protect @@ -1768,6 +1816,8 @@ This function ensures that none of these modifications will take place." (if (file-directory-p filename) (signal 'file-error (list "Opening input file" "file is a directory" filename))) + ;; Check whether the file is uncommonly large + (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert") (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename)) #'buffer-modified-p)) (tem (funcall insert-func filename))) @@ -1924,6 +1974,8 @@ in that case, this function acts as if `enable-local-variables' were t." (let ((enable-local-variables (or (not find-file) enable-local-variables))) (report-errors "File mode specification error: %s" (set-auto-mode)) + (report-errors "Project local-variables error: %s" + (hack-project-variables)) (report-errors "File local-variables error: %s" (hack-local-variables))) ;; Turn font lock off and on, to make sure it takes account of @@ -1964,6 +2016,7 @@ since only a single case-insensitive search through the alist is made." ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. ("\\.ltx\\'" . latex-mode) ("\\.dtx\\'" . doctex-mode) + ("\\.org\\'" . org-mode) ("\\.el\\'" . emacs-lisp-mode) ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) @@ -2031,6 +2084,7 @@ since only a single case-insensitive search through the alist is made." arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org + ("\\.\\(deb\\)\\'" . archive-mode) ; Debian packages. ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message ("\\`/tmp/Re" . text-mode) @@ -2044,6 +2098,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) ("\\.js\\'" . java-mode) ; javascript-mode would be better + ("\\.d?v\\'" . verilog-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) @@ -2060,7 +2115,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG ("\\.[eE]?[pP][sS]\\'" . ps-mode) - ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)" . doc-view-mode) + ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) ("BROWSE\\'" . ebrowse-tree-mode) ("\\.ebrowse\\'" . ebrowse-tree-mode) @@ -2078,7 +2133,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) ("java.+\\.conf\\'" . conf-javaprop-mode) ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config - ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode) + ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe) ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) ;; ChangeLog.old etc. Other change-log-mode entries are above; @@ -2125,6 +2180,16 @@ See also `interpreter-mode-alist', which detects executable script modes based on the interpreters they specify to run, and `magic-mode-alist', which determines modes based on file contents.") +(defun conf-mode-maybe () + "Select Conf mode or XML mode according to start of file." + (if (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (looking-at "<\\?xml \\|