;;; 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
(defgroup backup nil
"Backups of edited data files."
- :group 'data)
+ :group 'files)
(defgroup find-file nil
- "Finding and editing files."
- :group 'data)
+ "Finding files."
+ :group 'files)
(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
"*Value of t says silently ensure a file ends in a newline when it is saved.
Non-nil but not t says ask user whether to add a newline when there isn't one.
nil means don't add newlines."
- :type 'boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Add" t)
+ (sexp :tag "Ask" :format "%t\n" ask))
:group 'editing-basics)
(defcustom auto-save-default t
(or (fboundp 'file-locked-p)
(defalias 'file-locked-p 'ignore))
+(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
(setq dir (file-name-as-directory dir)))
(setq dir (abbreviate-file-name (expand-file-name dir)))
(if (not (file-directory-p dir))
- (error "%s is not a directory" dir)
+ (if (file-exists-p dir)
+ (error "%s is not a directory" dir)
+ (error "%s: no such directory" dir))
(if (file-executable-p dir)
(setq default-directory dir)
(error "Cannot cd to %s: Permission denied" dir))))
(let ((tem (copy-sequence file-name-handler-alist)))
(delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
(or prev-dirs (setq prev-dirs (list nil)))
+
+ ;; andrewi@harlequin.co.uk - none of the following code (except for
+ ;; invoking the file-name handler) currently applies on Windows
+ ;; (ie. there are no native symlinks), but there is an issue with
+ ;; case differences being ignored by the OS, and short "8.3 DOS"
+ ;; name aliases existing for all files. (The short names are not
+ ;; reported by directory-files, but can be used to refer to files.)
+ ;; It seems appropriate for file-truename to resolve these issues in
+ ;; the most natural way, which on Windows is to call the function
+ ;; `w32-long-file-name' - this returns the exact name of a file as
+ ;; it is stored on disk (expanding short name aliases with the full
+ ;; name in the process).
+ (if (eq system-type 'windows-nt)
+ (let ((handler (find-file-name-handler filename 'file-truename))
+ newname)
+ ;; 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
+ (setq filename (funcall handler 'file-truename filename))
+ ;; If filename contains a wildcard, newname will be the old name.
+ (if (string-match "[*?]" filename)
+ (setq newname filename)
+ ;; If filename doesn't exist, newname will be nil.
+ (setq newname (w32-long-file-name filename)))
+ (setq filename (or newname filename)))
+ (setq done t)))
+
;; If this file directly leads to a link, process that iteratively
;; so that we don't use lots of stack.
(while (not done)
unlike `file-truename'."
(let (tem (count 100) (newname filename))
(while (setq tem (file-symlink-p newname))
- (if (= count 0)
- (error "Apparent cycle of symbolic links for %s" filename))
- ;; In the context of a link, `//' doesn't mean what Emacs thinks.
- (while (string-match "//+" tem)
- (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
- (substring tem (match-end 0)))))
- ;; Handle `..' by hand, since it needs to work in the
- ;; target of any directory symlink.
- ;; This code is not quite complete; it does not handle
- ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
- (while (string-match "\\`\\.\\./" tem)
- (setq tem (substring tem 3))
- (setq newname (file-name-as-directory
- ;; Do the .. by hand.
- (directory-file-name
- (file-name-directory
- ;; Chase links in the default dir of the symlink.
- (file-chase-links
- (directory-file-name
- (file-name-directory newname))))))))
- (setq newname (expand-file-name tem (file-name-directory newname)))
- (setq count (1- count)))
+ (save-match-data
+ (if (= count 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ ;; In the context of a link, `//' doesn't mean what Emacs thinks.
+ (while (string-match "//+" tem)
+ (setq tem (replace-match "/" nil nil tem)))
+ ;; Handle `..' by hand, since it needs to work in the
+ ;; target of any directory symlink.
+ ;; This code is not quite complete; it does not handle
+ ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
+ (while (string-match "\\`\\.\\./" tem)
+ (setq tem (substring tem 3))
+ (setq newname (expand-file-name newname))
+ ;; Chase links in the default dir of the symlink.
+ (setq newname
+ (file-chase-links
+ (directory-file-name (file-name-directory newname))))
+ ;; Now find the parent of that dir.
+ (setq newname (file-name-directory newname)))
+ (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq count (1- count))))
newname))
\f
(defun switch-to-buffer-other-window (buffer &optional norecord)
(pop-to-buffer buffer t norecord)
(raise-frame (window-frame (selected-window)))))
-(defun find-file (filename &optional coding-system)
+(defun find-file (filename)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
-creating one if none already exists.
-A prefix argument enables user to specify the coding-system interactively."
- (interactive "FFind file: \nZCoding-system: ")
- (if coding-system
- (let ((coding-system-for-read coding-system))
- (switch-to-buffer (find-file-noselect filename)))
- (switch-to-buffer (find-file-noselect filename))))
-
-(defun find-file-other-window (filename &optional coding-system)
+creating one if none already exists."
+ (interactive "FFind file: ")
+ (switch-to-buffer (find-file-noselect filename)))
+
+(defun find-file-other-window (filename)
"Edit file FILENAME, in another window.
May create a new window, or reuse an existing one.
-A prefix argument enables user to specify the coding-system interactively.
See the function `display-buffer'."
- (interactive "FFind file in other window: \nZCoding-system: ")
- (if coding-system
- (let ((coding-system-for-read coding-system))
- (switch-to-buffer-other-window (find-file-noselect filename)))
- (switch-to-buffer-other-window (find-file-noselect filename))))
+ (interactive "FFind file in other window: ")
+ (switch-to-buffer-other-window (find-file-noselect filename)))
-(defun find-file-other-frame (filename &optional coding-system)
+(defun find-file-other-frame (filename)
"Edit file FILENAME, in another frame.
May create a new frame, or reuse an existing one.
-A prefix argument enables user to specify the coding-system interactively.
See the function `display-buffer'."
- (interactive "FFind file in other frame: \nZCoding-system: ")
- (if coding-system
- (let ((coding-system-for-read coding-system))
- (switch-to-buffer-other-frame (find-file-noselect filename)))
- (switch-to-buffer-other-frame (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 &optional coding-system)
+(defun find-file-read-only (filename)
"Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
-A prefix argument enables user to specify the coding-system interactively.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only: \nZCoding-system: ")
- (find-file filename coding-system)
- (setq buffer-read-only t)
+ (interactive "fFind file read-only: ")
+ (find-file filename)
+ (toggle-read-only 1)
(current-buffer))
-(defun find-file-read-only-other-window (filename &optional coding-system)
+(defun find-file-read-only-other-window (filename)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
-A prefix argument enables user to specify the coding-system interactively.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only other window: \nZCoding-system: ")
- (find-file-other-window filename coding-system)
- (setq buffer-read-only t)
+ (interactive "fFind file read-only other window: ")
+ (find-file-other-window filename)
+ (toggle-read-only 1)
(current-buffer))
-(defun find-file-read-only-other-frame (filename &optional coding-system)
+(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.
-A prefix argument enables user to specify the coding-system interactively.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only other frame: \nZCoding-system: ")
- (find-file-other-frame filename coding-system)
- (setq buffer-read-only t)
+ (interactive "fFind file read-only other frame: ")
+ (find-file-other-frame filename)
+ (toggle-read-only 1)
(current-buffer))
-(defun find-alternate-file-other-window (filename &optional coding-system)
+(defun find-alternate-file-other-window (filename)
"Find file FILENAME as a replacement for the file in the next window.
-This command does not select that window.
-A prefix argument enables user to specify the coding-system interactively."
+This command does not select that window."
(interactive
(save-selected-window
(other-window 1)
(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)
- (if current-prefix-arg
- (read-coding-system "Coding-system: "))))))
+ "Find alternate file: " file-dir nil nil file-name)))))
(if (one-window-p)
- (find-file-other-window filename coding-system)
+ (find-file-other-window filename)
(save-selected-window
(other-window 1)
- (find-alternate-file filename coding-system))))
+ (find-alternate-file filename))))
-(defun find-alternate-file (filename &optional coding-system)
+(defun find-alternate-file (filename)
"Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
-\(presumably by mistake), use this command to visit the file you really want.
-A prefix argument enables user to specify the coding-system interactively."
+\(presumably by mistake), use this command to visit the file you really want."
(interactive
(let ((file buffer-file-name)
(file-name nil)
(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)
- (if current-prefix-arg
- (read-coding-system "Coding-system: ")))))
+ "Find alternate file: " file-dir nil nil file-name))))
(and (buffer-modified-p) (buffer-file-name)
;; (not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
- (find-file filename coding-system))
+ (find-file filename))
(cond ((eq obuf (current-buffer))
(setq buffer-file-name ofile)
(setq buffer-file-number onum)
(rename-buffer oname))))
(or (eq (current-buffer) obuf)
(kill-buffer obuf))))
-
+\f
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
FILENAME (sans directory) is used unchanged if that name is free;
(setq found (car list))))
(setq list (cdr list))))
found))))
-
-(defun insert-file-contents-literally (filename &optional visit beg end replace)
- "Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place.
-
-This function does not work for remote files, because it turns off
-file name handlers and remote file access uses a file name handler."
- (let ((file-name-handler-alist nil)
- (format-alist nil)
- (after-insert-file-functions nil)
- (find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil)))
- (unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (filename) t))
- (insert-file-contents filename visit beg end replace))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
-
+\f
(defun find-file-noselect (filename &optional nowarn rawfile)
"Read file FILENAME into a buffer and return the buffer.
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.
Optional first arg NOWARN non-nil means suppress any warning messages.
-Optional second arg RAWFILE non-nil means the file is read literally"
+Optional second arg RAWFILE non-nil means the file is read literally."
(setq filename
(abbreviate-file-name
(expand-file-name filename)))
(file-name-nondirectory filename)
(buffer-name buf))))
(with-current-buffer buf
- (revert-buffer t t)))))
+ (revert-buffer t t)))
+ ((not (eq rawfile (not (null find-file-literally))))
+ (if rawfile
+ (message "File is already visited, and not literally")
+ (message "File is already visited, and visited literally")))))
(save-excursion
;;; The truename stuff makes this obsolete.
;;; (let* ((link-name (car (file-attributes filename)))
(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.
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
(if rawfile
- nil
+ (progn
+ (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))
(setq buf (current-buffer)))))
buf)))
\f
+(defun insert-file-contents-literally (filename &optional visit beg end replace)
+ "Like `insert-file-contents', but only reads in the file literally.
+A buffer may be modified in several ways after reading into the buffer,
+to Emacs features such as format decoding, character code
+conversion, find-file-hooks, automatic uncompression, etc.
+
+This function ensures that none of these modifications will take place."
+ (let ((format-alist nil)
+ (after-insert-file-functions nil)
+ (coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion)
+ (jka-compr-compression-info-list nil)
+ (find-buffer-file-type-function
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil)))
+ (unwind-protect
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
+ (if find-buffer-file-type-function
+ (fset 'find-buffer-file-type find-buffer-file-type-function)
+ (fmakunbound 'find-buffer-file-type)))))
+
+(defun insert-file-literally (filename)
+ "Insert contents of file FILENAME into buffer after point with no conversion.
+
+This function is meant for the user to run interactively.
+Don't call it from programs! Use `insert-file-contents-literally' instead.
+\(Its calling sequence is different; see its documentation)."
+ (interactive "*fInsert file literally: ")
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let ((tem (insert-file-contents-literally filename)))
+ (push-mark (+ (point) (car (cdr tem))))))
+
+(defvar find-file-literally nil
+ "Non-nil if this buffer was made by `find-file-literally' or equivalent.
+This is a permanent local.")
+(put 'find-file-literally 'permanent-local t)
+
+(defun find-file-literally (filename)
+ "Visit file FILENAME with no conversion of any kind.
+Format conversion and character code conversion are both disabled,
+and multibyte characters are disabled in the resulting buffer.
+The major mode used is Fundamental mode regardless of the file name,
+and local variable specifications in the file are ignored.
+Automatic uncompression is also disabled.
+
+You cannot absolutely rely on this function to result in
+visiting the file literally. If Emacs already has a buffer
+which is visiting the file, you get the existing buffer,
+regardless of whether it was created literally or not.
+
+In a Lisp program, if you want to be sure of accessing a file's
+contents literally, you should create a temporary buffer and then read
+the file contents into it using `insert-file-contents-literally'."
+ (interactive "FFind file literally: ")
+ (switch-to-buffer (find-file-noselect filename nil t)))
+\f
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
(if nomodes
nil
(normal-mode t)
+ (if (and buffer-read-only view-read-only
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
(run-hooks 'find-file-hooks)))
(defun normal-mode (&optional find-file)
("\\.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)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
+ ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option
("\\.bbl\\'" . latex-mode)
("\\.bib\\'" . bibtex-mode)
+ ("\\.m4\\'" . m4-mode)
+ ("\\.mc\\'" . m4-mode)
+ ("\\.mf\\'" . metafont-mode)
+ ("\\.mp\\'" . metapost-mode)
+ ("\\.vhdl?\\'" . vhdl-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.tcl\\'" . tcl-mode)
("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\)\\'" . archive-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/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)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
;; .emacs following a directory delimiter
- ;; in either Unix or VMS syntax.
- ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; in Unix, MSDOG or VMS syntax.
+ ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
;; _emacs following a directory delimiter
;; in MsDos syntax
("[:/]_emacs\\'" . emacs-lisp-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)
modes))))))
;; If we found modes to use, invoke them now,
;; outside the save-excursion.
- (if modes
- (unless just-from-file-name
- (mapcar 'funcall (nreverse modes))
- (setq done t)))
+ (when modes
+ (unless just-from-file-name
+ (mapcar 'funcall (nreverse modes)))
+ (setq done t))
;; If we didn't find a mode from a -*- line, try using the file name.
(if (and (not done) buffer-file-name)
(let ((name buffer-file-name)
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",
(defun hack-local-variables-prop-line ()
;; Set local variables specified in the -*- line.
- ;; Ignore any specification for `mode:';
- ;; set-auto-mode should already have handled that.
+ ;; Ignore any specification for `mode:' and `coding:';
+ ;; set-auto-mode should already have handled `mode:',
+ ;; set-auto-coding should already have handled `coding:'.
(save-excursion
(goto-char (point-min))
(let ((result nil)
;; case when checking for `mode' in set-auto-mode,
;; so we must do that here as well.
;; That is inconsistent, but we're stuck with it.
+ ;; The same can be said for `coding' in set-auto-coding.
(or (equal (downcase (symbol-name key)) "mode")
+ (equal (downcase (symbol-name key)) "coding")
(setq result (cons (cons key val) result)))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
(cond ((eq var 'mode)
(funcall (intern (concat (downcase (symbol-name val))
"-mode"))))
+ ((eq var 'coding)
+ ;; We have already handled coding: tag in set-auto-coding.
+ nil)
((memq var ignored-local-variables)
nil)
;; "Setting" eval means either eval it or do nothing.
;; 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)))
(set-auto-mode t))
(error nil)))
-(defun write-file (filename &optional confirm coding-system)
+(defun write-file (filename &optional confirm)
"Write current buffer into file FILENAME.
Makes buffer visit that file, and marks it not modified.
If the buffer is already visiting a file, you can specify
If optional second arg CONFIRM is non-nil,
ask for confirmation for overwriting an existing file.
-Interactively, confirmation is required unless you supply a prefix argument.
-
-A prefix argument also enables user to interactively specify a
-coding-system for encoding the file."
+Interactively, confirmation is required unless you supply a prefix argument."
;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
(read-file-name "Write file: "
(cdr (assq 'default-directory
(buffer-local-variables)))
- nil nil (buffer-name)))
- (not current-prefix-arg)
- (if current-prefix-arg
- (read-coding-system "Coding-system: "))
- ))
+ nil nil (file-name-nondirectory (buffer-name))))
+ (not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
;; If arg is just a directory,
(error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
- (if coding-system
- (let ((coding-system-for-write coding-system))
- ;; It is convenient to change buffer-file-coding-system to the
- ;; specified one.
- (set-buffer-file-coding-system coding-system)
- (save-buffer))
- (save-buffer)))
+ ;; 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 ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
(not (string-equal (substring fname 0 2)
(substring directory 0 2))))
filename
- (let ((ancestor ""))
- (while (not (string-match (concat "^" (regexp-quote directory)) fname))
+ (let ((ancestor ".")
+ (fname-dir (file-name-as-directory fname)))
+ (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
+ (not (string-match (concat "^" (regexp-quote directory)) fname)))
(setq directory (file-name-directory (substring directory 0 -1))
- ancestor (concat "../" ancestor)))
- (concat ancestor (substring fname (match-end 0))))))))
+ ancestor (if (equal ancestor ".")
+ ".."
+ (concat "../" ancestor))))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (string-match (concat "^" (regexp-quote directory)) fname)
+ ;; We matched within FNAME's directory part.
+ ;; Add the rest of FNAME onto ANCESTOR.
+ (let ((rest (substring fname (match-end 0))))
+ (if (and (equal ancestor ".")
+ (not (equal rest "")))
+ ;; But don't bother with ANCESTOR if it would give us `./'.
+ rest
+ (concat (file-name-as-directory ancestor) rest)))
+ ;; We matched FNAME's directory equivalent.
+ ancestor))))))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(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))
- (error "%s is not a directory" dir)
+ (if (file-exists-p dir)
+ (error "%s is not a directory" dir)
+ (error "%s: no such directory" buffer-file-name))
(if (not (file-exists-p buffer-file-name))
(error "Directory %s write-protected" dir)
(if (yes-or-no-p
(buffer-list)
'("buffer" "buffers" "save")
(list (list ?\C-r (lambda (buf)
- (view-buffer buf)
- (setq view-exit-action
- '(lambda (ignore)
- (exit-recursive-edit)))
+ (view-buffer buf
+ (function
+ (lambda (ignore)
+ (exit-recursive-edit))))
(recursive-edit)
;; Return nil to ask about BUF again.
nil)
(defun toggle-read-only (&optional arg)
"Change whether this buffer is visiting its file read-only.
-With arg, set read-only iff arg is positive."
+With arg, set read-only iff arg is positive.
+If visiting file read-only and `view-read-only' is non-nil, enter view mode."
(interactive "P")
- (setq buffer-read-only
- (if (null arg)
- (not buffer-read-only)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
+ (cond
+ ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
+ (not buffer-read-only))) ; If buffer-read-only is set correctly,
+ nil) ; do nothing.
+ ;; Toggle.
+ ((and buffer-read-only view-mode)
+ (View-exit-and-edit)) ; Must leave view mode.
+ ((and (not buffer-read-only) view-read-only
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
+ (t (setq buffer-read-only (not buffer-read-only))
+ (force-mode-line-update))))
-(defun insert-file (filename &optional coding-system)
+(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
Set mark after the inserted text.
-A prefix argument enables user to specify the coding-system interactively.
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
- (interactive "*fInsert file: \nZCoding-system: ")
+ (interactive "*fInsert file: ")
(if (file-directory-p filename)
(signal 'file-error (list "Opening input file" "file is a directory"
filename)))
- (let ((tem
- (if coding-system
- (let ((coding-system-for-read coding-system))
- (insert-file-contents filename))
- (insert-file-contents filename))))
+ (let ((tem (insert-file-contents filename)))
(push-mark (+ (point) (car (cdr tem))))))
-(defun append-to-file (start end filename &optional coding-system)
+(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
When called from a function, expects three arguments,
START, END and FILENAME. START and END are buffer positions
-saying what text to write.
-A prefix argument enables user to specify the coding-system interactively."
- (interactive "r\nFAppend to file: \nZCoding-system: ")
- (if coding-system
- (let ((coding-system-for-write coding-system))
- (write-region start end filename t))
- (write-region start end filename t)))
+saying what text to write."
+ (interactive "r\nFAppend to file: ")
+ (write-region start end filename t))
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
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)
(or auto-save-p
(unlock-buffer)))
(widen)
- (insert-file-contents file-name (not auto-save-p)
- nil nil t)))
+ (let ((coding-system-for-read
+ ;; Auto-saved file shoule be read without
+ ;; any code conversion.
+ (if auto-save-p 'no-conversion
+ coding-system-for-read)))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))))
(goto-char (min opoint (point-max)))
;; Recompute the truename in case changes in symlinks
;; have changed the truename.
(not (file-exists-p file-name)))
(error "Auto-save file %s not current" file-name))
((save-window-excursion
- (if (not (eq system-type 'vax-vms))
+ (if (not (memq system-type '(vax-vms windows-nt)))
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(call-process "ls" nil standard-output nil
(let ((file (dired-get-filename))
files
(buffer (get-buffer-create " *recover*")))
+ (dired-unmark 1)
(dired-do-flagged-delete t)
(unwind-protect
(save-excursion
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
(let ((fn (file-name-nondirectory buffer-file-name)))
- (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
+ (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
(concat (file-name-directory buffer-file-name)
"#" (match-string 1 fn)
"." (match-string 3 fn) "#"))
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
;; in the return value.
;; So just avoid stripping it in the first place.
'((expand-file-name . nil)
+ ;; `identity' means just return the first arg
+ ;; as stripped of its quoting.
+ (substitute-in-file-name . identity)
(file-name-directory . nil)
(file-name-as-directory . nil)
(directory-file-name . nil)
+ (file-name-completion 0 1)
+ (file-name-all-completions 0 1)
(rename-file 0 1)
(copy-file 0 1)
(make-symbolic-link 0 1)
(arguments (copy-sequence arguments)))
;; Strip off the /: from the file names that have this handler.
(save-match-data
- (while 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)))
+ (while (consp file-arg-indices)
+ (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))))
- (apply operation arguments)))
+ (if (eq file-arg-indices 'identity)
+ (car arguments)
+ (apply operation arguments))))
\f
(define-key ctl-x-map "\C-f" 'find-file)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key ctl-x-map "\C-v" 'find-alternate-file)
(define-key ctl-x-map "\C-s" 'save-buffer)
HCoop / bpt / emacs.git / blobdiff