1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-11 16:08:13 +00:00

(buffer-file-number): New variable.

(find-file-noselect): Record the file's filenum and devnum.
Notify if any buffer has the same values.
(basic-save-buffer): Save new filenum and devnum.
For file-precious-flag, pass real name as VISIT arg of write-region.
(set-visited-file-name): Likewise.
Clear buffer-file-{number,truename} if now visiting no file.
This commit is contained in:
Richard M. Stallman 1992-10-12 04:45:53 +00:00
parent f77ffc3d77
commit f3e2360646

View File

@ -92,6 +92,30 @@ even if the buffer is not visiting a file.
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.")
@ -238,6 +262,27 @@ accessible."
(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."
(let ((dir (file-name-directory filename))
target)
;; Get the truename of the directory.
(or (string= dir "/")
(setq dir (file-name-as-directory (file-truename (directory-file-name dir)))))
;; Put it back on the file name.
(setq filename (concat (file-name-nondirectory filename) dir))
;; 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)))
(defun switch-to-buffer-other-window (buffer)
"Select buffer BUFFER in another window."
@ -379,8 +424,46 @@ The buffer is not selected, just returned to the caller."
(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)
@ -396,12 +479,13 @@ The buffer is not selected, just returned to the caller."
(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)
@ -414,6 +498,10 @@ The buffer is not selected, just returned to the caller."
(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
@ -562,7 +650,7 @@ compares the filename against the entries in auto-mode-alist. It does
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)
@ -609,8 +697,72 @@ If enable-local-variables is nil, this function will not check for a
(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 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))
@ -674,27 +826,39 @@ If enable-local-variables is nil, this function will not check for a
(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 'enable-local-eval)
nil)
((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))))
(defun set-visited-file-name (filename)
"Change name of file visited in current buffer to FILENAME.
@ -724,6 +888,14 @@ if you wish to pass an empty string as the argument."
(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.
@ -1067,40 +1239,28 @@ the last real save, but optional arg FORCE non-nil means delete anyway."
(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
@ -1111,9 +1271,10 @@ the last real save, but optional arg FORCE non-nil means delete anyway."
(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.
@ -1355,7 +1516,7 @@ do the work."
(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)