Maximum length of the history list is determined by the value
of `history-length', which see.")
+
+(defvar save-silently nil
+ "If non-nil, avoid messages when saving files.
+Error-related messages will still be printed, but all other
+messages will not.")
+
\f
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
(lambda (f) (and (file-directory-p f) 'dir-ok)))
(error "No such directory found via CDPATH environment variable"))))
-(defun file-tree-walk (dir action &rest args)
- "Walk DIR executing ACTION on each file, with ARGS as additional arguments.
-For each file, the function calls ACTION as follows:
-
- \(ACTION DIRECTORY BASENAME ARGS\)
-
-Where DIRECTORY is the leading directory of the file,
- BASENAME is the basename of the file,
- and ARGS are as specified in the call to this function, or nil if omitted.
-
-The ACTION is applied to each subdirectory before descending into
-it, and if nil is returned at that point, the descent will be
-prevented. Directory entries are sorted with string-lessp."
- (cond ((file-directory-p dir)
- (setq dir (file-name-as-directory dir))
- (let ((lst (directory-files dir nil nil t))
- fullname file)
- (while lst
- (setq file (car lst))
- (setq lst (cdr lst))
- (cond ((member file '("." "..")))
- (t
- (and (apply action dir file args)
- (setq fullname (concat dir file))
- (file-directory-p fullname)
- (apply 'file-tree-walk fullname action args)))))))
- (t
- (apply action
- (file-name-directory dir)
- (file-name-nondirectory dir)
- args))))
-
(defsubst directory-name-p (name)
"Return non-nil if NAME ends with a slash character."
(and (> (length name) 0)
and alphabetical order.
If INCLUDE-DIRECTORIES, also include directories that have matching names."
(let ((result nil)
- (files nil))
+ (files nil)
+ ;; When DIR is "/", remote file names like "/method:" could
+ ;; also be offered. We shall suppress them.
+ (tramp-mode (and tramp-mode (file-remote-p dir))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
- (path (expand-file-name leaf dir)))
+ (full-file (expand-file-name leaf dir)))
;; Don't follow symlinks to other directories.
- (unless (file-symlink-p path)
- (setq result (nconc result (directory-files-recursively
- path match include-directories))))
+ (unless (file-symlink-p full-file)
+ (setq result
+ (nconc result (directory-files-recursively
+ full-file match include-directories))))
(when (and include-directories
(string-match match leaf))
- (setq result (nconc result (list path)))))
+ (setq result (nconc result (list full-file)))))
(when (string-match match file)
(push (expand-file-name file dir) files)))))
(nconc result (nreverse files))))
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
- (and (memq system-type '(windows-nt ms-dos cygwin))
+ (and (memq system-type '(windows-nt ms-dos cygwin nacl))
(eq (compare-strings dir 0 nil dirfile 0 nil t) t))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (listp value)
(progn
(setq value (nreverse value))
- (cons (switch-to-buffer-other-window (car value))
- (mapcar 'switch-to-buffer (cdr value))))
+ (switch-to-buffer-other-window (car value))
+ (mapc 'switch-to-buffer (cdr value))
+ value)
(switch-to-buffer-other-window value))))
(defun find-file-other-frame (filename &optional wildcards)
(if (listp value)
(progn
(setq value (nreverse value))
- (cons (switch-to-buffer-other-frame (car value))
- (mapcar 'switch-to-buffer (cdr value))))
+ (switch-to-buffer-other-frame (car value))
+ (mapc 'switch-to-buffer (cdr value))
+ value)
(switch-to-buffer-other-frame value))))
(defun find-file-existing (filename)
(confirm-nonexistent-file-or-buffer) file-name)
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
- (error "Aborted"))
+ (user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
(not (yes-or-no-p "Kill and replace the buffer without saving it? "))
- (error "Aborted"))
+ (user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
(not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
(file-size-human-readable size) op-type))))
- (error "Aborted")))
+ (user-error "Aborted")))
(defun warn-maybe-out-of-memory (size)
"Warn if an attempt to open file of SIZE bytes may run out of memory."
out-of-memory-warning-percentage
(file-size-human-readable (* total-free-memory 1024)))))))))
+(defun files--message (format &rest args)
+ "Like `message', except sometimes don't print to minibuffer.
+If the variable `save-silently' is non-nil, the message is not
+displayed on the minibuffer."
+ (apply #'message format args)
+ (when save-silently (message 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
(or nowarn
find-file-suppress-same-file-warnings
(string-equal filename (buffer-file-name other))
- (message "%s and %s are the same file"
- filename (buffer-file-name other)))
+ (files--message "%s and %s are the same file"
+ filename (buffer-file-name other)))
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other))))
(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
+due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
+ (signal 'file-error (list "Opening input file" "Is a directory"
filename)))
;; Check whether the file is uncommonly large
(abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename)
;; this has lower priority to avoid matching changelog.sgml etc.
("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
;; either user's dot-files or under /etc or some such
- ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
+ ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
;; alas not all ~/.*rc files are like this
("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
(error "Local variables entry is missing the prefix"))
(end-of-line)
;; Discard the suffix.
- (if (looking-back suffix)
+ (if (looking-back suffix (line-beginning-position))
(delete-region (match-beginning 0) (point))
(error "Local variables entry is missing the suffix"))
(forward-line 1))
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
Return the new variables list."
- (let* ((file-name (buffer-file-name))
+ (let* ((file-name (or (buffer-file-name)
+ ;; Handle non-file buffers, too.
+ (expand-file-name default-directory)))
(sub-file-name (if file-name
;; FIXME: Why not use file-relative-name?
(substring file-name (length root)))))
(not no-query)
(not (y-or-n-p (format "A buffer is visiting %s; proceed? "
filename)))
- (error "Aborted")))
+ (user-error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
(let ((oauto buffer-auto-save-file-name))
- ;; If auto-save was not already on, turn it on if appropriate.
- (if (not buffer-auto-save-file-name)
- (and buffer-file-name auto-save-default
- (auto-save-mode t))
- ;; If auto save is on, start using a new name.
- ;; We deliberately don't rename or delete the old auto save
- ;; for the old visited file name. This is because perhaps
- ;; the user wants to save the new state and then compare with the
- ;; previous state from the auto save file.
- (setq buffer-auto-save-file-name
- (make-auto-save-file-name)))
+ (cond ((null filename)
+ (setq buffer-auto-save-file-name nil))
+ ((not buffer-auto-save-file-name)
+ ;; If auto-save was not already on, turn it on if appropriate.
+ (and buffer-file-name auto-save-default (auto-save-mode t)))
+ (t
+ ;; If auto save is on, start using a new name. We
+ ;; deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because
+ ;; perhaps the user wants to save the new state and then
+ ;; compare with the previous state from the auto save
+ ;; file.
+ (setq buffer-auto-save-file-name (make-auto-save-file-name))))
;; Rename the old auto save file if any.
(and oauto buffer-auto-save-file-name
(file-exists-p oauto)
(listp last-nonmenu-event)
use-dialog-box))
(or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
- (error "Canceled")))
+ (user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
;; Make buffer writable if file is writable.
;; then Rmail-mbox never displays it due to buffer swapping. If
;; the test is ever re-introduced, be sure to handle saving of
;; Rmail files.
- (if (and modp (buffer-file-name) (not noninteractive))
+ (if (and modp
+ (buffer-file-name)
+ (not noninteractive)
+ (not save-silently))
(message "Saving file %s..." (buffer-file-name)))
- (basic-save-buffer)
+ (basic-save-buffer (called-interactively-p 'any))
(and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
(defun delete-auto-save-file-if-necessary (&optional force)
(make-variable-buffer-local 'save-buffer-coding-system)
(put 'save-buffer-coding-system 'permanent-local t)
-(defun basic-save-buffer ()
+(defun basic-save-buffer (&optional called-interactively)
"Save the current buffer in its visited file, if it has been modified.
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 in the usual way.
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
- (interactive)
+ (interactive '(called-interactively))
(save-current-buffer
;; In an indirect buffer, save its base buffer instead.
(if (buffer-base-buffer)
;; Support VC `implicit' locking.
(vc-after-save)
(run-hooks 'after-save-hook))
- (or noninteractive (message "(No changes need to be saved)")))))
+ (or noninteractive
+ (not called-interactively)
+ (files--message "(No changes need to be saved)")))))
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
;; Pass in nil&nil rather than point-min&max
;; cause we're saving the whole buffer.
;; write-region-annotate-functions may use it.
- (write-region nil nil
- tempname nil realname
- buffer-file-truename 'excl)
+ (write-region nil nil
+ tempname nil realname
+ buffer-file-truename 'excl)
+ (when save-silently (message nil))
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
;; Pass in nil&nil rather than point-min&max to indicate
;; we're saving the buffer rather than just a region.
;; write-region-annotate-functions may make us of it.
- (write-region nil nil
- buffer-file-name nil t buffer-file-truename)
+ (write-region nil nil
+ buffer-file-name nil t buffer-file-truename)
+ (when save-silently (message nil))
(setq success t))
;; If we get an error writing the new file, and we made
;; the backup by renaming, undo the backing-up.
(or queried (> files-done 0) abbrevs-done
(cond
((null autosaved-buffers)
- (message "(No files need saving)"))
+ (when (called-interactively-p 'any)
+ (files--message "(No files need saving)")))
((= (length autosaved-buffers) 1)
- (message "(Saved %s)" (car autosaved-buffers)))
+ (files--message "(Saved %s)" (car autosaved-buffers)))
(t
- (message "(Saved %d files: %s)"
- (length autosaved-buffers)
- (mapconcat 'identity autosaved-buffers ", "))))))))
+ (files--message "(Saved %d files: %s)"
+ (length autosaved-buffers)
+ (mapconcat 'identity autosaved-buffers ", "))))))))
\f
(defun clear-visited-file-modtime ()
"Clear out records of last mod time of visited file.
prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(declare (interactive-only set-buffer-modified-p))
(interactive "P")
- (message (if arg "Modification-flag set"
- "Modification-flag cleared"))
+ (files--message (if arg "Modification-flag set"
+ "Modification-flag cleared"))
(set-buffer-modified-p arg))
(defun toggle-read-only (&optional arg interactive)
This does character code conversion and applies annotations
like `write-region' does."
(interactive "r\nFAppend to file: ")
- (write-region start end filename t))
+ (prog1 (write-region start end filename t)
+ (when save-silently (message nil))))
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
(interactive)
(if (null auto-save-list-file-prefix)
(error "You set `auto-save-list-file-prefix' to disable making session files"))
- (let ((dir (file-name-directory auto-save-list-file-prefix)))
+ (let ((dir (file-name-directory auto-save-list-file-prefix))
+ (nd (file-name-nondirectory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
(make-directory dir t))
(unless (directory-files dir nil
- (concat "\\`" (regexp-quote
- (file-name-nondirectory
- auto-save-list-file-prefix)))
+ (if (string= "" nd)
+ directory-files-no-dot-files-regexp
+ (concat "\\`" (regexp-quote nd)))
t)
(error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
-set [ \\t\\n;<>&|()'\"#$] is quoted with a backslash; for DOS/Windows, all
+set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
(if (or (string-match "[\"]" pattern)
- ;; We quote [&()#$'] in case their shell is a port of a
+ ;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
;; passing arguments to batch files that use positional
;; arguments like %1.
- (not (string-match "[ \t;&()#$',=+]" pattern)))
+ (not (string-match "[ \t;&()#$`',=+]" pattern)))
pattern
(let ((result "\"")
(beg 0)
(concat result (substring pattern beg) "\""))))
(t
(let ((beg 0))
- (while (string-match "[ \t\n;<>&|()'\"#$]" pattern beg)
+ (while (string-match "[ \t\n;<>&|()`'\"#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
- (and (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
- (buffer-list))))
- (yes-or-no-p "Modified buffers exist; exit anyway? "))
- (or (not (fboundp 'process-list))
- ;; process-list is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (with-current-buffer-window
- (get-buffer-create "*Process List*") nil
- #'(lambda (window _value)
- (with-selected-window window
- (unwind-protect
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
- (when (window-live-p window)
- (quit-restore-window window 'kill)))))
- (list-processes t)))))
- ;; Query the user for other things, perhaps.
- (run-hook-with-args-until-failure 'kill-emacs-query-functions)
- (or (null confirm-kill-emacs)
- (funcall confirm-kill-emacs "Really exit Emacs? "))
- (kill-emacs)))
+ (let ((confirm confirm-kill-emacs))
+ (and
+ (or (not (memq t (mapcar (function
+ (lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf))))
+ (buffer-list))))
+ (progn (setq confirm nil)
+ (yes-or-no-p "Modified buffers exist; exit anyway? ")))
+ (or (not (fboundp 'process-list))
+ ;; process-list is not defined on MSDOS.
+ (let ((processes (process-list))
+ active)
+ (while processes
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
+ (setq active t))
+ (setq processes (cdr processes)))
+ (or (not active)
+ (with-current-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (progn
+ (setq confirm nil)
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? "))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
+ ;; Query the user for other things, perhaps.
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
+ (or (null confirm)
+ (funcall confirm "Really exit Emacs? "))
+ (kill-emacs))))
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.