"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible."
- (let (handler (handlers file-name-handler-alist))
- (save-match-data
- (while (and (consp handlers) (null handler))
- (if (and (consp (car handlers))
- (stringp (car (car handlers)))
- (string-match (car (car handlers)) file))
- (setq handler (cdr (car handlers))))
- (setq handlers (cdr handlers))))
+ (let ((handler (find-file-name-handler file)))
(if handler
(funcall handler 'file-local-copy file)
nil)))
containing it, until no links are left at any level."
(if (string= filename "~")
(setq filename (expand-file-name filename)))
- (let (handler (handlers file-name-handler-alist))
- (save-match-data
- (while (and (consp handlers) (null handler))
- (if (and (consp (car handlers))
- (stringp (car (car handlers)))
- (string-match (car (car handlers)) filename))
- (setq handler (cdr (car handlers))))
- (setq handlers (cdr handlers))))
+ (let ((handler (find-file-name-handler filename)))
;; For file name that has a special handler, call handler.
;; This is so that ange-ftp can save time by doing a no-op.
(if handler
(file-truename (expand-file-name target dir))
;; No, we are done!
filename)))))
+
\f
(defun switch-to-buffer-other-window (buffer)
"Select buffer BUFFER in another window."
(defun generate-new-buffer (name)
"Create and return a buffer with a name based on NAME.
-Choose the buffer's name using generate-new-buffer-name."
+Choose the buffer's name using `generate-new-buffer-name'."
(get-buffer-create (generate-new-buffer-name name)))
(defconst automount-dir-prefix "^/tmp_mnt/"
"Regexp to match the automounter prefix in a directory name.")
+(defvar abbreviated-home-dir nil
+ "The the user's homedir abbreviated according to `directory-abbrev-list'.")
+
(defun abbreviate-file-name (filename)
- "Return a version of FILENAME shortened using directory-abbrev-alist.
+ "Return a version of FILENAME shortened using `directory-abbrev-alist'.
This also substitutes \"~\" for the user's home directory.
-See \\[describe-variable] directory-abbrev-alist RET for more information."
+Type \\[describe-variable] directory-abbrev-alist RET for more information."
;; Get rid of the prefixes added by the automounter.
(if (and (string-match automount-dir-prefix filename)
(file-exists-p (file-name-directory
(substring filename (1- (match-end 0))))))
(setq filename (substring filename (1- (match-end 0)))))
(let ((tail directory-abbrev-alist))
+ ;; If any elt of directory-abbrev-alist matches this name,
+ ;; abbreviate accordingly.
(while tail
(if (string-match (car (car tail)) filename)
(setq filename
(concat (cdr (car tail)) (substring filename (match-end 0)))))
(setq tail (cdr tail)))
- (if (string-match (concat "^" (expand-file-name "~")) filename)
+ ;; Compute and save the abbreviated homedir name.
+ ;; We defer computing this until the first time it's needed, to
+ ;; give time for directory-abbrev-alist to be set properly.
+ (or abbreviated-home-dir
+ (setq abbreviated-home-dir
+ (let ((abbreviated-home-dir "$foo"))
+ (concat "^" (abbreviate-file-name (expand-file-name "~"))))))
+ ;; If FILENAME starts with the abbreviated homedir,
+ ;; make it start with `~' instead.
+ (if (string-match abbreviated-home-dir filename)
(setq filename
(concat "~" (substring filename (match-end 0)))))
filename))
"Note: file is write protected")
((file-attributes (directory-file-name default-directory))
"File not found and directory write-protected")
+ ((file-exists-p (file-name-directory buffer-file-name))
+ (setq buffer-read-only nil))
(t
- ;; If the directory the buffer is in doesn't exist,
- ;; offer to create it. It's better to do this now
- ;; than when we save the buffer, because we want
- ;; autosaving to work.
(setq buffer-read-only nil)
- (or (file-exists-p (file-name-directory buffer-file-name))
- (if (yes-or-no-p
- (format
- "The directory containing %s does not exist. Create? "
- (abbreviate-file-name buffer-file-name)))
- (make-directory-path
- (file-name-directory buffer-file-name))))
- nil))))
+ (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
+ "Use M-x make-dir RET RET to create the directory"
+ "Use C-u M-x make-dir RET RET to create directory and its parents")))))
(if msg
(progn
(message msg)
(setq backup-inhibited t)))
;; If auto-save was not already on, turn it on if appropriate.
(if (not buffer-auto-save-file-name)
- (auto-save-mode (and buffer-file-name auto-save-default)))
+ (auto-save-mode (and buffer-file-name auto-save-default))
+ ;; If auto save is on, start using a new name.
+ ;; We deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because perhaps
+ ;; the user wants to save the new state and then compare with the
+ ;; previous state from the auto save file.
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name)))
(if buffer-file-name
(set-buffer-modified-p t)))
redefine it.
If the optional argument KEEP-BACKUP-VERSION is non-nil,
we do not remove backup version numbers, only true file version numbers."
- (let (handler (handlers file-name-handler-alist))
- (save-match-data
- (while (and (consp handlers) (null handler))
- (if (and (consp (car handlers))
- (stringp (car (car handlers)))
- (string-match (car (car handlers)) name))
- (setq handler (cdr (car handlers))))
- (setq handlers (cdr handlers))))
+ (let ((handler (find-file-name-handler name)))
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
(substring name 0
(rename-buffer name)
(set-buffer-modified-p (buffer-modified-p)))) ; force mode line update
-(defun make-directory-path (path)
- "Create all the directories along path that don't exist yet."
- (interactive "Fdirectory path to create: ")
- (let ((path (directory-file-name (expand-file-name path)))
- create-list)
- (while (not (file-exists-p path))
- (setq create-list (cons path create-list)
- path (directory-file-name (file-name-directory path))))
- (while create-list
- (make-directory (car create-list))
- (setq create-list (cdr create-list)))))
-
+(defun make-directory (dir &optional parents)
+ "Create the directory DIR and any nonexistent parent dirs."
+ (interactive "FMake directory: \nP")
+ (let ((handler (find-file-name-handler dir)))
+ (if handler
+ (funcall handler 'make-directory dir parents)
+ (if (not parents)
+ (make-directory-internal dir)
+ (let ((dir (directory-file-name (expand-file-name dir)))
+ create-list)
+ (while (not (file-exists-p dir))
+ (setq create-list (cons dir create-list)
+ dir (directory-file-name (file-name-directory dir))))
+ (while create-list
+ (make-directory-internal (car create-list))
+ (setq create-list (cdr create-list))))))))
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
This works by running a directory listing program
whose name is in the variable `ls-program'.
If WILDCARD, it also runs the shell specified by `shell-file-name'."
- (let (handler (handlers file-name-handler-alist))
- (save-match-data
- (while (and (consp handlers) (null handler))
- (if (and (consp (car handlers))
- (stringp (car (car handlers)))
- (string-match (car (car handlers)) file))
- (setq handler (cdr (car handlers))))
- (setq handlers (cdr handlers))))
+ (let ((handler (find-file-name-handler file)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
HCoop / bpt / emacs.git / blobdiff