]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / files.el
index bf7d34e2227691e791f9e7ee3b67bf5524be7630..be28dec4c409b8d42784b2f3e0685f9e15a1612d 100644 (file)
@@ -59,8 +59,9 @@ FROM with TO when it appears in a directory name.  This replacement is
 done when setting up the default directory of a newly visited file.
 *Every* FROM string should start with `^'.
 
-Do not use `~' in the TO strings.
-They should be ordinary absolute directory names.
+FROM and TO should be equivalent names, which refer to the
+same directory.  Do not use `~' in the TO strings;
+they should be ordinary absolute directory names.
 
 Use this feature when you have directories which you normally refer to
 via absolute symbolic links.  Make TO the name of the link, and FROM
@@ -554,7 +555,7 @@ See Info node `(elisp)Standard File Names' for more details."
            (start 0))
        ;; Replace invalid filename characters with !
        (while (string-match "[?*:<>|\"\000-\037]" name start)
-         (aset name (match-beginning 0) ?!)
+              (aset name (match-beginning 0) ?!)
          (setq start (match-end 0)))
        name)
     filename))
@@ -643,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)
@@ -711,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'."
@@ -727,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)
@@ -1051,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
@@ -1081,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))
@@ -1099,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
@@ -1120,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
@@ -1143,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))
@@ -1158,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))
@@ -1173,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))
@@ -1281,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.
@@ -1972,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
@@ -1988,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)
@@ -2448,11 +2503,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
@@ -3188,7 +3245,7 @@ we do not remove backup version numbers, only true file version numbers."
                         (length name))
                   (if keep-backup-version
                       (length name)
-                    (or (string-match "\\.~[-0-9a-z._]+~\\'" name)
+                    (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name)
                         (string-match "~\\'" name)
                         (length name))))))))
 
@@ -4049,6 +4106,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.
@@ -4420,6 +4479,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
@@ -4434,13 +4501,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)))))
+
 \f
 (defun auto-save-mode (arg)
   "Toggle auto-saving of contents of current buffer.
@@ -5252,6 +5326,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))))
+
 \f
 ;; We use /: as a prefix to "quote" a file name
 ;; so that magic file name handlers will not apply to it.
@@ -5340,6 +5430,98 @@ With prefix arg, silently save all file-visiting buffers, then kill."
          (t
           (apply operation arguments)))))
 \f
+;; 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)))))
+
+\f
 (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)
@@ -5349,7 +5531,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)