;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
+;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,03,2004
;;; 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.
-Note that auto-save file will not be deleted if the buffer is killed
+Note that the auto-save file will not be deleted if the buffer is killed
when it has unsaved changes."
:type 'boolean
:group 'auto-save)
"[\000-\031]\\|" ; control characters
"\\(/\\.\\.?[^/]\\)\\|" ; leading dots
"\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[|<>\"?*\000-\031]")) ; invalid characters
(t "[\000]"))
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
-(defvar find-file-hook nil
+(defcustom find-file-hook nil
"List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
-functions are called.")
+functions are called."
+ :group 'find-file
+ :type 'hook
+ :options '(auto-insert)
+ :version "21.4")
(defvaralias 'find-file-hooks 'find-file-hook)
(make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4")
the visited file name with \\[set-visited-file-name], but not when you
change the major mode.
-See also `write-contents-functions'.")
+This hook is not run if any of the functions in
+`write-contents-functions' returns non-nil. Both hooks pertain
+to how to save a buffer to file, for instance, choosing a suitable
+coding system and setting mode bits. (See Info
+node `(elisp)Saving Buffers'.) To perform various checks or
+updates before the buffer is saved, use `before-save-hook' .")
(put 'write-file-functions 'permanent-local t)
(defvaralias 'write-file-hooks 'write-file-functions)
(make-obsolete-variable 'write-file-hooks 'write-file-functions "21.4")
`set-visited-file-name' does not clear this variable; but changing the
major mode does clear it.
-See also `write-file-functions'.")
+For hooks that _do_ pertain to the particular visited file, use
+`write-file-functions'. Both this variable and
+`write-file-functions' relate to how a buffer is saved to file.
+To perform various checks or updates before the buffer is saved,
+use `before-save-hook'.")
(make-variable-buffer-local 'write-contents-functions)
(defvaralias 'write-contents-hooks 'write-contents-functions)
(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "21.4")
(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.")
+(defcustom view-read-only nil
+ "*Non-nil means buffers visiting files read-only do so in view mode.
+In fact, this means that all read-only buffers normally have
+View mode enabled, including buffers that are read-only because
+you visit a file you cannot alter, and buffers you make read-only
+using \\[toggle-read-only]."
+ :type 'boolean
+ :group 'view)
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
"Read directory name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
-Default name to DEFAULT-DIRNAME if user enters a null string.
+Default name to DEFAULT-DIRNAME if user exits with the same
+non-empty string that was inserted by this function.
(If DEFAULT-DIRNAME is omitted, the current buffer's directory is used,
except that if INITIAL is specified, that combined with DIR is used.)
+If the user exits with an empty minibuffer, this function returns
+an empty string. (This can only happen if the user erased the
+pre-inserted contents or if `insert-default-directory' is nil.)
Fourth arg MUSTMATCH non-nil means require existing directory's name.
Non-nil and non-t means also require confirmation after completion.
Fifth arg INITIAL specifies text to start with.
-DIR defaults to current buffer's directory default."
+DIR should be an absolute directory name. It defaults to
+the value of `default-directory'."
(unless dir
(setq dir default-directory))
(unless default-dirname
\(For values of `colon' equal to `path-separator'.)"
;; We could use split-string here.
(and cd-path
- (let (cd-prefix cd-list (cd-start 0) cd-colon)
+ (let (cd-list (cd-start 0) cd-colon)
(setq cd-path (concat cd-path path-separator))
(while (setq cd-colon (string-match path-separator cd-path cd-start))
(setq cd-list
(suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
(string-dir (file-name-directory string)))
(dolist (dir (car path-and-suffixes))
+ (unless dir
+ (setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
(dolist (file (file-name-all-completions
;; PREV-DIRS can be a cons cell whose car is an alist
;; of truenames we've just recently computed.
- ;; The last test looks dubious, maybe `+' is meant here? --simon.
- (if (or (string= filename "") (string= filename "~")
- (and (string= (substring filename 0 1) "~")
- (string-match "~[^/]*" filename)))
- (progn
- (setq filename (expand-file-name filename))
- (if (string= filename "")
- (setq filename "/"))))
+ (cond ((or (string= filename "") (string= filename "~"))
+ (setq filename (expand-file-name filename))
+ (if (string= filename "")
+ (setq filename "/")))
+ ((and (string= (substring filename 0 1) "~")
+ (string-match "~[^/]*/?" filename))
+ (let ((first-part
+ (substring filename 0 (match-end 0)))
+ (rest (substring filename (match-end 0))))
+ (setq filename (concat (expand-file-name first-part) rest)))))
+
(or counter (setq counter (list 100)))
(let (done
;; For speed, remove the ange-ftp completion handler from the list.
;; 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)
+ (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
(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)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use the long name
+ (setq filename (or (w32-long-file-name filename) filename))))
(setq done t)))
;; If this file directly leads to a link, process that iteratively
(setq done t))))))))
filename))
-(defun file-chase-links (filename)
+(defun file-chase-links (filename &optional limit)
"Chase links in FILENAME until a name that is not a link.
-Does not examine containing directories for links,
-unlike `file-truename'."
- (let (tem (count 100) (newname filename))
- (while (setq tem (file-symlink-p newname))
+Unlike `file-truename', this does not check whether a parent
+directory name is a symbolic link.
+If the optional argument LIMIT is a number,
+it means chase no more than that many links and then stop."
+ (let (tem (newname filename)
+ (count 0))
+ (while (and (or (null limit) (< count limit))
+ (setq tem (file-symlink-p newname)))
(save-match-data
- (if (= count 0)
+ (if (and (null limit) (= count 100))
(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)
;; 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))))
+ (setq count (1+ count))))
+ newname))
+
+(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
+ "Change the encoding of FILE's name from CODING to NEW-CODING.
+The value is a new name of FILE.
+Signals a `file-already-exists' error if a file of the new name
+already exists unless optional third argument OK-IF-ALREADY-EXISTS
+is non-nil. A number as third arg means request confirmation if
+the new name already exists. This is what happens in interactive
+use with M-x."
+ (interactive
+ (let ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ (filename (read-file-name "Recode filename: " nil nil t))
+ from-coding to-coding)
+ (if (and default-coding
+ ;; We provide the default coding only when it seems that
+ ;; the filename is correctly decoded by the default
+ ;; coding.
+ (let ((charsets (find-charset-string filename)))
+ (and (not (memq 'eight-bit-control charsets))
+ (not (memq 'eight-bit-graphic charsets)))))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from (default %s): "
+ filename default-coding)
+ default-coding))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from: " filename))))
+
+ ;; We provide the default coding only when a user is going to
+ ;; change the encoding not from the default coding.
+ (if (eq from-coding default-coding)
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to: "
+ filename from-coding)))
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to (default %s): "
+ filename from-coding default-coding)
+ default-coding)))
+ (list filename from-coding to-coding)))
+
+ (let* ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ ;; FILE should have been decoded by DEFAULT-CODING.
+ (encoded (encode-coding-string file default-coding))
+ (newname (decode-coding-string encoded coding))
+ (new-encoded (encode-coding-string newname new-coding))
+ ;; Suppress further encoding.
+ (file-name-coding-system nil)
+ (default-file-name-coding-system nil)
+ (locale-coding-system nil))
+ (rename-file encoded new-encoded ok-if-already-exists)
newname))
\f
(defun switch-to-buffer-other-window (buffer &optional norecord)
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive "BSwitch to buffer in other window: ")
- (let ((pop-up-windows t))
+ (let ((pop-up-windows t)
+ ;; Don't let these interfere.
+ same-window-buffer-names same-window-regexps)
(pop-to-buffer buffer t norecord)))
(defun switch-to-buffer-other-frame (buffer &optional norecord)
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive "BSwitch to buffer in other frame: ")
- (let ((pop-up-frames t))
+ (let ((pop-up-frames t)
+ same-window-buffer-names same-window-regexps)
(pop-to-buffer buffer t norecord)
(raise-frame (window-frame (selected-window)))))
minibuffer-setup-hook))
(add-hook 'minibuffer-setup-hook munge-default-fun)
(read-file-name prompt nil default-directory mustmatch))
- current-prefix-arg))
+ t))
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
(interactive (find-file-read-args "Find file read-only: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file filename wildcards)
(toggle-read-only 1)
(current-buffer))
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
(interactive (find-file-read-args "Find file read-only other window: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-window filename wildcards)
(toggle-read-only 1)
(current-buffer))
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
(interactive (find-file-read-args "Find file read-only other frame: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-frame filename wildcards)
(toggle-read-only 1)
(current-buffer))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
+ (odir dired-directory)
(otrue buffer-file-truename)
(oname (buffer-name)))
(if (get-buffer " **lose**")
(unwind-protect
(progn
(unlock-buffer)
+ ;; This prevents us from finding the same buffer
+ ;; if we specified the same file again.
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
+ ;; Likewise for dired buffers.
+ (setq dired-directory nil)
(find-file filename))
(when (eq obuf (current-buffer))
;; This executes if find-file gets an error
(setq buffer-file-name ofile)
(setq buffer-file-number onum)
(setq buffer-file-truename otrue)
+ (setq dired-directory odir)
(lock-buffer)
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
-This also substitutes \"~\" for the user's home directory.
-Type \\[describe-variable] directory-abbrev-alist RET for more information."
+This also substitutes \"~\" for the user's home directory and
+removes automounter prefixes (see the variable `automount-dir-prefix')."
;; Get rid of the prefixes added by the automounter.
(if (and automount-dir-prefix
(string-match automount-dir-prefix filename)
;; MS-DOS root directories can come with a drive letter;
;; Novell Netware allows drive letters beyond `Z:'.
(not (and (or (eq system-type 'ms-dos)
+ (eq system-type 'cygwin)
(eq system-type 'windows-nt))
(save-match-data
(string-match "^[a-zA-`]:/$" filename)))))
:type '(repeat (string :tag "Name"))
:group 'find-file)
-(defun find-buffer-visiting (filename)
+(defun find-buffer-visiting (filename &optional predicate)
"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 PREDICATE is non-nil, only a buffer satisfying it can be returned.
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* ((attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
- (list (buffer-list)) found)
- (and buffer-file-numbers-unique
- number
- (while (and (not found) list)
- (with-current-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 (file-attributes buffer-file-truename)
- attributes))
- (setq found (car list))))
- (setq list (cdr list))))
- found))))
+ (let ((predicate (or predicate #'identity))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or (let ((buf (get-file-buffer filename)))
+ (when (and buf (funcall predicate buf)) 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)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let* ((attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
+ (list (buffer-list)) found)
+ (and buffer-file-numbers-unique
+ number
+ (while (and (not found) list)
+ (with-current-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 (file-attributes buffer-file-truename)
+ attributes)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
\f
(defcustom find-file-wildcards t
"*Non-nil means file-visiting commands should handle wildcards.
:version "21.1"
:type 'boolean)
+(defcustom large-file-warning-threshold 10000000
+ "Maximum size of file above which a confirmation is requested.
+When nil, never request confirmation."
+ :group 'files
+ :group 'find-file
+ :type '(choice integer (const :tag "Never request confirmation" nil)))
+
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(mapcar #'find-file-noselect files)))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes truename)))
+ (attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
;; Find any buffer for a file which has same truename.
(other (and (not buf) (find-buffer-visiting filename))))
;; Let user know if there is a buffer with the same truename.
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other))))
+ ;; Check to see if the file looks uncommonly large.
+ (when (and large-file-warning-threshold (nth 7 attributes)
+ ;; Don't ask again if we already have the file or
+ ;; if we're asked to be quiet.
+ (not (or buf nowarn))
+ (> (nth 7 attributes) large-file-warning-threshold)
+ (not (y-or-n-p
+ (format "File %s is large (%sMB), really open? "
+ (file-name-nondirectory filename)
+ (/ (nth 7 attributes) 1048576)))))
+ (error "Aborted"))
(if buf
;; We are using an existing buffer.
(progn
;; Needed in case we are re-visiting the file with a different
;; text representation.
(kill-local-variable 'buffer-file-coding-system)
+ (kill-local-variable 'cursor-type)
(erase-buffer)
(and (default-value 'enable-multibyte-characters)
(not rawfile)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
- (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
- (inhibit-file-name-operation 'insert-file-contents))
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil))
+ (inhibit-file-name-handlers
+ (append '(jka-compr-handler image-file-handler)
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (filename) t))
- (insert-file-contents filename visit beg end replace))
+ (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-1 (filename insert-func)
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
+ #'buffer-modified-p))
+ (tem (funcall insert-func filename)))
+ (push-mark (+ (point) (car (cdr tem))))
+ (when buffer
+ (message "File %s already visited and modified in buffer %s"
+ filename (buffer-name buffer)))))
+
(defun insert-file-literally (filename)
"Insert contents of file FILENAME into buffer after point with no conversion.
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))))))
+ (insert-file-1 filename #'insert-file-contents-literally))
(defvar find-file-literally nil
"Non-nil if this buffer was made by `find-file-literally' or equivalent.
(setq buffer-read-only nil))
(t
(setq buffer-read-only nil)
- (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
- "Use M-x make-directory RET RET to create the directory"
- "Use C-u M-x make-directory RET RET to create directory and its parents")))))
+ "Use M-x make-directory RET RET to create the directory and its parents"))))
(when msg
(message "%s" msg)
- (or not-serious (sit-for 1 nil t))))
+ (or not-serious (sit-for 1 t))))
(when (and auto-save-default (not noauto))
(auto-save-mode t)))
;; Make people do a little extra work (C-x C-q)
(view-mode-enter))
(run-hooks 'find-file-hook)))
+(defmacro report-errors (format &rest body)
+ "Eval BODY and turn any error into a FORMAT message.
+FORMAT can have a %s escape which will be replaced with the actual error.
+If `debug-on-error' is set, errors are not caught, so that you can
+debug them.
+Avoid using a large BODY since it is duplicated."
+ (declare (debug t) (indent 1))
+ `(if debug-on-error
+ (progn . ,body)
+ (condition-case err
+ (progn . ,body)
+ (error (message ,format (prin1-to-string err))))))
+
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
Also sets up any specified local variables of the file.
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
(or find-file (funcall (or default-major-mode 'fundamental-mode)))
- (condition-case err
- (set-auto-mode)
- (error (message "File mode specification error: %s"
- (prin1-to-string err))))
- (condition-case err
- (let ((enable-local-variables (or (not find-file)
- enable-local-variables)))
- (hack-local-variables))
- (error (message "File local-variables error: %s"
- (prin1-to-string err)))))
+ (report-errors "File mode specification error: %s"
+ (set-auto-mode))
+ (report-errors "File local-variables error: %s"
+ (let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ (hack-local-variables)))
+ (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
+ (ucs-set-table-for-input)))
(defvar auto-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
+ ;; c++-mode, java-mode and more) are added through autoload
+ ;; directives in that file. That way is discouraged since it
+ ;; spreads out the definition of the initial value.
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
'(("\\.te?xt\\'" . text-mode)
- ("\\.c\\'" . c-mode)
- ("\\.h\\'" . c-mode)
("\\.tex\\'" . tex-mode)
+ ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
+ ("\\.dtx\\'" . doctex-mode)
("\\.el\\'" . emacs-lisp-mode)
- ("\\.scm\\'" . scheme-mode)
+ ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.lisp\\'" . lisp-mode)
("\\.f\\'" . fortran-mode)
("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
- ("\\.cc\\'" . c++-mode)
- ("\\.hh\\'" . c++-mode)
- ("\\.hpp\\'" . c++-mode)
- ("\\.C\\'" . c++-mode)
- ("\\.H\\'" . c++-mode)
- ("\\.cpp\\'" . c++-mode)
- ("\\.cxx\\'" . c++-mode)
- ("\\.hxx\\'" . c++-mode)
- ("\\.c\\+\\+\\'" . c++-mode)
- ("\\.h\\+\\+\\'" . c++-mode)
- ("\\.m\\'" . objc-mode)
- ("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
("\\.me\\'" . nroff-mode)
("\\.ms\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
- ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-mode)
- ("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode)
("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\.zone\\'" . zone-mode)
;; some news reader is reported to use this
("\\`/tmp/fol/" . text-mode)
- ("\\.y\\'" . c-mode)
- ("\\.lex\\'" . c-mode)
("\\.oak\\'" . scheme-mode)
("\\.sgml?\\'" . sgml-mode)
("\\.xml\\'" . sgml-mode)
+ ("\\.xsl\\'" . sgml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.idl\\'" . idl-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
("\\.[1-9]\\'" . nroff-mode)
("\\.g\\'" . antlr-mode)
+ ("\\.ses\\'" . ses-mode)
+ ("\\.orig\\'" nil t) ; from patch
("\\.in\\'" nil t)))
"Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
(defvar interpreter-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
+ ;; and pike-mode) are added through autoload directives in that
+ ;; file. That way is discouraged since it spreads out the
+ ;; definition of the initial value.
(mapc
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
- ("awk" . awk-mode)
- ("mawk" . awk-mode)
- ("nawk" . awk-mode)
- ("gawk" . awk-mode)
("scm" . scheme-mode)
("ash" . sh-mode)
("bash" . sh-mode)
(mode nil))
;; Find first matching alist entry.
(let ((case-fold-search
- (memq system-type '(vax-vms windows-nt))))
+ (memq system-type '(vax-vms windows-nt cygwin))))
(while (and (not mode) alist)
(if (string-match (car (car alist)) name)
(if (and (consp (cdr (car alist)))
(goto-char beg)
end))))
-(defun hack-local-variables-prop-line ()
+(defun hack-local-variables-prop-line (&optional mode-only)
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
`set-auto-mode' should already have handled `mode:',
-`set-auto-coding' should already have handled `coding:'."
+`set-auto-coding' should already have handled `coding:'.
+If MODE-ONLY is non-nil, all we do is check whether the major mode
+is specified, returning t if it is specified."
(save-excursion
(goto-char (point-min))
(let ((result nil)
(end (set-auto-mode-1))
+ mode-specified
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
- ;; Parse the -*- line into the `result' alist.
+ ;; Parse the -*- line into the RESULT alist.
+ ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
(cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-". Already handled.
+ (setq mode-specified t)
nil)
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
(or (equal (downcase (symbol-name key)) "mode")
(equal (downcase (symbol-name key)) "coding")
(setq result (cons (cons key val) result)))
+ (if (equal (downcase (symbol-name key)) "mode")
+ (setq mode-specified t))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
- (if (and result
- (or (eq enable-local-variables t)
- (and enable-local-variables
- (save-window-excursion
- (condition-case nil
- (switch-to-buffer (current-buffer))
- (error
- ;; If we fail to switch in the selected window,
- ;; it is probably a minibuffer.
- ;; So try another window.
- (condition-case nil
- (switch-to-buffer-other-window (current-buffer))
- (error
- (switch-to-buffer-other-frame (current-buffer))))))
- (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
- (file-name-nondirectory buffer-file-name)))))))
- (let ((enable-local-eval enable-local-eval))
- (while result
- (hack-one-local-variable (car (car result)) (cdr (car result)))
- (setq result (cdr result))))))))
+ (if mode-only mode-specified
+ (if (and result
+ (or mode-only
+ (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer.
+ ;; So try another window.
+ (condition-case nil
+ (switch-to-buffer-other-window (current-buffer))
+ (error
+ (switch-to-buffer-other-frame (current-buffer))))))
+ (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
+ (file-name-nondirectory buffer-file-name)))))))
+ (let ((enable-local-eval enable-local-eval))
+ (while result
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
+ (setq result (cdr result)))))
+ nil))))
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
"Parse and put into effect this buffer's local variables spec.
If MODE-ONLY is non-nil, all we do is check whether the major mode
is specified, returning t if it is specified."
- (unless mode-only
- (hack-local-variables-prop-line))
- ;; Look for "Local variables:" line in last page.
- (let (mode-specified
+ (let ((mode-specified
+ ;; If MODE-ONLY is t, we check here for specifying the mode
+ ;; in the -*- line. If MODE-ONLY is nil, we process
+ ;; the -*- line here.
+ (hack-local-variables-prop-line mode-only))
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
+ ;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'inhibit-quit 'risky-local-variable t)
(put 'minor-mode-alist 'risky-local-variable t)
(put 'minor-mode-map-alist 'risky-local-variable t)
(put 'minor-mode-overriding-map-alist 'risky-local-variable t)
(put 'format-alist 'risky-local-variable t)
(put 'vc-mode 'risky-local-variable t)
(put 'imenu-generic-expression 'risky-local-variable t)
-(put 'imenu-index-alist 'risky-local-variable t)
+(put 'imenu--index-alist 'risky-local-variable t)
(put 'standard-input 'risky-local-variable t)
(put 'standard-output 'risky-local-variable t)
(put 'unread-command-events 'risky-local-variable t)
(put 'mode-line-buffer-identification 'risky-local-variable t)
(put 'mode-line-modes 'risky-local-variable t)
(put 'mode-line-position 'risky-local-variable t)
+(put 'mode-line-process 'risky-local-variable t)
+(put 'mode-name 'risky-local-variable t)
(put 'display-time-string 'risky-local-variable t)
-
-;; This one is safe because the user gets to check it before it is used.
-(put 'compile-command 'safe-local-variable t)
+(put 'parse-time-rules 'risky-local-variable t)
+
+;; This case is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable 'stringp)
+
+(defun risky-local-variable-p (sym &optional val)
+ "Non-nil if SYM could be dangerous as a file-local variable with value VAL.
+If VAL is nil or omitted, the question is whether any value might be
+dangerous."
+ (let ((safep (get sym 'safe-local-variable)))
+ (or (memq sym ignored-local-variables)
+ (get sym 'risky-local-variable)
+ (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
+ (symbol-name sym))
+ (not safep))
+ ;; If the safe-local-variable property isn't t or nil,
+ ;; then it must return non-nil on the proposed value to be safe.
+ (and (not (memq safep '(t nil)))
+ (or (null val)
+ (not (funcall safep val)))))))
(defcustom safe-local-eval-forms nil
"*Expressions that are considered \"safe\" in an `eval:' local variable.
((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$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
- (symbol-name var))
- (not (get var 'safe-local-variable))))
+ ((risky-local-variable-p var val)
;; Permit evalling a put of a harmless property.
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
(save-excursion (eval val))
(make-local-variable var)
(set var val))
- (message "Ignoring `eval:' in the local variables list")))
+ (message "Ignoring risky spec in the local variables list")))
;; Ordinary variable, really set it.
(t (make-local-variable var)
;; Make sure the string has no text properties.
(if (eq system-type 'vax-vms)
(setq new-name (downcase new-name)))
(setq default-directory (file-name-directory buffer-file-name))
+ ;; If new-name == old-name, renaming would add a spurious <2>
+ ;; and it's considered as a feature in rename-buffer.
(or (string= new-name (buffer-name))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
(progn
(setq buffer-file-truename (abbreviate-file-name truename))
(if find-file-visit-truename
- (setq buffer-file-name buffer-file-truename))))
+ (setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
(nthcdr 10 (file-attributes buffer-file-name))
If you specify just a directory name as FILENAME, that means to use
the default file name but in that directory. You can also yank
-the default file name into the minibuffer to edit it, using M-n.
+the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
If the buffer is not already visiting a file, the default file name
for the output file is the buffer name.
(or (eq delete-old-versions t) (eq delete-old-versions nil))
(or delete-old-versions
(y-or-n-p (format "Delete excess backup versions of %s? "
- real-file-name))))))
+ real-file-name)))))
+ (modes (file-modes buffer-file-name)))
;; Actually write the back up file.
(condition-case ()
(if (or file-precious-flag
; (file-symlink-p buffer-file-name)
backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (and modes (< 0 (logand modes #o6000)))
(and backup-by-copying-when-linked
(> (file-nlinks real-file-name) 1))
(and (or backup-by-copying-when-mismatch
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
(or (nth 9 attr)
(not (file-ownership-preserved-p real-file-name)))))))
- (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)))
+ (backup-buffer-copy real-file-name backupname modes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
- (setq setmodes
- (cons (file-modes backupname) backupname)))
+ (setq setmodes (cons modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
(setq backupname (expand-file-name
(message "Cannot write backup file; backing up in %s"
(file-name-nondirectory backupname))
(sleep-for 1)
- (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)))))
+ (backup-buffer-copy real-file-name backupname modes)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil))))))
+(defun backup-buffer-copy (from-name to-name modes)
+ (condition-case ()
+ (copy-file from-name to-name t t)
+ (file-error
+ ;; If copying fails because file TO-NAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p to-name)
+ (not (file-writable-p to-name)))
+ (delete-file to-name))
+ (copy-file from-name to-name t t)))
+ (and modes
+ (set-file-modes to-name (logand modes #o1777))))
+
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return file NAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
(defun make-backup-file-name-1 (file)
"Subroutine of `make-backup-file-name' and `find-backup-file-name'."
(let ((alist backup-directory-alist)
- elt backup-directory failed)
+ elt backup-directory)
(while alist
(setq elt (pop alist))
(if (string-match (car elt) file)
file
(if (file-name-absolute-p backup-directory)
(progn
- (when (memq system-type '(windows-nt ms-dos))
+ (when (memq system-type '(windows-nt ms-dos cygwin))
;; Normalize DOSish file names: downcase the drive
;; letter, if any, and replace the leading "x:" with
;; "/drive_x".
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
+;; (defun file-relative-name (filename &optional directory)
+;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
+;; This function returns a relative file name which is equivalent to FILENAME
+;; when used with that default directory as the default.
+;; If this is impossible (which can happen on MSDOS and Windows
+;; when the file name and directory use different drive names)
+;; then it returns FILENAME."
+;; (save-match-data
+;; (let ((fname (expand-file-name filename)))
+;; (setq directory (file-name-as-directory
+;; (expand-file-name (or directory default-directory))))
+;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
+;; ;; drive names, they can't be relative, so return the absolute name.
+;; (if (and (or (eq system-type 'ms-dos)
+;; (eq system-type 'cygwin)
+;; (eq system-type 'windows-nt))
+;; (not (string-equal (substring fname 0 2)
+;; (substring directory 0 2))))
+;; filename
+;; (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 (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))))))
+
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name which is equivalent to FILENAME
when used with that default directory as the default.
-If this is impossible (which can happen on MSDOS and Windows
-when the file name and directory use different drive names)
-then it returns FILENAME."
+If FILENAME and DIRECTORY lie on different machines or on different drives
+on a DOS/Windows machine, it returns FILENAME on expanded form."
(save-match-data
- (let ((fname (expand-file-name filename)))
- (setq directory (file-name-as-directory
- (expand-file-name (or directory default-directory))))
- ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
- ;; drive names, they can't be relative, so return the absolute name.
- (if (and (or (eq system-type 'ms-dos)
- (eq system-type 'windows-nt))
- (not (string-equal (substring fname 0 2)
- (substring directory 0 2))))
+ (setq directory
+ (file-name-as-directory (expand-file-name (or directory
+ default-directory))))
+ (setq filename (expand-file-name filename))
+ (let ((hf (find-file-name-handler filename 'file-local-copy))
+ (hd (find-file-name-handler directory 'file-local-copy)))
+ (when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
+ (when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
+ (if ;; Conditions for separate trees
+ (or
+ ;; Test for different drives on DOS/Windows
+ (and
+ ;; Should `cygwin' really be included here? --stef
+ (memq system-type '(ms-dos cygwin windows-nt))
+ (not (eq t (compare-strings filename 0 2 directory 0 2))))
+ ;; Test for different remote file handlers
+ (not (eq hf hd))
+ ;; Test for different remote file system identification
+ (and
+ hf
+ (let ((re (car (rassq hf file-name-handler-alist))))
+ (not
+ (equal
+ (and
+ (string-match re filename)
+ (substring filename 0 (match-end 0)))
+ (and
+ (string-match re directory)
+ (substring directory 0 (match-end 0))))))))
filename
- (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))
+ (let ((ancestor ".")
+ (filename-dir (file-name-as-directory filename)))
+ (while (not
+ (or
+ (eq t (compare-strings filename-dir nil (length directory)
+ directory nil nil case-fold-search))
+ (eq t (compare-strings filename nil (length directory)
+ directory nil nil case-fold-search))))
+ (setq directory (file-name-directory (substring directory 0 -1))
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 "")))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (eq t (compare-strings filename nil (length directory)
+ directory nil nil case-fold-search))
+ ;; We matched within FILENAME's directory part.
+ ;; Add the rest of FILENAME onto ANCESTOR.
+ (let ((rest (substring filename (length directory))))
+ (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))))))
+ ;; We matched FILENAME's directory equivalent.
+ ancestor))))))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(defvar auto-save-hook nil
"Normal hook run just before auto-saving.")
+(defcustom before-save-hook nil
+ "Normal hook that is run before a buffer is saved to its file."
+ :options '(copyright-update)
+ :type 'hook
+ :group 'files)
+
(defcustom after-save-hook nil
"Normal hook that is run after a buffer is saved to its file."
:options '(executable-make-buffer-file-executable-if-script-p)
The hooks `write-contents-functions' and `write-file-functions' get a chance
to do the job of saving; if they do not, then the buffer is saved in
the visited file file in the usual way.
-After saving the buffer, this function runs `after-save-hook'."
+Before and after saving the buffer, this function runs
+`before-save-hook' and `after-save-hook', respectively."
(interactive)
(save-current-buffer
;; In an indirect buffer, save its base buffer instead.
(set-buffer (buffer-base-buffer)))
(if (buffer-modified-p)
(let ((recent-save (recent-auto-save-p))
- setmodes tempsetmodes)
+ setmodes)
;; On VMS, rename file and buffer to get rid of version number.
(if (and (eq system-type 'vax-vms)
(not (string= buffer-file-name
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
+ (run-hooks 'before-save-hook)
(or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-functions)
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
(let ((realname buffer-file-name)
- tempname temp nogood i succeed
+ tempname nogood i succeed
(old-modtime (visited-file-modtime)))
(setq i 0)
(setq nogood t)
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")
- (if (and arg
+ (if (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.
(make-local-variable 'view-read-only)
(setq view-read-only t)) ; Must leave view mode.
((and (not buffer-read-only) view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
(not (eq (get major-mode 'mode-class) 'special)))
(view-mode-enter))
(t (setq buffer-read-only (not buffer-read-only))
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
(interactive "*fInsert file: ")
- (if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
- filename)))
- (let ((tem (insert-file-contents filename)))
- (push-mark (+ (point) (car (cdr tem))))))
+ (insert-file-1 filename #'insert-file-contents))
(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
- (make-backup-file-name filename)))
+ (make-backup-file-name (expand-file-name filename))))
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
That is useful when you have visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS says whether
-to create parent directories if they don't exist."
+to create parent directories if they don't exist. Interactively,
+this happens by default."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
The function you specify is responsible for updating (or preserving) point.")
+(defvar buffer-stale-function nil
+ "Function to check whether a non-file buffer needs reverting.
+This should be a function with one optional argument NOCONFIRM.
+Auto Revert Mode sets NOCONFIRM to t. The function should return
+non-nil if the buffer should be reverted. A return value of
+`fast' means that the need for reverting was not checked, but
+that reverting the buffer is fast. The buffer is current when
+this function is called.
+
+The idea behind the NOCONFIRM argument is that it should be
+non-nil if the buffer is going to be reverted without asking the
+user. In such situations, one has to be careful with potentially
+time consuming operations.")
+
(defvar before-revert-hook nil
"Normal hook for `revert-buffer' to run before reverting.
If `revert-buffer-function' is used to override the normal revert
This command also works for special buffers that contain text which
doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and buffer-list buffers. In these cases,
+for example, Dired buffers and `buffer-list' buffers. In these cases,
it reconstructs the buffer contents from the appropriate data base.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
(funcall revert-buffer-insert-file-contents-function
file-name auto-save-p)
(if (not (file-exists-p file-name))
- (error "File %s no longer exists!" file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists!"
+ "Cannot revert nonexistent file %s")
+ file-name))
;; Bind buffer-file-name to nil
;; so that we don't try to lock the file.
(let ((buffer-file-name nil))
(if auto-save-p 'emacs-mule-unix
(or coding-system-for-read
buffer-file-coding-system))))
- ;; This force
- ;; after-insert-file-set-buffer-file-coding-system
+ ;; This force after-insert-file-set-coding
;; (called from insert-file-contents) to set
;; buffer-file-coding-system to a proper value.
(kill-local-variable 'buffer-file-coding-system)
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook-p
- (progn
- (make-local-variable 'revert-buffer-internal-hook)
- (setq revert-buffer-internal-hook local-hook))
+ (set (make-local-variable 'revert-buffer-internal-hook)
+ local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
t)))))
(interactive "FRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
- (error "%s is an auto-save file" file))
+ (error "%s is an auto-save file" (abbreviate-file-name file)))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
(cond ((if (file-exists-p file)
(not (file-newer-than-file-p file-name file))
(not (file-exists-p file-name)))
- (error "Auto-save file %s not current" file-name))
+ (error "Auto-save file %s not current"
+ (abbreviate-file-name file-name)))
((save-window-excursion
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(let ((buffer-read-only nil)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
- ;; Auto-saved file shoule be read without any code conversion.
- (coding-system-for-read 'emacs-mule-unix))
+ ;; Auto-saved file shoule be read with special coding.
+ (coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(error "You set `auto-save-list-file-prefix' to disable making session files"))
(let ((dir (file-name-directory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
- (make-directory dir t)))
+ (make-directory dir t))
+ (unless (directory-files dir nil
+ (concat "\\`" (regexp-quote
+ (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
(concat dired-listing-switches "t")))
;; a "visited file name" from that.
(progn
(forward-line 1)
- (setq autofile
- (buffer-substring-no-properties
- (point)
- (save-excursion
- (end-of-line)
- (point))))
- (setq thisfile
- (expand-file-name
- (substring
- (file-name-nondirectory autofile)
- 1 -1)
- (file-name-directory autofile)))
+ ;; If there is no auto-save file name, the
+ ;; auto-save-list file is probably corrupted.
+ (unless (eolp)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (setq thisfile
+ (expand-file-name
+ (substring
+ (file-name-nondirectory autofile)
+ 1 -1)
+ (file-name-directory autofile))))
(forward-line 1))
;; This pair of lines is a file-visiting
;; buffer. Use the visited file name.
(point) (progn (end-of-line) (point))))
(forward-line 1)))
;; Ignore a file if its auto-save file does not exist now.
- (if (file-exists-p autofile)
+ (if (and autofile (file-exists-p autofile))
(setq files (cons thisfile files)))))
(setq files (nreverse files))
;; The file contains a pair of line for each auto-saved buffer.
(kill-buffer buffer))))
(defun kill-some-buffers (&optional list)
- "For each buffer in LIST, ask whether to kill it.
-LIST defaults to all existing live buffers."
+ "Kill some buffers. Asks the user whether to kill each one of them.
+Non-interactively, if optional argument LIST is non-`nil', it
+specifies the list of buffers to kill, asking for approval for each one."
(interactive)
(if (null list)
(setq list (buffer-list)))
PATTERN that already quotes some of the special characters."
(save-match-data
(cond
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
(save-match-data
(with-temp-buffer
(when (and directory-free-space-program
- (zerop (call-process directory-free-space-program
- nil t nil
- directory-free-space-args
- dir)))
+ (eq 0 (call-process directory-free-space-program
+ nil t nil
+ directory-free-space-args
+ dir)))
;; Usual format is a header line followed by a line of
;; numbers.
(goto-char (point-min))
(defun insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
-SWITCHES may be a string of options, or a list of strings.
+SWITCHES may be a string of options, or a list of strings
+representing individual options.
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 `insert-directory-program'.
-If WILDCARD, it also runs the shell specified by `shell-file-name'."
+If WILDCARD, it also runs the shell specified by `shell-file-name'.
+
+When SWITCHES contains the long `--dired' option, this function
+treats it specially, for the sake of dired. However, the
+normally equivalent short `-D' option is just passed on to
+`insert-directory-program', as any other option."
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory)))
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (let (result available (beg (point)))
+ (let (result (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; RESULT gets the status code.
- (let* ((coding-system-for-read
+ (let* (;; We at first read by no-conversion, then after
+ ;; putting text property `dired-filename, decode one
+ ;; bunch by one to preserve that property.
+ (coding-system-for-read 'no-conversion)
+ ;; This is to control encoding the arguments in call-process.
+ (coding-system-for-write
(and enable-multibyte-characters
(or file-name-coding-system
- default-file-name-coding-system)))
- ;; This is to control encoding the arguments in call-process.
- (coding-system-for-write coding-system-for-read))
+ default-file-name-coding-system))))
(setq result
(if wildcard
;; Run ls in the directory part of the file pattern
file))))))))
;; If `insert-directory-program' failed, signal an error.
- (if (/= result 0)
- ;; On non-Posix systems, we cannot open a directory, so
- ;; don't even try, because that will always result in
- ;; the ubiquitous "Access denied". Instead, show the
- ;; command line so the user can try to guess what went wrong.
- (if (and (file-directory-p file)
- (memq system-type '(ms-dos windows-nt)))
- (error
- "Reading directory: \"%s %s -- %s\" exited with status %s"
- insert-directory-program
- (if (listp switches) (concat switches) switches)
- file result)
- ;; Unix. Access the file to get a suitable error.
- (access-file file "Reading directory")
- (error "Listing directory failed but `access-file' worked")))
-
- (when (string-match "--dired\\>" switches)
+ (unless (eq 0 result)
+ ;; Delete the error message it may have output.
+ (delete-region beg (point))
+ ;; On non-Posix systems, we cannot open a directory, so
+ ;; don't even try, because that will always result in
+ ;; the ubiquitous "Access denied". Instead, show the
+ ;; command line so the user can try to guess what went wrong.
+ (if (and (file-directory-p file)
+ (memq system-type '(ms-dos windows-nt)))
+ (error
+ "Reading directory: \"%s %s -- %s\" exited with status %s"
+ insert-directory-program
+ (if (listp switches) (concat switches) switches)
+ file result)
+ ;; Unix. Access the file to get a suitable error.
+ (access-file file "Reading directory")
+ (error "Listing directory failed but `access-file' worked")))
+
+ (when (if (stringp switches)
+ (string-match "--dired\\>" switches)
+ (member "--dired" switches))
(forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
(let ((end (line-end-position)))
(forward-word 1)
(forward-char 3)
(while (< (point) end)
(let ((start (+ beg (read (current-buffer))))
(end (+ beg (read (current-buffer)))))
- (put-text-property start end 'dired-filename t)))
+ (if (= (char-after end) ?\n)
+ (put-text-property start end 'dired-filename t)
+ ;; It seems that we can't trust ls's output as to
+ ;; byte positions of filenames.
+ (put-text-property beg (point) 'dired-filename nil)
+ (end-of-line))))
(goto-char end)
(beginning-of-line)
(delete-region (point) (progn (forward-line 2) (point)))))
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char beg)
- ;; First find the line to put it on.
- (when (re-search-forward "^ *\\(total\\)" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "used", to avoid confusion.
- (replace-match "total used in directory" nil nil nil 1)
- (end-of-line)
- (insert " available " available))))))))))
+ ;; Now decode what read if necessary.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region beg (point) t)))
+ (if (not (eq (coding-system-base coding) 'undecided))
+ (save-restriction
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (narrow-to-region beg (point))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so
+ ;; that CR is preserved.
+ (decode-coding-region pos (point)
+ (if val coding-no-eol coding))
+ (if val
+ (put-text-property pos (point)
+ 'dired-filename t)))))))
+
+ (if full-directory-p
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char beg)
+ ;; First find the line to put it on.
+ (when (re-search-forward "^ *\\(total\\)" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "used", to avoid confusion.
+ (replace-match "total used in directory" nil nil nil 1)
+ (end-of-line)
+ (insert " available " available)))))))))))
(defun insert-directory-safely (file switches
&optional wildcard full-directory-p)
(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)
+;;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
;;; files.el ends here