Automatically local in all buffers.")
(make-variable-buffer-local 'buffer-offer-save)
+(defconst find-file-existing-other-name nil
+ "*Non-nil means find a file under alternative names, in existing buffers.
+This means if any existing buffer is visiting the file you want
+under another name, you get the existing buffer instead of a new buffer.")
+
+(defconst find-file-visit-truename nil
+ "*Non-nil means visit a file under its truename.
+The truename of a file is found by chasing all links
+both at the file level and at the levels of the containing directories.")
+
+(defvar buffer-file-truename nil
+ "The truename of the file visited in the current buffer.
+This variable is automatically local in all buffers, when non-nil.")
+(make-variable-buffer-local 'buffer-file-truename)
+(put 'buffer-file-truename 'permanent-local t)
+
+(defvar buffer-file-number nil
+ "The device number and file number of the file visited in the current buffer.
+The value is a list of the form (FILENUM DEVNUM).
+This pair of numbers uniquely identifies the file.
+If the buffer is visiting a new file, the value is nil.")
+(make-variable-buffer-local 'buffer-file-number)
+(put 'buffer-file-number 'permanent-local t)
+
(defconst file-precious-flag nil
"*Non-nil means protect against I/O errors while saving files.
Some modes set this non-nil in particular buffers.")
"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)))
+
+(defun file-truename (filename)
+ "Return the truename of FILENAME, which should be absolute.
+The truename of a file name is found by chasing symbolic links
+both at the level of the file and at the level of the directories
+containing it, until no links are left at any level."
+ (if (string= filename "~")
+ (setq filename (expand-file-name filename)))
+ (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
+ (funcall handler 'file-truename filename)
+ (let ((dir (file-name-directory filename))
+ target dirfile)
+ ;; Get the truename of the directory.
+ (setq dirfile (directory-file-name dir))
+ ;; If these are equal, we have the (or a) root directory.
+ (or (string= dir dirfile)
+ (setq dir (file-name-as-directory (file-truename dirfile))))
+ ;; Put it back on the file name.
+ (setq filename (concat dir (file-name-nondirectory filename)))
+ ;; Is the file name the name of a link?
+ (setq target (file-symlink-p filename))
+ (if target
+ ;; Yes => chase that link, then start all over
+ ;; since the link may point to a directory name that uses links.
+ (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))
(if find-file-run-dired
(dired-noselect filename)
(error "%s is a directory." filename))
- (let ((buf (get-file-buffer filename))
- error)
+ (let* ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename)))
+ (number (nthcdr 10 (file-attributes truename)))
+ ;; Find any buffer for a file which has same truename.
+ (same-truename
+ (or buf ; Shortcut
+ (let (found
+ (list (buffer-list)))
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (string= buffer-file-truename truename)
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)))
+ (same-number
+ (or buf ; Shortcut
+ (and number
+ (let (found
+ (list (buffer-list)))
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (equal buffer-file-number number)
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found))))
+ error)
+ ;; Let user know if there is a buffer with the same truename.
+ (if (and (not buf) same-truename (not nowarn))
+ (message "%s and %s are the same file (%s)"
+ filename (buffer-file-name same-truename)
+ truename)
+ (if (and (not buf) same-number (not nowarn))
+ (message "%s and %s are the same file"
+ filename (buffer-file-name same-number))))
+
+ ;; Optionally also find that buffer.
+ (if (or find-file-existing-other-name find-file-visit-truename)
+ (setq buf (or same-truename same-number)))
(if buf
(or nowarn
(verify-visited-file-modtime buf)
(set-buffer buf)
(revert-buffer t t)))))
(save-excursion
- (let* ((link-name (car (file-attributes filename)))
- (linked-buf (and (stringp link-name)
- (get-file-buffer link-name))))
- (if (bufferp linked-buf)
- (message "Symbolic link to file in buffer %s"
- (buffer-name linked-buf))))
+;;; The truename stuff makes this obsolete.
+;;; (let* ((link-name (car (file-attributes filename)))
+;;; (linked-buf (and (stringp link-name)
+;;; (get-file-buffer link-name))))
+;;; (if (bufferp linked-buf)
+;;; (message "Symbolic link to file in buffer %s"
+;;; (buffer-name linked-buf))))
(setq buf (create-file-buffer filename))
(set-buffer buf)
(erase-buffer)
(while (and hooks
(not (funcall (car hooks))))
(setq hooks (cdr hooks))))))
+ ;; Find the file's truename, and maybe use that as visited name.
+ (setq buffer-file-truename (abbreviate-file-name truename))
+ (setq buffer-file-number number)
+ (if find-file-visit-truename (setq filename buffer-file-truename))
;; Set buffer's default directory to that of the file.
(setq default-directory (file-name-directory filename))
;; Turn off backup files for certain file names. Since
(after-find-file error (not nowarn))))
buf)))
\f
-(defun after-find-file (&optional error warn)
+(defun after-find-file (&optional error warn noauto)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
-Optional args ERROR and WARN: ERROR non-nil means there was an
+Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
+NOAUTO means don't mess with auto-save mode.
Finishes by calling the functions in `find-file-hooks'."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
"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)
(or not-serious (sit-for 1 nil t)))))
- (if auto-save-default
+ (if (and auto-save-default (not noauto))
(auto-save-mode t)))
(normal-mode t)
(mapcar 'funcall find-file-hooks))
not check for the \"mode:\" local variable in the Local Variables
section of the file; for that, use `hack-local-variables'.
-If enable-local-variables is nil, this function will not check for a
+If `enable-local-variables' is nil, this function does not check for a
-*- mode tag."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let (beg end mode)
(setq alist (cdr alist)))))))
(if mode (funcall mode))))
+(defun hack-local-variables-prop-line ()
+ ;; Set local variables specified in the -*- line.
+ ;; Returns t if mode was set.
+ (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\r")
+ (let ((result '())
+ (end (save-excursion (end-of-line) (point)))
+ mode-p)
+ ;; Parse the -*- line into the `result' alist.
+ (cond ((not (search-forward "-*-" end t))
+ ;; doesn't have one.
+ nil)
+ ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
+ ;; Simple form: "-*- MODENAME -*-".
+ (setq result
+ (list (cons 'mode
+ (intern (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))))
+ (t
+ ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
+ ;; (last ";" is optional).
+ (save-excursion
+ (if (search-forward "-*-" end t)
+ (setq end (- (point) 3))
+ (error "-*- not terminated before end of line")))
+ (while (< (point) end)
+ (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
+ (error "malformed -*- line"))
+ (goto-char (match-end 0))
+ (let ((key (intern (downcase (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))
+ (val (save-restriction
+ (narrow-to-region (point) end)
+ (read (current-buffer)))))
+ (setq result (cons (cons key val) result))
+ (skip-chars-forward " \t;")))
+ (setq result (nreverse result))))
+
+ ;; Mode is magic.
+ (let (mode)
+ (while (setq mode (assq 'mode result))
+ (setq mode-p t result (delq mode result))
+ (funcall (intern (concat (downcase (symbol-name (cdr mode)))
+ "-mode")))))
+
+ (if (and result
+ (or (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
+ (file-name-nondirectory buffer-file-name)))))))
+ (while result
+ (let ((key (car (car result)))
+ (val (cdr (car result))))
+ ;; 'mode has already been removed from this list.
+ (hack-one-local-variable key val))
+ (setq result (cdr result))))
+ mode-p)))
+
(defun hack-local-variables ()
- "Parse (and bind or evaluate as appropriate) any local variables
-for current buffer."
+ "Parse and put into effect this buffer's local variables spec."
+ (hack-local-variables-prop-line)
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(or (if suffix (looking-at suffix) (eolp))
(error "Local variables entry is terminated incorrectly"))
;; Set the variable. "Variables" mode and eval are funny.
- (cond ((eq var 'mode)
- (funcall (intern (concat (downcase (symbol-name val))
- "-mode"))))
- ((eq var 'eval)
- (if (and (not (string= (user-login-name) "root"))
- (or (eq enable-local-eval t)
- (and enable-local-eval
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (save-excursion
- (beginning-of-line)
- (set-window-start (selected-window) (point)))
- (setq enable-local-eval
- (y-or-n-p (format "Process `eval' local variable in file %s? "
- (file-name-nondirectory buffer-file-name))))))))
- (save-excursion (eval val))
- (message "Ignoring `eval:' in file's local variables")))
- (t (make-local-variable var)
- (set var val))))))))))
+ (hack-one-local-variable var val))))))))
+
+(defconst ignored-local-variables
+ '(enable-local-eval)
+ "Variables to be ignored in a file's local variable spec.")
+
+;; "Set" one variable in a local variables spec.
+;; A few variable names are treated specially.
+(defun hack-one-local-variable (var val)
+ (cond ((eq var 'mode)
+ (funcall (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ ((memq var ignored-local-variables)
+ nil)
+ ;; "Setting" eval means either eval it or do nothing.
+ ((eq var 'eval)
+ (if (and (not (string= (user-login-name) "root"))
+ (or (eq enable-local-eval t)
+ (and enable-local-eval
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point)))
+ (setq enable-local-eval
+ (y-or-n-p (format "Process `eval' local variable in file %s? "
+ (file-name-nondirectory buffer-file-name))))))))
+ (save-excursion (eval val))
+ (message "Ignoring `eval:' in file's local variables")))
+ ;; Ordinary variable, really set it.
+ (t (make-local-variable var)
+ (set var val))))
+
\f
(defun set-visited-file-name (filename)
"Change name of file visited in current buffer to FILENAME.
(rename-buffer new-name t)))
(setq buffer-backed-up nil)
(clear-visited-file-modtime)
+ (if filename
+ (progn
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
+ (if find-file-visit-truename
+ (setq buffer-file-name buffer-file-truename))
+ (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))))
+ (setq buffer-file-truename nil buffer-file-number nil))
;; write-file-hooks is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
;; Changing to visit an ordinary local file instead should flush the hook.
(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
(defun file-nlinks (filename)
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
+
+(defun file-relative-name-1 (directory)
+ (cond ((string= directory "/")
+ filename)
+ ((string-match (concat "^" (regexp-quote directory))
+ filename)
+ (substring filename (match-end 0)))
+ (t
+ (file-relative-name-1
+ (file-name-directory (substring directory 0 -1))))))
+
+(defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
+ (setq filename (expand-file-name filename)
+ directory (file-name-as-directory (if directory
+ (expand-file-name directory)
+ default-directory)))
+ (file-relative-name-1 directory))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(or buffer-backed-up
(setq setmodes (backup-buffer)))
(if file-precious-flag
- ;; If file is precious, rename it away before
- ;; overwriting it.
- (let ((rename t)
- realname tempname temp)
- ;; Chase symlinks; rename the ultimate actual file.
- (setq realname buffer-file-name)
- (while (setq temp (file-symlink-p realname))
- (setq realname temp))
- (setq tempname (concat realname "#"))
- (condition-case ()
- (progn (rename-file realname tempname t)
- (setq setmodes (file-modes tempname)))
- (file-error (setq rename nil tempname nil)))
- (if (file-directory-p realname)
- (error "%s is a directory" realname))
+ ;; If file is precious, write temp name, then rename it.
+ (let ((dir (file-name-directory buffer-file-name))
+ (realname buffer-file-name)
+ tempname temp nogood i succeed)
+ (setq i 0)
+ (setq nogood t)
+ ;; Find the temporary name to write under.
+ (while nogood
+ (setq tempname (format "%s#tmp#%d" dir i))
+ (setq nogood (file-exists-p tempname))
+ (setq i (1+ i)))
(unwind-protect
(progn (clear-visited-file-modtime)
(write-region (point-min) (point-max)
- realname nil t)
- (setq rename nil))
- ;; If rename is still t, writing failed.
- ;; So rename the old file back to original name,
- (if rename
- (progn
- (rename-file tempname realname t)
- (clear-visited-file-modtime))
- ;; Otherwise we don't need the original file,
- ;; so flush it, if we still have it.
- ;; If rename failed due to name length restriction
- ;; then TEMPNAME is now nil.
- (if tempname
- (condition-case ()
- (delete-file tempname)
- (error nil))))))
+ tempname nil realname)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed (delete-file tempname)))
+ ;; We succeeded in writing the temp file,
+ ;; so rename it.
+ (rename-file tempname buffer-file-name t))
;; If file not writable, see if we can make it writable
;; temporarily while we write it.
;; But no need to do so if we have just backed it up
(set-file-modes buffer-file-name 511)))
(write-region (point-min) (point-max)
buffer-file-name nil t)))))
+ (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
- (set-file-modes buffer-file-name setmodes)
+ (set-file-modes buffer-file-name setmodes)
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
(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
(erase-buffer))
(insert-file-contents file-name (not auto-save-p))))
(goto-char (min opoint (point-max)))
- (after-find-file nil)
+ (after-find-file nil nil t)
t)))))
(defun recover-file (file)
(let ((buffer-read-only nil))
(erase-buffer)
(insert-file-contents file-name nil))
- (after-find-file nil))
+ (after-find-file nil nil t))
(t (error "Recover-file cancelled.")))))
(defun kill-some-buffers ()
\f
(defun auto-save-mode (arg)
"Toggle auto-saving of contents of current buffer.
-With ARG, turn auto-saving on if positive, else off."
+With prefix argument ARG, turn auto-saving on if positive, else off."
(interactive "P")
(setq buffer-auto-save-file-name
(and (if (null arg)
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