diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 226 |
1 files changed, 204 insertions, 22 deletions
diff --git a/lisp/files.el b/lisp/files.el index 9ae4396946b..6d03ad24dbe 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -644,7 +644,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) @@ -712,6 +712,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'." @@ -728,17 +750,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) @@ -1052,6 +1085,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 @@ -1082,7 +1121,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)) @@ -1100,7 +1141,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 @@ -1121,7 +1164,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 @@ -1144,7 +1189,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)) @@ -1159,7 +1206,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)) @@ -1174,7 +1223,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)) @@ -1282,11 +1333,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. @@ -1973,8 +2027,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 @@ -1989,7 +2044,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) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) @@ -2006,6 +2060,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) @@ -2449,11 +2504,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 @@ -4050,6 +4107,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. @@ -4421,6 +4480,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 @@ -4435,13 +4502,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. @@ -5253,6 +5327,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. @@ -5341,6 +5431,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) @@ -5350,7 +5532,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) |