;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+;; Maintainer: FSF
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Code:
+
(defconst delete-auto-save-files t
"*Non-nil means delete a buffer's auto-save file when the buffer is saved.")
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.")
"*When cleaning directory, number of versions to keep.")
(defvar trim-versions-without-asking nil
- "*If true, deletes excess backup versions silently.
-Otherwise asks confirmation.")
+ "*If t, deletes excess backup versions silently.
+If nil, asks confirmation. Any other value prevents any trimming.")
(defvar kept-old-versions 2
"*Number of oldest versions to keep when a new numbered backup is made.")
The command \\[normal-mode] always obeys local-variables lists
and ignores this variable.")
-(defconst enable-local-eval nil
+(defconst enable-local-eval 'maybe
"*Control processing of the \"variable\" `eval' in a file's local variables.
The value can be t, nil or something else.
A value of t means obey `eval' variables;
This is an interface to the function `load'."
(interactive "sLoad library: ")
(load library))
+
+;; OTHER is the other file to be compared.
+(defun file-local-copy (file)
+ "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 (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."
(let ((pop-up-windows t))
(pop-to-buffer buffer t)))
-(defun switch-to-buffer-other-screen (buffer)
- "Switch to buffer BUFFER in another screen."
- (interactive "BSwitch to buffer in other screen: ")
- (let ((pop-up-screens t))
+(defun switch-to-buffer-other-frame (buffer)
+ "Switch to buffer BUFFER in another frame."
+ (interactive "BSwitch to buffer in other frame: ")
+ (let ((pop-up-frames t))
(pop-to-buffer buffer)))
(defun find-file (filename)
(interactive "FFind file in other window: ")
(switch-to-buffer-other-window (find-file-noselect filename)))
-(defun find-file-other-screen (filename)
- "Edit file FILENAME, in another screen.
-May create a new screen, or reuse an existing one.
+(defun find-file-other-frame (filename)
+ "Edit file FILENAME, in another frame.
+May create a new frame, or reuse an existing one.
See the function `display-buffer'."
- (interactive "FFind file in other screen: ")
- (switch-to-buffer-other-screen (find-file-noselect filename)))
+ (interactive "FFind file in other frame: ")
+ (switch-to-buffer-other-frame (find-file-noselect filename)))
(defun find-file-read-only (filename)
"Edit file FILENAME but don't allow changes.
(find-file filename)
(setq buffer-read-only t))
-(defun find-file-read-only-other-screen (filename)
- "Edit file FILENAME in another screen but don't allow changes.
-Like \\[find-file-other-screen] but marks buffer as read-only.
+(defun find-file-read-only-other-frame (filename)
+ "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 "fFind file read-only other screen: ")
- (find-file-other-screen filename)
+ (interactive "fFind file read-only other frame: ")
+ (find-file-other-frame filename)
(setq buffer-read-only t))
(defun find-alternate-file (filename)
(and file
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
- (list (read-file-name "Find alternate file: " file-dir nil nil file-name))))
+ (list (read-file-name
+ "Find alternate file: " file-dir nil nil file-name))))
(and (buffer-modified-p)
;; (not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(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 a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
The buffer is not selected, just returned to the caller."
- (setq filename (expand-file-name filename))
- ;; Get rid of the prefixes added by the automounter.
- (if (and (string-match "^/tmp_mnt/" filename)
- (file-exists-p (file-name-directory
- (substring filename (1- (match-end 0))))))
- (setq filename (substring filename (1- (match-end 0)))))
- (setq filename (abbreviate-file-name filename))
+ (setq filename
+ (abbreviate-file-name
+ (expand-file-name filename)))
(if (file-directory-p 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))
("\\.el\\'" . emacs-lisp-mode)
("\\.mm\\'" . nroff-mode)
("\\.me\\'" . nroff-mode)
- ("\\.[12345678]\\'" . nroff-mode)
("\\.scm\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.lisp\\'" . lisp-mode)
;;; so more common ones above are found faster.
("\\.s\\'" . asm-mode)
("ChangeLog\\'" . change-log-mode)
+ ("ChangeLog.[0-9]+\\'" . change-log-mode)
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
+;; The following should come after the ChangeLog pattern
+;; for the sake of ChangeLog.1, etc.
+ ("\\.[12345678]\\'" . nroff-mode)
("\\.TeX\\'" . TeX-mode)
("\\.sty\\'" . LaTeX-mode)
("\\.bbl\\'" . LaTeX-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.texinfo\\'" . texinfo-mode)
+ ("\\.texi\\'" . texinfo-mode)
("\\.lsp\\'" . lisp-mode)
("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
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))
(y-or-n-p (format "Set local variables as specified at end of %s? "
(file-name-nondirectory buffer-file-name))))))))
(let ((continue t)
- prefix prefixlen suffix beg)
+ prefix prefixlen suffix beg
+ (enable-local-eval enable-local-eval))
;; The prefix is what comes before "local variables:" in its line.
;; The suffix is what comes after "local variables:" in its line.
(skip-chars-forward " \t")
(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)))
- (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)))
;; ask the user to confirm now, before doing anything.
;; But don't actually delete til later.
(and targets
+ (or (eq trim-versions-without-asking t) (eq trim-versions-without-asking nil))
(or trim-versions-without-asking
(y-or-n-p (format "Delete excess backup versions of %s? "
real-file-name))))))
(let ((attr (file-attributes real-file-name)))
(or (nth 9 attr)
(/= (nth 2 attr) (user-uid))))))
- (copy-file real-file-name backupname t t)
-; rename-file should delete old backup.
-; (condition-case ()
-; (delete-file backupname)
-; (file-error nil))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))
+ ;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
(setq setmodes (file-modes backupname)))
(file-error
(setq backupname (expand-file-name "~/%backup%~"))
(message "Cannot write backup file; backing up in ~/%%backup%%~")
(sleep-for 1)
- (copy-file real-file-name backupname t t)))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil)))))
-(defun file-name-sans-versions (name)
+(defun file-name-sans-versions (name &optional keep-backup-version)
"Return FILENAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
-redefine it."
- (substring name 0
- (if (eq system-type 'vax-vms)
- ;; VMS version number is (a) semicolon, optional
- ;; sign, zero or more digits or (b) period, option
- ;; sign, zero or more digits, provided this is the
- ;; second period encountered outside of the
- ;; device/directory part of the file name.
- (or (string-match ";[---+]?[0-9]*\\'" name)
- (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
- name)
- (match-beginning 1))
- (length name))
- (or (string-match "\\.~[0-9]+~\\'" name)
- (string-match "~\\'" name)
- (length name)))))
+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 (find-file-name-handler name)))
+ (if handler
+ (funcall handler 'file-name-sans-versions name keep-backup-version)
+ (substring name 0
+ (if (eq system-type 'vax-vms)
+ ;; VMS version number is (a) semicolon, optional
+ ;; sign, zero or more digits or (b) period, option
+ ;; sign, zero or more digits, provided this is the
+ ;; second period encountered outside of the
+ ;; device/directory part of the file name.
+ (or (string-match ";[---+]?[0-9]*\\'" name)
+ (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
+ name)
+ (match-beginning 1))
+ (length name))
+ (if keep-backup-version
+ (length name)
+ (or (string-match "\\.~[0-9]+~\\'" name)
+ (string-match "~\\'" name)
+ (length name))))))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
You may need to redefine `file-name-sans-versions' as well."
(string-match "~$" file))
+;; This is used in various files.
+;; The usage of bv-length is not very clean,
+;; but I can't see a good alternative,
+;; so as of now I am leaving it alone.
+(defun backup-extract-version (fn)
+ "Given the name of a numeric backup file, return the backup number.
+Uses the free variable `bv-length', whose value should be
+the index in the name where the version number begins."
+ (if (and (string-match "[0-9]+~$" fn bv-length)
+ (= (match-beginning 0) bv-length))
+ (string-to-int (substring fn bv-length -1))
+ 0))
+
;; I believe there is no need to alter this behavior for VMS;
;; since backup files are not made on VMS, it should not get called.
(defun find-backup-file-name (fn)
(possibilities (file-name-all-completions
base-versions
(file-name-directory fn)))
- (versions (sort (mapcar 'backup-extract-version possibilities)
+ (versions (sort (mapcar
+ (function backup-extract-version)
+ possibilities)
'<))
(high-water-mark (apply 'max 0 versions))
(deserve-versions-p
(rplacd (nthcdr (1- number-to-delete) v) ())
v))))))))
-(defun backup-extract-version (fn)
- (if (and (string-match "[0-9]+~$" fn bv-length)
- (= (match-beginning 0) bv-length))
- (string-to-int (substring fn bv-length -1))
- 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.
Optional second argument EXITING means ask about certain non-file buffers
as well as about file buffers."
(interactive "P")
- (save-excursion
+ (save-window-excursion
(if (zerop (map-y-or-n-p
(function
(lambda (buffer)
(set-buffer buffer)
(save-buffer)))
(buffer-list)
- '("buffer" "buffers" "save")))
+ '("buffer" "buffers" "save")
+ (list (list ?\C-r (lambda (buf)
+ (view-buffer buf)
+ (setq view-exit-action
+ '(lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer"))
+ ))
(message "(No files need saving)"))))
\f
(defun not-modified (&optional arg)
(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)
(princ "Directory ")
(princ dirname)
(terpri)
+ (save-excursion
+ (set-buffer "*Directory*")
+ (let ((wildcard (not (file-directory-p dirname))))
+ (insert-directory dirname switches wildcard (not wildcard)))))))
+
+(defvar insert-directory-program "ls"
+ "Absolute or relative name of the `ls' program used by `insert-directory'.")
+
+;; insert-directory
+;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
+;; FULL-DIRECTORY-P is nil.
+;; The single line of output must display FILE's name as it was
+;; given, namely, an absolute path name.
+;; - must insert exactly one line for each file if WILDCARD or
+;; FULL-DIRECTORY-P is t, plus one optional "total" line
+;; before the file lines, plus optional text after the file lines.
+;; Lines are delimited by "\n", so filenames containing "\n" are not
+;; allowed.
+;; File lines should display the basename.
+;; - must be consistent with
+;; - functions dired-move-to-filename, (these two define what a file line is)
+;; dired-move-to-end-of-filename,
+;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
+;; dired-insert-headerline
+;; dired-after-subdir-garbage (defines what a "total" line is)
+;; - variable dired-subdir-regexp
+(defun insert-directory (file switches &optional wildcard full-directory-p)
+ "Insert directory listing for of FILE, formatted according to SWITCHES.
+Leaves point after the inserted text.
+Optional third arg WILDCARD means treat FILE as shell wildcard.
+Optional fourth arg FULL-DIRECTORY-P means file is a directory and
+switches do not contain `d', so that a full listing is expected.
+
+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 (find-file-name-handler file)))
+ (if handler
+ (funcall handler 'insert-directory file switches
+ wildcard full-directory-p)
(if (eq system-type 'vax-vms)
- (vms-read-directory dirname switches standard-output)
- (if (file-directory-p dirname)
- (save-excursion
- (set-buffer "*Directory*")
- (call-process "ls" nil standard-output nil switches
- (setq default-directory
- (file-name-as-directory dirname))))
- (let ((default-directory (file-name-directory dirname)))
- (if (file-exists-p default-directory)
- (call-process shell-file-name nil standard-output nil
- "-c" (concat "exec ls "
- switches " "
- (file-name-nondirectory dirname)))
- (princ "No such directory: ")
- (princ dirname)
- (terpri))))))))
+ (vms-read-directory file switches (current-buffer))
+ (if wildcard
+ (let ((default-directory (file-name-directory file)))
+ (call-process shell-file-name nil t nil
+ "-c" (concat insert-directory-program
+ " -d " switches " "
+ (file-name-nondirectory file))))
+;;; ;; Chase links till we reach a non-link.
+;;; (let (symlink)
+;;; (while (setq symlink (file-symlink-p file))
+;;; (setq file symlink)))
+ (call-process insert-directory-program nil t nil switches file))))))
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
(let ((processes (process-list))
active)
(while processes
- (and (memq (process-status (car processes)) '(run stop))
+ (and (memq (process-status (car processes)) '(run stop open))
(let ((val (process-kill-without-query (car processes))))
(process-kill-without-query (car processes) val)
val)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
-(define-key ctl-x-4-map "o" 'display-buffer)
+(define-key ctl-x-4-map "\C-o" 'display-buffer)
-(define-key ctl-x-5-map "b" 'switch-to-buffer-other-screen)
-(define-key ctl-x-5-map "f" 'find-file-other-screen)
-(define-key ctl-x-5-map "\C-f" 'find-file-other-screen)
-(define-key ctl-x-5-map "r" 'find-file-read-only-other-screen)
+(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
+(define-key ctl-x-5-map "f" 'find-file-other-frame)
+(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
+(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
;;; files.el ends here
HCoop / bpt / emacs.git / blobdiff