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.
+ "The abbreviated truename of the file visited in the current buffer.
+That is, (abbreviated-file-name (file-truename buffer-file-name)).
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)
"*Control use of version numbers for backup files.
t means make numeric backup versions unconditionally.
nil means make them for files that have some already.
-never means do not make them.")
+`never' means do not make them.")
(defvar dired-kept-versions 2
"*When cleaning directory, number of versions to keep.")
(defun ange-ftp-completion-hook-function (op &rest args)
(if (memq op '(file-name-completion file-name-all-completions))
(apply 'ange-ftp-hook-function op args)
- (let (file-name-handler-alist)
+ (let ((inhibit-file-name-handlers
+ (cons 'ange-ftp-completion-hook-function
+ (and (eq inhibit-file-name-operation op)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation op))
(apply op args))))
\f
(defun pwd ()
(interactive "sLoad library: ")
(load library))
-;; OTHER is the other file to be compared.
-(defun file-local-copy (file)
+(defun file-local-copy (file &optional buffer)
"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)))
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
(if handler
(funcall handler 'file-local-copy file)
nil)))
(setq filename (expand-file-name filename))
(if (string= filename "")
(setq filename "/"))))
- (let ((handler (find-file-name-handler filename)))
+ (let ((handler (find-file-name-handler filename 'file-truename)))
;; 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
directory where the file was found. If you *do not* want that, add the logical
name to this list as a string.")
+(defun find-buffer-visiting (filename)
+ "Return the buffer visiting file FILENAME (a string).
+This is like `get-file-buffer', except that it checks for any buffer
+visiting the same file, possibly under a different name.
+If there is no such live buffer, return nil."
+ (let ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or buf
+ (let ((list (buffer-list)) found)
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (string= buffer-file-truename truename))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let ((number (nthcdr 10 (file-attributes truename)))
+ (list (buffer-list)) found)
+ (and number
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (equal buffer-file-number number)
+ ;; Verify this buffer's file number
+ ;; still belongs to its file.
+ (file-exists-p buffer-file-name)
+ (equal (nthcdr 10 (file-attributes buffer-file-name))
+ number))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
+
(defun find-file-noselect (filename &optional nowarn)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(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 (and buffer-file-name
- (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 (and (equal buffer-file-number number)
- ;; Verify this buffer's file number
- ;; still belongs to its file.
- (file-exists-p buffer-file-name)
- (equal (nthcdr 10 (file-attributes buffer-file-name)) number))
- (setq found (car list))))
- (setq list (cdr list)))
- found))))
+ (other (and (not buf) (find-buffer-visiting filename)))
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 other
+ (progn
+ (or nowarn (message "%s and %s are the same file"
+ filename (buffer-file-name other)))
+ ;; Optionally also find that buffer.
+ (if (or find-file-existing-other-name find-file-visit-truename)
+ (setq buf other))))
(if buf
(or nowarn
(verify-visited-file-modtime buf)
t))))
(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-truename truename)
(setq buffer-file-number number)
;; On VMS, we may want to remember which directory in a search list
;; the file was found in.
the name of the interpreter specified in the first line.
If it matches, mode MODE is selected.")
-(defconst inhibit-local-variables-regexps '("\\.tar$")
- "List of regexps; if one matches a file name, don't look for local vars.")
+(defconst inhibit-first-line-modes-regexps '("\\.tar$")
+ "List of regexps; if one matches a file name, don't look for `-*-'.")
(defvar user-init-file
"" ; set by command-line
(skip-chars-forward " \t\n")
(and enable-local-variables
;; Don't look for -*- if this file name matches any
- ;; of the regexps in inhibit-local-variables-regexps.
- (let ((temp inhibit-local-variables-regexps))
+ ;; of the regexps in inhibit-first-line-modes-regexps.
+ (let ((temp inhibit-first-line-modes-regexps))
(while (and temp
(not (string-match (car temp)
buffer-file-name)))
(goto-char beg)
(if (save-excursion (search-forward ":" end t))
;; Find all specifications for the `mode:' variable
- ;; and execute hem left to right.
+ ;; and execute them left to right.
(while (let ((case-fold-search t))
(search-forward "mode:" end t))
(skip-chars-forward " \t")
;; set-auto-mode should already have handled that.
(save-excursion
(goto-char (point-min))
- (skip-chars-forward " \t\n\r")
- (let ((result '())
- (end (save-excursion (end-of-line) (point))))
+ (let ((result nil)
+ (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point))))
;; 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)))))))
+ ;; Simple form: "-*- MODENAME -*-". Already handled.
+ nil)
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
(val (save-restriction
(narrow-to-region (point) end)
(read (current-buffer)))))
- (setq result (cons (cons key val) result))
+ (or (eq key 'mode)
+ (setq result (cons (cons key val) result)))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
(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))))
- (or (eq key 'mode)
- (hack-one-local-variable key val)))
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
(setq result (cdr result)))))))
(defun hack-local-variables ()
'(enable-local-eval)
"Variables to be ignored in a file's local variable spec.")
+;; Get confirmation before setting these variables as locals in a file.
+(put 'eval 'risky-local-variable t)
+(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'minor-mode-map-alist 'risky-local-variable t)
+(put 'after-load-alist 'risky-local-variable t)
+
+(defun hack-one-local-variable-quotep (exp)
+ (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+
;; "Set" one variable in a local variables spec.
;; A few variable names are treated specially.
(defun hack-one-local-variable (var val)
nil)
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
- ((or (memq var '(eval file-name-handler-alist after-load-alist))
- (string-match "-hooks?$\\|-functions?$" (symbol-name var)))
- (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' or hook local variables in file %s? "
- (file-name-nondirectory buffer-file-name))))))))
+ ((or (get var 'risky-local-variable)
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$"
+ (symbol-name var)))
+ ;; Permit evaling a put of a harmless property
+ ;; if the args do nothing tricky.
+ (if (or (and (eq var 'eval)
+ (consp val)
+ (eq (car val) 'put)
+ (hack-one-local-variable-quotep (nth 1 val))
+ (hack-one-local-variable-quotep (nth 2 val))
+ ;; Only allow safe values of lisp-indent-hook;
+ ;; not functions.
+ (or (numberp (nth 3 val))
+ (eq (nth 3 val) 'defun))
+ (memq (nth 1 (nth 2 val))
+ '(lisp-indent-hook)))
+ ;; Permit eval if not root and user says ok.
+ (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' or hook local variables in file %s? "
+ (file-name-nondirectory buffer-file-name)))))))))
(if (eq var 'eval)
(save-excursion (eval val))
(make-local-variable var)
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
+ ;; If buffer was read-only because of version control,
+ ;; that reason is gone now, so make it writable.
+ (if vc-mode
+ (setq buffer-read-only nil))
+ (kill-local-variable 'vc-mode)
;; Turn off backup files for certain file names.
;; Since this is a permanent local, the major mode won't eliminate it.
(and (not (funcall backup-enable-predicate buffer-file-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)))
+ (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
(substring name 0
;; 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]*\\)\\'"
+ (or (string-match ";[-+]?[0-9]*\\'" name)
+ (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
name)
(match-beginning 1))
(length name))
(widen)
(and (> (point-max) 1)
(/= (char-after (1- (point-max))) ?\n)
+ (not (and (eq selective-display t)
+ (= (char-after (1- (point-max))) ?\r)))
(or (eq require-final-newline t)
(and require-final-newline
(y-or-n-p
(setq hooks (cdr hooks)))
;; If a hook returned t, file is already "written".
(cond ((not done)
- (if (not (file-writable-p buffer-file-name))
- (let ((dir (file-name-directory buffer-file-name)))
- (if (not (file-directory-p dir))
- (error "%s is not a directory" dir)
- (if (not (file-exists-p buffer-file-name))
- (error "Directory %s write-protected" dir)
- (if (yes-or-no-p
- (format "File %s is write-protected; try to save anyway? "
- (file-name-nondirectory
- buffer-file-name)))
- (setq tempsetmodes t)
- (error "Attempt to save to a file which you aren't allowed to write"))))))
- (or buffer-backed-up
- (setq setmodes (backup-buffer)))
- (if file-precious-flag
- ;; 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)
- tempname nil realname)
- (setq succeed t))
- ;; If writing the temp file fails,
- ;; delete the temp file.
- (or succeed (delete-file tempname)))
- ;; Since we have created an entirely new file
- ;; and renamed it, make sure it gets the
- ;; right permission bits set.
- (setq setmodes (file-modes buffer-file-name))
- ;; 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
- ;; (setmodes is set) because that says we're superseding.
- (cond ((and tempsetmodes (not setmodes))
- ;; Change the mode back, after writing.
- (setq setmodes (file-modes buffer-file-name))
- (set-file-modes buffer-file-name 511)))
- (write-region (point-min) (point-max)
- buffer-file-name nil t)))))
+ (setq setmodes (basic-save-buffer-1)))))
(setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(run-hooks 'after-save-hook))
(message "(No changes need to be saved)")))
+;; This does the "real job" of writing a buffer into its visited file
+;; and making a backup file. This is what is normally done
+;; but inhibited if one of write-file-hooks returns non-nil.
+;; It returns a value to store in setmodes.
+(defun basic-save-buffer-1 ()
+ (let (tempsetmodes setmodes)
+ (if (not (file-writable-p buffer-file-name))
+ (let ((dir (file-name-directory buffer-file-name)))
+ (if (not (file-directory-p dir))
+ (error "%s is not a directory" dir)
+ (if (not (file-exists-p buffer-file-name))
+ (error "Directory %s write-protected" dir)
+ (if (yes-or-no-p
+ (format "File %s is write-protected; try to save anyway? "
+ (file-name-nondirectory
+ buffer-file-name)))
+ (setq tempsetmodes t)
+ (error "Attempt to save to a file which you aren't allowed to write"))))))
+ (or buffer-backed-up
+ (setq setmodes (backup-buffer)))
+ (if file-precious-flag
+ ;; 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)
+ tempname nil realname)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed (delete-file tempname)))
+ ;; Since we have created an entirely new file
+ ;; and renamed it, make sure it gets the
+ ;; right permission bits set.
+ (setq setmodes (file-modes buffer-file-name))
+ ;; 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
+ ;; (setmodes is set) because that says we're superseding.
+ (cond ((and tempsetmodes (not setmodes))
+ ;; Change the mode back, after writing.
+ (setq setmodes (file-modes buffer-file-name))
+ (set-file-modes buffer-file-name 511)))
+ (write-region (point-min) (point-max)
+ buffer-file-name nil t))
+ setmodes))
+
(defun save-some-buffers (&optional arg exiting)
"Save some modified file-visiting buffers. Asks user about each one.
Optional argument (the prefix) non-nil means save all with no questions.
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
- (let ((handler (find-file-name-handler dir)))
+ (let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
(if (not parents)
(let ((buffer-file-name nil))
(or auto-save-p
(unlock-buffer)))
+ (widen)
(insert-file-contents file-name (not auto-save-p)
nil nil t)))
(goto-char (min opoint (point-max)))
(not buffer-read-only))
buffer-file-name
(make-auto-save-file-name))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0))
(if (interactive-p)
(message "Auto-save %s (in this buffer)"
(if buffer-auto-save-file-name "on" "off")))
This works by running a directory listing program
whose name is in the variable `insert-directory-program'.
If WILDCARD, it also runs the shell specified by `shell-file-name'."
- (let ((handler (find-file-name-handler file)))
+ (let ((handler (find-file-name-handler file 'insert-directory)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(let ((default-directory
(if (file-name-absolute-p file)
(file-name-directory file)
- (file-name-directory (expand-file-name file)))))
+ (file-name-directory (expand-file-name file))))
+ (pattern (file-name-nondirectory file))
+ (beg 0))
+ ;; Quote some characters that have special meanings in shells;
+ ;; but don't quote the wildcards--we want them to be special.
+ ;; We also currently don't quote the quoting characters
+ ;; in case people want to use them explicitly to quote
+ ;; wildcard characters.
+ (while (string-match "[ \t\n;<>&|{}()#$]" pattern beg)
+ (setq pattern
+ (concat (substring pattern 0 (match-beginning 0))
+ "\\"
+ (substring pattern (match-beginning 0)))
+ beg (1+ (match-end 0))))
(call-process shell-file-name nil t nil
"-c" (concat insert-directory-program
" -d " switches " "
- (file-name-nondirectory file))))
+ pattern)))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
(call-process insert-directory-program nil t nil switches
HCoop / bpt / emacs.git / blobdiff