;;; files.el --- file input and output commands for Emacs
;; Copyright (C) 1985, 86, 87, 92, 93,
-;; 94, 95, 1996 Free Software Foundation, Inc.
+;; 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
;; Maintainer: FSF
(defcustom delete-auto-save-files t
- "*Non-nil means delete auto-save file when a buffer is saved or killed."
+ "*Non-nil means delete auto-save file when a buffer is saved or killed.
+
+Note that auto-save file will not be deleted if the buffer is killed
+when it has unsaved changes."
:type 'boolean
:group 'auto-save)
If the file name matches one of these regular expressions,
then `revert-buffer' reverts the file without querying
if the file has changed on disk and you have not edited the buffer."
- :type 'boolean
+ :type '(repeat regexp)
:group 'find-file)
(defvar buffer-file-number nil
(defvar view-read-only nil
"*Non-nil means buffers visiting files read-only, do it in view mode.")
+(defvar system-tmp-directory
+ (directory-file-name
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+ ((memq system-type '(vax-vms axp-vms))
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
+ (t
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+ "The directory for writing temporary files--actually, its name as a file.")
+
;; This hook function provides support for ange-ftp host name
;; completion. It runs the usual ange-ftp hook, but only for
;; completion operations. Having this here avoids the need
"Value of the CDPATH environment variable, as a list.
Not actually set up until the first time you you use it.")
-(defvar path-separator ":"
- "Character used to separate directories in search paths.")
-
(defun parse-colon-path (cd-path)
"Explode a colon-separated search path into a list of directory names."
(and cd-path
(condition-case ()
(insert-file-contents-literally filename t)
(file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable"
+ filename)))
;; Unconditionally set error
(setq error t)))
(condition-case ()
(insert-file-contents filename t)
(file-error
+ (when (and (file-exists-p filename)
+ (not (file-readable-p filename)))
+ (kill-buffer buf)
+ (signal 'file-error (list "File is not readable"
+ filename)))
;; Run find-file-not-found-hooks until one returns non-nil.
(or (run-hook-with-args-until-success 'find-file-not-found-hooks)
;; If they fail too, set error.
(setq backup-inhibited t)))
(if rawfile
(progn
- (setq enable-multibyte-characters nil)
+ (set-buffer-multibyte nil)
+ (setq buffer-file-coding-system 'no-conversion)
(make-local-variable 'find-file-literally)
(setq find-file-literally t))
(after-find-file error (not nowarn))
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
- ("\\.pl\\'" . perl-mode)
- ("\\.pm\\'" . perl-mode)
+ ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
("\\.cc\\'" . c++-mode)
("\\.hh\\'" . c++-mode)
("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\'" . makefile-mode)
+ ("\\.am\\'" . makefile-mode) ;For Automake.
;;; Less common extensions come here
;;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
("\\.mc\\'" . m4-mode)
("\\.mf\\'" . metafont-mode)
("\\.mp\\'" . metapost-mode)
+ ("\\.vhdl?\\'" . vhdl-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.tcl\\'" . tcl-mode)
("\\`/tmp/Re" . text-mode)
("/Message[0-9]*\\'" . text-mode)
("/drafts/[0-9]+\\'" . mh-letter-mode)
+ ("\\.zone\\'" . zone-mode)
;; some news reader is reported to use this
("\\`/tmp/fol/" . text-mode)
("\\.y\\'" . c-mode)
calling FUNCTION (if it's not nil), we delete the suffix that matched
REGEXP and search the list again for another match.")
+
(defvar interpreter-mode-alist
'(("perl" . perl-mode)
("perl5" . perl-mode)
+ ("miniperl" . perl-mode)
("wish" . tcl-mode)
("wishx" . tcl-mode)
("tcl" . tcl-mode)
keep-going nil)))
(setq alist (cdr alist))))
(if mode
- (funcall mode)
+ ;; When JUST-FROM-FILE-NAME is set,
+ ;; we are working on behalf of set-visited-file-name.
+ ;; In that case, if the major mode specified is the
+ ;; same one we already have, don't actually reset it.
+ ;; We don't want to lose minor modes such as Font Lock.
+ (unless (and just-from-file-name (eq mode major-mode))
+ (funcall mode))
;; If we can't deduce a mode from the file name,
;; look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl",
;; Likewise for setting hook variables.
((or (get var 'risky-local-variable)
(and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
(symbol-name var))
(not (get var 'safe-local-variable))))
;; Permit evalling a put of a harmless property.
(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))
+ (and buffer-file-name
+ (not (funcall backup-enable-predicate buffer-file-name))
(progn
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
(read-file-name "Write file: "
(cdr (assq 'default-directory
(buffer-local-variables)))
- nil nil (buffer-name)))
+ nil nil (file-name-nondirectory (buffer-name))))
(not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
(error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
+ ;; Make buffer writable if file is writable.
+ (and buffer-file-name
+ (file-writable-p buffer-file-name)
+ (setq buffer-read-only nil))
(save-buffer))
\f
(defun backup-buffer ()
(defvar after-save-hook nil
"Normal hook that is run after a buffer is saved to its file.")
+(defvar save-buffer-coding-system nil
+ "If non-nil, use this coding system for saving the buffer.
+More precisely, use this coding system in place of the
+value of `buffer-file-coding-system', when saving the buffer.
+Calling `write-region' for any purpose other than saving the buffer
+will still use `buffer-file-coding-system'; this variable has no effect
+in such cases.")
+
(defun basic-save-buffer ()
"Save the current buffer in its visited file, if it has been modified.
After saving the buffer, run `after-save-hook'."
(interactive)
- (save-excursion
+ (save-current-buffer
;; In an indirect buffer, save its base buffer instead.
(if (buffer-base-buffer)
(set-buffer (buffer-base-buffer)))
(error "Save not confirmed"))
(save-restriction
(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
- (format "Buffer %s does not end in newline. Add one? "
- (buffer-name)))))
- (save-excursion
- (goto-char (point-max))
- (insert ?\n)))
+ (save-excursion
+ (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
+ (format "Buffer %s does not end in newline. Add one? "
+ (buffer-name)))))
+ (save-excursion
+ (goto-char (point-max))
+ (insert ?\n))))
(or (run-hook-with-args-until-success 'write-contents-hooks)
(run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-hooks)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(setq setmodes (basic-save-buffer-1)))
+ ;; Now we have saved the current buffer. Let's make sure
+ ;; that buffer-file-coding-system is fixed to what
+ ;; actually used for saving by binding it locally.
+ (if save-buffer-coding-system
+ (setq save-buffer-coding-system last-coding-system-used)
+ (setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
;; 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)
+ (let ((buffer-file-coding-system
+ (or save-buffer-coding-system
+ buffer-file-coding-system))
+ tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
(let ((dir (file-name-directory buffer-file-name)))
(if (not (file-directory-p dir))
or multiple mail buffers, etc."
(interactive)
(save-match-data
- (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
- (not (and buffer-file-name
- (string= (buffer-name)
- (file-name-nondirectory
- buffer-file-name)))))
- ;; If the existing buffer name has a <NNN>,
- ;; which isn't part of the file name (if any),
- ;; then get rid of that.
- (substring (buffer-name) 0 (match-beginning 0))
- (buffer-name)))
- (new-buf (generate-new-buffer base-name))
- (name (buffer-name new-buf)))
- (kill-buffer new-buf)
- (rename-buffer name)
+ (let ((base-name (buffer-name)))
+ (and (string-match "<[0-9]+>\\'" base-name)
+ (not (and buffer-file-name
+ (string= base-name
+ (file-name-nondirectory buffer-file-name))))
+ ;; If the existing buffer name has a <NNN>,
+ ;; which isn't part of the file name (if any),
+ ;; then get rid of that.
+ (setq base-name (substring base-name 0 (match-beginning 0))))
+ (rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
(defun make-directory (dir &optional parents)
(let ((file (dired-get-filename))
files
(buffer (get-buffer-create " *recover*")))
+ (dired-unmark 1)
(dired-do-flagged-delete t)
(unwind-protect
(save-excursion
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (or (= 0
- (if wildcard
- ;; Run ls in the directory of the file pattern we asked for.
- (let ((default-directory
- (if (file-name-absolute-p file)
- (file-name-directory 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 "\\" ;; Disregard shell aliases!
- insert-directory-program
- " -d "
- (if (stringp switches)
- switches
- (mapconcat 'identity switches " "))
- " -- "
- pattern)))
- ;; SunOS 4.1.3, SVr4 and others need the "." to list the
- ;; directory if FILE is a symbolic link.
- (apply 'call-process
- insert-directory-program nil t nil
- (let (list)
- (if (listp switches)
- (setq list switches)
- (if (not (equal switches ""))
- (progn
- ;; Split the switches at any spaces
- ;; so we can pass separate options as separate args.
- (while (string-match " " switches)
- (setq list (cons (substring switches 0 (match-beginning 0))
- list)
- switches (substring switches (match-end 0))))
- (setq list (nreverse (cons switches list))))))
- (append list
- ;; Avoid lossage if FILE starts with `-'.
- '("--")
- (list
- (if full-directory-p
- (concat (file-name-as-directory file) ".")
- file)))))))
- ;; We get here if ls failed.
- ;; Access the file to get a suitable error.
- (access-file file "Reading directory"))))))
+ (let* ((coding-system-for-read
+ (and enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ ;; This binding is for encoding arguements by call-process.
+ (coding-system-for-write coding-system-for-read)
+ (result
+ (if wildcard
+ ;; Run ls in the directory of the file pattern we asked for.
+ (let ((default-directory
+ (if (file-name-absolute-p file)
+ (file-name-directory 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 "\\";; Disregard shell aliases!
+ insert-directory-program
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " -- "
+ pattern)))
+ ;; SunOS 4.1.3, SVr4 and others need the "." to list the
+ ;; directory if FILE is a symbolic link.
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (let (list)
+ (if (listp switches)
+ (setq list switches)
+ (if (not (equal switches ""))
+ (progn
+ ;; Split the switches at any spaces
+ ;; so we can pass separate options as separate args.
+ (while (string-match " " switches)
+ (setq list (cons (substring switches 0 (match-beginning 0))
+ list)
+ switches (substring switches (match-end 0))))
+ (setq list (nreverse (cons switches list))))))
+ (append list
+ ;; Avoid lossage if FILE starts with `-'.
+ '("--")
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file) ".")
+ file))))))))
+ (if (/= result 0)
+ ;; We get here if ls failed.
+ ;; Access the file to get a suitable error.
+ (access-file file "Reading directory")))))))
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
(defun file-name-non-special (operation &rest arguments)
(let ((file-name-handler-alist nil)
+ (default-directory
+ (if (eq operation 'insert-directory)
+ (directory-file-name
+ (expand-file-name
+ (unhandled-file-name-directory default-directory)))
+ default-directory))
;; Get a list of the indices of the args which are file names.
(file-arg-indices
(cdr (or (assq operation
;; Strip off the /: from the file names that have this handler.
(save-match-data
(while (consp file-arg-indices)
- (and (nth (car file-arg-indices) arguments)
- (string-match "\\`/:" (nth (car file-arg-indices) arguments))
- (setcar (nthcdr (car file-arg-indices) arguments)
- (substring (nth (car file-arg-indices) arguments) 2)))
+ (let ((pair (nthcdr (car file-arg-indices) arguments)))
+ (and (car pair)
+ (string-match "\\`/:" (car pair))
+ (setcar pair
+ (if (= (length (car pair)) 2)
+ "/"
+ (substring (car pair) 2)))))
(setq file-arg-indices (cdr file-arg-indices))))
(if (eq file-arg-indices 'identity)
(car arguments)
HCoop / bpt / emacs.git / blobdiff