Mercurial > emacs

comparison lisp/files.el @ 8362:87e1b76bbd6b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(set-auto-mode): Shorten scope of case-fold-search binding. (cd-absolute): Call file-name-as-directory first thing. (basic-save-buffer-1): Ignore file-precious-flag if the file's dir is not writable.
author Richard M. Stallman <rms@gnu.org>
date Wed, 27 Jul 1994 18:55:38 +0000
parents 6f692cc01d52
children 4c6590fc242e
comparison
equal deleted inserted replaced
8361:2ea2644e07fb 8362:87e1b76bbd6b
276 (setq cd-start (+ cd-colon 1))) 276 (setq cd-start (+ cd-colon 1)))
277 cd-list))) 277 cd-list)))
278 278
279 (defun cd-absolute (dir) 279 (defun cd-absolute (dir)
280 "Change current directory to given absolute file name DIR." 280 "Change current directory to given absolute file name DIR."
281 (setq dir (abbreviate-file-name (expand-file-name dir))) 281 ;; Put the name into directory syntax now,
282 ;; because otherwise expand-file-name may give some bad results.
282 (if (not (eq system-type 'vax-vms)) 283 (if (not (eq system-type 'vax-vms))
283 (setq dir (file-name-as-directory dir))) 284 (setq dir (file-name-as-directory dir)))
285 (setq dir (abbreviate-file-name (expand-file-name dir)))
284 (if (not (file-directory-p dir)) 286 (if (not (file-directory-p dir))
285 (error "%s is not a directory" dir) 287 (error "%s is not a directory" dir)
286 (if (file-executable-p dir) 288 (if (file-executable-p dir)
287 (setq default-directory dir) 289 (setq default-directory dir)
288 (error "Cannot cd to %s: Permission denied" dir)))) 290 (error "Cannot cd to %s: Permission denied" dir))))
962 (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode")))) 964 (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode"))))
963 (setq done t))) 965 (setq done t)))
964 ;; If we didn't find a mode from a -*- line, try using the file name. 966 ;; If we didn't find a mode from a -*- line, try using the file name.
965 (if (and (not done) buffer-file-name) 967 (if (and (not done) buffer-file-name)
966 (let ((name buffer-file-name) 968 (let ((name buffer-file-name)
967 (case-fold-search (eq system-type 'vax-vms))
968 (keep-going t)) 969 (keep-going t))
969 ;; Remove backup-suffixes from file name. 970 ;; Remove backup-suffixes from file name.
970 (setq name (file-name-sans-versions name)) 971 (setq name (file-name-sans-versions name))
971 (while keep-going 972 (while keep-going
972 (setq keep-going nil) 973 (setq keep-going nil)
973 (let ((alist auto-mode-alist) 974 (let ((alist auto-mode-alist)
974 (mode nil)) 975 (mode nil))
975 ;; Find first matching alist entry. 976 ;; Find first matching alist entry.
976 (while (and (not mode) alist) 977 (let ((case-fold-search (eq system-type 'vax-vms)))
977 (if (string-match (car (car alist)) name) 978 (while (and (not mode) alist)
978 (if (and (consp (cdr (car alist))) 979 (if (string-match (car (car alist)) name)
979 (nth 2 (car alist))) 980 (if (and (consp (cdr (car alist)))
980 (progn 981 (nth 2 (car alist)))
981 (setq mode (car (cdr (car alist))) 982 (progn
982 name (substring name 0 (match-beginning 0)) 983 (setq mode (car (cdr (car alist)))
983 keep-going t)) 984 name (substring name 0 (match-beginning 0))
984 (setq mode (cdr (car alist)) 985 keep-going t))
985 keep-going nil))) 986 (setq mode (cdr (car alist))
986 (setq alist (cdr alist))) 987 keep-going nil)))
988 (setq alist (cdr alist))))
987 (if mode 989 (if mode
988 (funcall mode) 990 (funcall mode)
989 ;; If we can't deduce a mode from the file name, 991 ;; If we can't deduce a mode from the file name,
990 ;; look for an interpreter specified in the first line. 992 ;; look for an interpreter specified in the first line.
991 (let ((interpreter 993 (let ((interpreter
1631 buffer-file-name))) 1633 buffer-file-name)))
1632 (setq tempsetmodes t) 1634 (setq tempsetmodes t)
1633 (error "Attempt to save to a file which you aren't allowed to write")))))) 1635 (error "Attempt to save to a file which you aren't allowed to write"))))))
1634 (or buffer-backed-up 1636 (or buffer-backed-up
1635 (setq setmodes (backup-buffer))) 1637 (setq setmodes (backup-buffer)))
1636 (if file-precious-flag 1638 (let ((dir (file-name-directory buffer-file-name)))
1637 ;; If file is precious, write temp name, then rename it. 1639 (if (and file-precious-flag
1638 (let ((dir (file-name-directory buffer-file-name)) 1640 (file-writable-p dir))
1639 (realname buffer-file-name) 1641 ;; If file is precious, write temp name, then rename it.
1640 tempname temp nogood i succeed) 1642 ;; This requires write access to the containing dir,
1641 (setq i 0) 1643 ;; which is why we don't try it if we don't have that access.
1642 (setq nogood t) 1644 (let ((realname buffer-file-name)
1643 ;; Find the temporary name to write under. 1645 tempname temp nogood i succeed)
1644 (while nogood 1646 (setq i 0)
1645 (setq tempname (format "%s#tmp#%d" dir i)) 1647 (setq nogood t)
1646 (setq nogood (file-exists-p tempname)) 1648 ;; Find the temporary name to write under.
1647 (setq i (1+ i))) 1649 (while nogood
1648 (unwind-protect 1650 (setq tempname (format "%s#tmp#%d" dir i))
1649 (progn (clear-visited-file-modtime) 1651 (setq nogood (file-exists-p tempname))
1650 (write-region (point-min) (point-max) 1652 (setq i (1+ i)))
1651 tempname nil realname) 1653 (unwind-protect
1652 (setq succeed t)) 1654 (progn (clear-visited-file-modtime)
1653 ;; If writing the temp file fails, 1655 (write-region (point-min) (point-max)
1654 ;; delete the temp file. 1656 tempname nil realname)
1655 (or succeed (delete-file tempname))) 1657 (setq succeed t))
1656 ;; Since we have created an entirely new file 1658 ;; If writing the temp file fails,
1657 ;; and renamed it, make sure it gets the 1659 ;; delete the temp file.
1658 ;; right permission bits set. 1660 (or succeed (delete-file tempname)))
1659 (setq setmodes (file-modes buffer-file-name)) 1661 ;; Since we have created an entirely new file
1660 ;; We succeeded in writing the temp file, 1662 ;; and renamed it, make sure it gets the
1661 ;; so rename it. 1663 ;; right permission bits set.
1662 (rename-file tempname buffer-file-name t)) 1664 (setq setmodes (file-modes buffer-file-name))
1663 ;; If file not writable, see if we can make it writable 1665 ;; We succeeded in writing the temp file,
1664 ;; temporarily while we write it. 1666 ;; so rename it.
1665 ;; But no need to do so if we have just backed it up 1667 (rename-file tempname buffer-file-name t))
1666 ;; (setmodes is set) because that says we're superseding. 1668 ;; If file not writable, see if we can make it writable
1667 (cond ((and tempsetmodes (not setmodes)) 1669 ;; temporarily while we write it.
1668 ;; Change the mode back, after writing. 1670 ;; But no need to do so if we have just backed it up
1669 (setq setmodes (file-modes buffer-file-name)) 1671 ;; (setmodes is set) because that says we're superseding.
1670 (set-file-modes buffer-file-name 511))) 1672 (cond ((and tempsetmodes (not setmodes))
1671 (write-region (point-min) (point-max) 1673 ;; Change the mode back, after writing.
1672 buffer-file-name nil t)) 1674 (setq setmodes (file-modes buffer-file-name))
1675 (set-file-modes buffer-file-name 511)))
1676 (write-region (point-min) (point-max)
1677 buffer-file-name nil t)))
1673 setmodes)) 1678 setmodes))
1674 1679
1675 (defun save-some-buffers (&optional arg exiting) 1680 (defun save-some-buffers (&optional arg exiting)
1676 "Save some modified file-visiting buffers. Asks user about each one. 1681 "Save some modified file-visiting buffers. Asks user about each one.
1677 Optional argument (the prefix) non-nil means save all with no questions. 1682 Optional argument (the prefix) non-nil means save all with no questions.