diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 272 |
1 files changed, 235 insertions, 37 deletions
diff --git a/lisp/files.el b/lisp/files.el index aa6e7f1082a..bc74ecf4667 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -213,6 +213,15 @@ 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 @@ -450,7 +459,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, :all 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 @@ -626,9 +635,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. @@ -647,7 +657,7 @@ The path separator is colon in GNU and GNU-like systems." (let ((trypath (parse-colon-path (getenv "CDPATH")))) (setq cd-path (or trypath (list "./"))))) (if (not (catch 'found - (mapcar + (mapc (function (lambda (x) (let ((f (expand-file-name (concat x dir)))) (if (file-directory-p f) @@ -715,6 +725,28 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." ((null action) (try-completion string names)) (t (test-completion string names)))))) +(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))) + ;; 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)) + (throw 'found (car files)) + (if (equal dir + (setq dir (file-name-directory + (directory-file-name dir)))) + (setq dir nil)))) + nil))) + (defun executable-find (command) "Search for COMMAND in `exec-path' and return the absolute file name. Return nil if COMMAND is not found anywhere in `exec-path'." @@ -731,17 +763,28 @@ This is an interface to the function `load'." (cons load-path (get-load-suffixes))))) (load library)) -(defun file-remote-p (file) +(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:\"." +on the system \"/user@host:\". + +IDENTIFICATION specifies which part of the identification shall +be returned as string. IDENTIFICATION can be the symbol +`method', `user' or `host'; any other value is handled like nil +and means to return the complete identification string. + +If CONNECTED is non-nil, the function returns an identification only +if FILE is located on a remote system, and a connection is established +to that remote system. + +`file-remote-p' will never open a connection on its own." (let ((handler (find-file-name-handler file 'file-remote-p))) (if handler - (funcall handler 'file-remote-p file) + (funcall handler 'file-remote-p file identification connected) nil))) (defun file-local-copy (file) @@ -1057,6 +1100,12 @@ Recursive uses of the minibuffer will not be affected." ,@body) (remove-hook 'minibuffer-setup-hook ,hook))))) +(defcustom find-file-confirm-nonexistent-file nil + "If non-nil, `find-file' requires confirmation before visiting a new file." + :group 'find-file + :version "23.1" + :type 'boolean) + (defun find-file-read-args (prompt mustmatch) (list (let ((find-file-default (and buffer-file-name @@ -1087,7 +1136,9 @@ suppress wildcard expansion by setting `find-file-wildcards' to nil. To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." - (interactive (find-file-read-args "Find file: " nil)) + (interactive + (find-file-read-args "Find file: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (mapcar 'switch-to-buffer (nreverse value)) @@ -1105,7 +1156,9 @@ type M-n to pull it into the minibuffer. Interactively, or if WILDCARDS is non-nil in a call from Lisp, expand wildcards (if any) and visit multiple files." - (interactive (find-file-read-args "Find file in other window: " nil)) + (interactive + (find-file-read-args "Find file in other window: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (progn @@ -1126,7 +1179,9 @@ type M-n to pull it into the minibuffer. Interactively, or if WILDCARDS is non-nil in a call from Lisp, expand wildcards (if any) and visit multiple files." - (interactive (find-file-read-args "Find file in other frame: " nil)) + (interactive + (find-file-read-args "Find file in other frame: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (progn @@ -1149,7 +1204,9 @@ file names with wildcards." "Edit file FILENAME but don't allow changes. Like \\[find-file], but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only: " nil)) + (interactive + (find-file-read-args "Find file read-only: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -1164,7 +1221,9 @@ Use \\[toggle-read-only] to permit editing." "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window], but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other window: " nil)) + (interactive + (find-file-read-args "Find file read-only other window: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -1179,7 +1238,9 @@ Use \\[toggle-read-only] to permit editing." "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame], but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other frame: " nil)) + (interactive + (find-file-read-args "Find file read-only other frame: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -1287,11 +1348,14 @@ killed." (defun create-file-buffer (filename) "Create a suitably named buffer for visiting FILENAME, and return it. FILENAME (sans directory) is used unchanged if that name is free; -otherwise a string <2> or <3> or ... is appended to get an unused name." +otherwise a string <2> or <3> or ... is appended to get an unused name. +Spaces at the start of FILENAME (sans directory) are removed." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) - (generate-new-buffer lastname))) + (save-match-data + (string-match "^ *\\(.*\\)" lastname) + (generate-new-buffer (match-string 1 lastname))))) (defun generate-new-buffer (name) "Create and return a buffer with a name based on NAME. @@ -1915,6 +1979,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) @@ -1978,8 +2043,9 @@ since only a single case-insensitive search through the alist is made." ("\\.tar\\'" . tar-mode) ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. - ("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode) - ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode) + ("\\.\\(\ +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 ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message @@ -1994,7 +2060,6 @@ since only a single case-insensitive search through the alist is made." ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) ("\\.js\\'" . java-mode) ; javascript-mode would be better - ("\\.x[bp]m\\'" . c-mode) ("\\.d?v\\'" . verilog-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. @@ -2012,6 +2077,7 @@ since only a single case-insensitive search through the alist is made." ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG ("\\.[eE]?[pP][sS]\\'" . ps-mode) + ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) ("BROWSE\\'" . ebrowse-tree-mode) ("\\.ebrowse\\'" . ebrowse-tree-mode) @@ -2388,7 +2454,11 @@ Otherwise, return nil; point may be changed." ;; put them in the first line of ;; such a file without screwing up ;; the interpreter invocation. - (and (looking-at "^#!") 2)) t) + ;; The same holds for + ;; '\" + ;; in man pages (preprocessor + ;; magic for the `man' program). + (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t) (progn (skip-chars-forward " \t") (setq beg (point)) @@ -2465,11 +2535,13 @@ asking you for confirmation." minor-mode-overriding-map-alist mode-line-buffer-identification mode-line-format + mode-line-client mode-line-modes mode-line-modified mode-line-mule-info mode-line-position mode-line-process + mode-line-remote mode-name outline-level overriding-local-map @@ -2577,7 +2649,7 @@ n -- to ignore the local variables list.") (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g))) done) (while (not done) - (message prompt) + (message "%s" prompt) (setq char (read-event)) (if (numberp char) (cond ((eq char ?\C-v) @@ -3163,13 +3235,13 @@ BACKUPNAME is the backup file name, which is the old file renamed." (set-default-file-modes ?\700) (when (condition-case nil ;; Try to overwrite old backup first. - (copy-file from-name to-name t t) + (copy-file from-name to-name t t t) (error t)) (while (condition-case nil (progn (when (file-exists-p to-name) (delete-file to-name)) - (copy-file from-name to-name nil t) + (copy-file from-name to-name nil t t) nil) (file-already-exists t)) ;; The file was somehow created by someone else between @@ -4066,6 +4138,8 @@ or multiple mail buffers, etc." (defun make-directory (dir &optional parents) "Create the directory DIR and any nonexistent parent dirs. +If DIR already exists as a directory, do nothing. + Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistent directory. @@ -4147,10 +4221,12 @@ This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. -This command also works for special buffers that contain text which -doesn't come from a file, but reflects some other data base instead: -for example, Dired buffers and `buffer-list' buffers. In these cases, -it reconstructs the buffer contents from the appropriate data base. +This command also implements an interface for special buffers +that contain text which doesn't come from a file, but reflects +some other data instead (e.g. Dired buffers, `buffer-list' +buffers). This is done via the variable +`revert-buffer-function'. In these cases, it should reconstruct +the buffer contents from the appropriate data. When called from Lisp, the first argument is IGNORE-AUTO; only offer to revert from the auto-save file when this is nil. Note that the @@ -4437,6 +4513,14 @@ This command is used in the special Dired buffer created by (message "No files can be recovered from this session now"))) (kill-buffer buffer)))) +(defun kill-buffer-ask (buffer) + "Kill buffer if confirmed." + (when (yes-or-no-p + (format "Buffer %s %s. Kill? " (buffer-name buffer) + (if (buffer-modified-p buffer) + "HAS BEEN EDITED" "is unmodified"))) + (kill-buffer buffer))) + (defun kill-some-buffers (&optional list) "Kill some buffers. Asks the user whether to kill each one of them. Non-interactively, if optional argument LIST is non-nil, it @@ -4451,13 +4535,20 @@ specifies the list of buffers to kill, asking for approval for each one." ; if we killed the base buffer. (not (string-equal name "")) (/= (aref name 0) ?\s) - (yes-or-no-p - (format "Buffer %s %s. Kill? " - name - (if (buffer-modified-p buffer) - "HAS BEEN EDITED" "is unmodified"))) - (kill-buffer buffer))) + (kill-buffer-ask buffer))) (setq list (cdr list)))) + +(defun kill-matching-buffers (regexp &optional internal-too) + "Kill buffers whose name matches the specified regexp. +The optional second argument indicates whether to kill internal buffers too." + (interactive "sKill buffers matching this regular expression: \nP") + (dolist (buffer (buffer-list)) + (let ((name (buffer-name buffer))) + (when (and name (not (string-equal name "")) + (or internal-too (/= (aref name 0) ?\s)) + (string-match regexp name)) + (kill-buffer-ask buffer))))) + (defun auto-save-mode (arg) "Toggle auto-saving of contents of current buffer. @@ -5228,9 +5319,8 @@ message to that effect instead of signaling an error." (defvar kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled. -`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, -but `kill-emacs', the low level primitive, does not. -See also `kill-emacs-hook'.") +`save-buffers-kill-emacs' calls these functions, but `kill-emacs', +the low level primitive, does not. See also `kill-emacs-hook'.") (defcustom confirm-kill-emacs nil "How to ask for confirmation when leaving Emacs. @@ -5269,6 +5359,22 @@ With prefix arg, silently save all file-visiting buffers, then kill." (or (null confirm-kill-emacs) (funcall confirm-kill-emacs "Really exit Emacs? ")) (kill-emacs))) + +(defun save-buffers-kill-terminal (&optional arg) + "Offer to save each buffer, then kill the current connection. +If the current frame has no client, kill Emacs itself. + +With prefix arg, silently save all file-visiting buffers, then kill. + +If emacsclient was started with a list of filenames to edit, then +only these files will be asked to be saved." + (interactive "P") + (let ((proc (frame-parameter (selected-frame) 'client)) + (frame (selected-frame))) + (if (null proc) + (save-buffers-kill-emacs) + (server-save-buffers-kill-terminal proc arg)))) + ;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. @@ -5357,6 +5463,98 @@ With prefix arg, silently save all file-visiting buffers, then kill." (t (apply operation arguments))))) +;; Symbolic modes and read-file-modes. + +(defun file-modes-char-to-who (char) + "Convert CHAR to a who-mask from a symbolic mode notation. +CHAR is in [ugoa] and represents the users on which rights are applied." + (cond ((= char ?u) #o4700) + ((= char ?g) #o2070) + ((= char ?o) #o1007) + ((= char ?a) #o7777) + (t (error "%c: bad `who' character" char)))) + +(defun file-modes-char-to-right (char &optional from) + "Convert CHAR to a right-mask from a symbolic mode notation. +CHAR is in [rwxXstugo] and represents a right. +If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)." + (or from (setq from 0)) + (cond ((= char ?r) #o0444) + ((= char ?w) #o0222) + ((= char ?x) #o0111) + ((= char ?s) #o1000) + ((= char ?t) #o6000) + ;; Rights relative to the previous file modes. + ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) + ((= char ?u) (let ((uright (logand #o4700 from))) + (+ uright (/ uright #o10) (/ uright #o100)))) + ((= char ?g) (let ((gright (logand #o2070 from))) + (+ gright (/ gright #o10) (* gright #o10)))) + ((= char ?o) (let ((oright (logand #o1007 from))) + (+ oright (* oright #o10) (* oright #o100)))) + (t (error "%c: bad right character" char)))) + +(defun file-modes-rights-to-number (rights who-mask &optional from) + "Convert a right string to a right-mask from a symbolic modes notation. +RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\". +WHO-MASK is the mask number of the users on which the rights are to be applied. +FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed." + (let* ((num-rights (or from 0)) + (list-rights (string-to-list rights)) + (op (pop list-rights))) + (while (memq op '(?+ ?- ?=)) + (let ((num-right 0) + char-right) + (while (memq (setq char-right (pop list-rights)) + '(?r ?w ?x ?X ?s ?t ?u ?g ?o)) + (setq num-right + (logior num-right + (file-modes-char-to-right char-right num-rights)))) + (setq num-right (logand who-mask num-right) + num-rights + (cond ((= op ?+) (logior num-rights num-right)) + ((= op ?-) (logand num-rights (lognot num-right))) + (t (logior (logand num-rights (lognot who-mask)) num-right))) + op char-right))) + num-rights)) + +(defun file-modes-symbolic-to-number (modes &optional from) + "Convert symbolic file modes to numeric file modes. +MODES is the string to convert, it should match +\"[ugoa]*([+-=][rwxXstugo]+)+,...\". +See (info \"(coreutils)File permissions\") for more information on this +notation. +FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed." + (save-match-data + (let ((case-fold-search nil) + (num-modes (or from 0))) + (while (/= (string-to-char modes) 0) + (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" modes) + (let ((num-who (apply 'logior 0 + (mapcar 'file-modes-char-to-who + (match-string 1 modes))))) + (when (= num-who 0) + (setq num-who (default-file-modes))) + (setq num-modes + (file-modes-rights-to-number (substring modes (match-end 1)) + num-who num-modes) + modes (substring modes (match-end 3)))) + (error "Parse error in modes near `%s'" (substring modes 0)))) + num-modes))) + +(defun read-file-modes (&optional prompt orig-file) + "Read file modes in octal or symbolic notation. +PROMPT is used as the prompt, default to `File modes (octal or symbolic): '. +ORIG-FILE is the original file of which modes will be change." + (let* ((modes (or (if orig-file (file-modes orig-file) 0) + (error "File not found"))) + (value (read-string (or prompt "File modes (octal or symbolic): ")))) + (save-match-data + (if (string-match "^[0-7]+" value) + (string-to-number value 8) + (file-modes-symbolic-to-number value modes))))) + + (define-key ctl-x-map "\C-f" 'find-file) (define-key ctl-x-map "\C-r" 'find-file-read-only) (define-key ctl-x-map "\C-v" 'find-alternate-file) @@ -5366,7 +5564,7 @@ With prefix arg, silently save all file-visiting buffers, then kill." (define-key ctl-x-map "i" 'insert-file) (define-key esc-map "~" 'not-modified) (define-key ctl-x-map "\C-d" 'list-directory) -(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) +(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal) (define-key ctl-x-map "\C-q" 'toggle-read-only) (define-key ctl-x-4-map "f" 'find-file-other-window) |