Line data Source code
1 : ;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1985-1987, 1992-2017 Free Software Foundation, Inc.
4 :
5 : ;; Maintainer: emacs-devel@gnu.org
6 : ;; Package: emacs
7 :
8 : ;; This file is part of GNU Emacs.
9 :
10 : ;; GNU Emacs is free software: you can redistribute it and/or modify
11 : ;; it under the terms of the GNU General Public License as published by
12 : ;; the Free Software Foundation, either version 3 of the License, or
13 : ;; (at your option) any later version.
14 :
15 : ;; GNU Emacs is distributed in the hope that it will be useful,
16 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 : ;; GNU General Public License for more details.
19 :
20 : ;; You should have received a copy of the GNU General Public License
21 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 :
23 : ;;; Commentary:
24 :
25 : ;; Defines most of Emacs's file- and directory-handling functions,
26 : ;; including basic file visiting, backup generation, link handling,
27 : ;; ITS-id version control, load- and write-hook handling, and the like.
28 :
29 : ;;; Code:
30 :
31 : (eval-when-compile
32 : (require 'pcase)
33 : (require 'easy-mmode)) ; For `define-minor-mode'.
34 :
35 : (defvar font-lock-keywords)
36 :
37 : (defgroup backup nil
38 : "Backups of edited data files."
39 : :group 'files)
40 :
41 : (defgroup find-file nil
42 : "Finding files."
43 : :group 'files)
44 :
45 :
46 : (defcustom delete-auto-save-files t
47 : "Non-nil means delete auto-save file when a buffer is saved or killed.
48 :
49 : Note that the auto-save file will not be deleted if the buffer is killed
50 : when it has unsaved changes."
51 : :type 'boolean
52 : :group 'auto-save)
53 :
54 : (defcustom directory-abbrev-alist
55 : nil
56 : "Alist of abbreviations for file directories.
57 : A list of elements of the form (FROM . TO), each meaning to replace
58 : a match for FROM with TO when a directory name matches FROM. This
59 : replacement is done when setting up the default directory of a
60 : newly visited file buffer.
61 :
62 : FROM is a regexp that is matched against directory names anchored at
63 : the first character, so it should start with a \"\\\\\\=`\", or, if
64 : directory names cannot have embedded newlines, with a \"^\".
65 :
66 : FROM and TO should be equivalent names, which refer to the
67 : same directory. TO should be an absolute directory name.
68 : Do not use `~' in the TO strings.
69 :
70 : Use this feature when you have directories which you normally refer to
71 : via absolute symbolic links. Make TO the name of the link, and FROM
72 : a regexp matching the name it is linked to."
73 : :type '(repeat (cons :format "%v"
74 : :value ("\\`" . "")
75 : (regexp :tag "From")
76 : (string :tag "To")))
77 : :group 'abbrev
78 : :group 'find-file)
79 :
80 : (defcustom make-backup-files t
81 : "Non-nil means make a backup of a file the first time it is saved.
82 : This can be done by renaming the file or by copying.
83 :
84 : Renaming means that Emacs renames the existing file so that it is a
85 : backup file, then writes the buffer into a new file. Any other names
86 : that the old file had will now refer to the backup file. The new file
87 : is owned by you and its group is defaulted.
88 :
89 : Copying means that Emacs copies the existing file into the backup
90 : file, then writes the buffer on top of the existing file. Any other
91 : names that the old file had will now refer to the new (edited) file.
92 : The file's owner and group are unchanged.
93 :
94 : The choice of renaming or copying is controlled by the variables
95 : `backup-by-copying', `backup-by-copying-when-linked',
96 : `backup-by-copying-when-mismatch' and
97 : `backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
98 : :type 'boolean
99 : :group 'backup)
100 :
101 : ;; Do this so that local variables based on the file name
102 : ;; are not overridden by the major mode.
103 : (defvar backup-inhibited nil
104 : "If non-nil, backups will be inhibited.
105 : This variable is intended for use by making it local to a buffer,
106 : but it is not an automatically buffer-local variable.")
107 : (put 'backup-inhibited 'permanent-local t)
108 :
109 : (defcustom backup-by-copying nil
110 : "Non-nil means always use copying to create backup files.
111 : See documentation of variable `make-backup-files'."
112 : :type 'boolean
113 : :group 'backup)
114 :
115 : (defcustom backup-by-copying-when-linked nil
116 : "Non-nil means use copying to create backups for files with multiple names.
117 : This causes the alternate names to refer to the latest version as edited.
118 : This variable is relevant only if `backup-by-copying' is nil."
119 : :type 'boolean
120 : :group 'backup)
121 :
122 : (defcustom backup-by-copying-when-mismatch t
123 : "Non-nil means create backups by copying if this preserves owner or group.
124 : Renaming may still be used (subject to control of other variables)
125 : when it would not result in changing the owner or group of the file;
126 : that is, for files which are owned by you and whose group matches
127 : the default for a new file created there by you.
128 : This variable is relevant only if `backup-by-copying' is nil."
129 : :version "24.1"
130 : :type 'boolean
131 : :group 'backup)
132 : (put 'backup-by-copying-when-mismatch 'permanent-local t)
133 :
134 : (defcustom backup-by-copying-when-privileged-mismatch 200
135 : "Non-nil means create backups by copying to preserve a privileged owner.
136 : Renaming may still be used (subject to control of other variables)
137 : when it would not result in changing the owner of the file or if the owner
138 : has a user id greater than the value of this variable. This is useful
139 : when low-numbered uid's are used for special system users (such as root)
140 : that must maintain ownership of certain files.
141 : This variable is relevant only if `backup-by-copying' and
142 : `backup-by-copying-when-mismatch' are nil."
143 : :type '(choice (const nil) integer)
144 : :group 'backup)
145 :
146 : (defvar backup-enable-predicate 'normal-backup-enable-predicate
147 : "Predicate that looks at a file name and decides whether to make backups.
148 : Called with an absolute file name as argument, it returns t to enable backup.")
149 :
150 : (defcustom buffer-offer-save nil
151 : "Non-nil in a buffer means always offer to save buffer on exit.
152 : Do so even if the buffer is not visiting a file.
153 : Automatically local in all buffers."
154 : :type 'boolean
155 : :group 'backup)
156 : (make-variable-buffer-local 'buffer-offer-save)
157 : (put 'buffer-offer-save 'permanent-local t)
158 :
159 : (defcustom find-file-existing-other-name t
160 : "Non-nil means find a file under alternative names, in existing buffers.
161 : This means if any existing buffer is visiting the file you want
162 : under another name, you get the existing buffer instead of a new buffer."
163 : :type 'boolean
164 : :group 'find-file)
165 :
166 : (defcustom find-file-visit-truename nil
167 : "Non-nil means visiting a file uses its truename as the visited-file name.
168 : That is, the buffer visiting the file has the truename as the
169 : value of `buffer-file-name'. The truename of a file is found by
170 : chasing all links both at the file level and at the levels of the
171 : containing directories."
172 : :type 'boolean
173 : :group 'find-file)
174 : (put 'find-file-visit-truename 'safe-local-variable 'booleanp)
175 :
176 : (defcustom revert-without-query nil
177 : "Specify which files should be reverted without query.
178 : The value is a list of regular expressions.
179 : If the file name matches one of these regular expressions,
180 : then `revert-buffer' reverts the file without querying
181 : if the file has changed on disk and you have not edited the buffer."
182 : :type '(repeat regexp)
183 : :group 'find-file)
184 :
185 : (defvar buffer-file-number nil
186 : "The device number and file number of the file visited in the current buffer.
187 : The value is a list of the form (FILENUM DEVNUM).
188 : This pair of numbers uniquely identifies the file.
189 : If the buffer is visiting a new file, the value is nil.")
190 : (make-variable-buffer-local 'buffer-file-number)
191 : (put 'buffer-file-number 'permanent-local t)
192 :
193 : (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
194 : "Non-nil means that `buffer-file-number' uniquely identifies files.")
195 :
196 : (defvar buffer-file-read-only nil
197 : "Non-nil if visited file was read-only when visited.")
198 : (make-variable-buffer-local 'buffer-file-read-only)
199 :
200 : (defcustom small-temporary-file-directory
201 : (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
202 : "The directory for writing small temporary files.
203 : If non-nil, this directory is used instead of `temporary-file-directory'
204 : by programs that create small temporary files. This is for systems that
205 : have fast storage with limited space, such as a RAM disk."
206 : :group 'files
207 : :initialize 'custom-initialize-delay
208 : :type '(choice (const nil) directory))
209 :
210 : ;; The system null device. (Should reference NULL_DEVICE from C.)
211 : (defvar null-device (purecopy "/dev/null") "The system null device.")
212 :
213 : (declare-function msdos-long-file-names "msdos.c")
214 : (declare-function w32-long-file-name "w32proc.c")
215 : (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
216 : (declare-function dired-unmark "dired" (arg &optional interactive))
217 : (declare-function dired-do-flagged-delete "dired" (&optional nomessage))
218 : (declare-function dos-8+3-filename "dos-fns" (filename))
219 : (declare-function dosified-file-name "dos-fns" (file-name))
220 :
221 : (defvar file-name-invalid-regexp
222 : (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
223 : (purecopy
224 : (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
225 : "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
226 : "[\000-\037]\\|" ; control characters
227 : "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
228 : "\\(/[^/.]+\\.[^/.]*\\.\\)"))) ; more than a single dot
229 : ((memq system-type '(ms-dos windows-nt cygwin))
230 : (purecopy
231 : (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
232 : "[|<>\"?*\000-\037]"))) ; invalid characters
233 : (t (purecopy "[\000]")))
234 : "Regexp recognizing file names which aren't allowed by the filesystem.")
235 :
236 : (defcustom file-precious-flag nil
237 : "Non-nil means protect against I/O errors while saving files.
238 : Some modes set this non-nil in particular buffers.
239 :
240 : This feature works by writing the new contents into a temporary file
241 : and then renaming the temporary file to replace the original.
242 : In this way, any I/O error in writing leaves the original untouched,
243 : and there is never any instant where the file is nonexistent.
244 :
245 : Note that this feature forces backups to be made by copying.
246 : Yet, at the same time, saving a precious file
247 : breaks any hard links between it and other files.
248 :
249 : This feature is advisory: for example, if the directory in which the
250 : file is being saved is not writable, Emacs may ignore a non-nil value
251 : of `file-precious-flag' and write directly into the file.
252 :
253 : See also: `break-hardlink-on-save'."
254 : :type 'boolean
255 : :group 'backup)
256 :
257 : (defcustom break-hardlink-on-save nil
258 : "Whether to allow breaking hardlinks when saving files.
259 : If non-nil, then when saving a file that exists under several
260 : names \(i.e., has multiple hardlinks), break the hardlink
261 : associated with `buffer-file-name' and write to a new file, so
262 : that the other instances of the file are not affected by the
263 : save.
264 :
265 : If `buffer-file-name' refers to a symlink, do not break the symlink.
266 :
267 : Unlike `file-precious-flag', `break-hardlink-on-save' is not advisory.
268 : For example, if the directory in which a file is being saved is not
269 : itself writable, then error instead of saving in some
270 : hardlink-nonbreaking way.
271 :
272 : See also `backup-by-copying' and `backup-by-copying-when-linked'."
273 : :type 'boolean
274 : :group 'files
275 : :version "23.1")
276 :
277 : (defcustom version-control nil
278 : "Control use of version numbers for backup files.
279 : When t, make numeric backup versions unconditionally.
280 : When nil, make them for files that have some already.
281 : The value `never' means do not make them."
282 : :type '(choice (const :tag "Never" never)
283 : (const :tag "If existing" nil)
284 : (other :tag "Always" t))
285 : :group 'backup)
286 :
287 : (defun version-control-safe-local-p (x)
288 : "Return whether X is safe as local value for `version-control'."
289 19 : (or (booleanp x) (equal x 'never)))
290 :
291 : (put 'version-control 'safe-local-variable
292 : #'version-control-safe-local-p)
293 :
294 : (defcustom dired-kept-versions 2
295 : "When cleaning directory, number of versions to keep."
296 : :type 'integer
297 : :group 'backup
298 : :group 'dired)
299 :
300 : (defcustom delete-old-versions nil
301 : "If t, delete excess backup versions silently.
302 : If nil, ask confirmation. Any other value prevents any trimming."
303 : :type '(choice (const :tag "Delete" t)
304 : (const :tag "Ask" nil)
305 : (other :tag "Leave" other))
306 : :group 'backup)
307 :
308 : (defcustom kept-old-versions 2
309 : "Number of oldest versions to keep when a new numbered backup is made."
310 : :type 'integer
311 : :group 'backup)
312 : (put 'kept-old-versions 'safe-local-variable 'integerp)
313 :
314 : (defcustom kept-new-versions 2
315 : "Number of newest versions to keep when a new numbered backup is made.
316 : Includes the new backup. Must be > 0"
317 : :type 'integer
318 : :group 'backup)
319 : (put 'kept-new-versions 'safe-local-variable 'integerp)
320 :
321 : (defcustom require-final-newline nil
322 : "Whether to add a newline automatically at the end of the file.
323 :
324 : A value of t means do this only when the file is about to be saved.
325 : A value of `visit' means do this right after the file is visited.
326 : A value of `visit-save' means do it at both of those times.
327 : Any other non-nil value means ask user whether to add a newline, when saving.
328 : A value of nil means don't add newlines.
329 :
330 : Certain major modes set this locally to the value obtained
331 : from `mode-require-final-newline'."
332 : :safe #'symbolp
333 : :type '(choice (const :tag "When visiting" visit)
334 : (const :tag "When saving" t)
335 : (const :tag "When visiting or saving" visit-save)
336 : (const :tag "Don't add newlines" nil)
337 : (other :tag "Ask each time" ask))
338 : :group 'editing-basics)
339 :
340 : (defcustom mode-require-final-newline t
341 : "Whether to add a newline at end of file, in certain major modes.
342 : Those modes set `require-final-newline' to this value when you enable them.
343 : They do so because they are often used for files that are supposed
344 : to end in newlines, and the question is how to arrange that.
345 :
346 : A value of t means do this only when the file is about to be saved.
347 : A value of `visit' means do this right after the file is visited.
348 : A value of `visit-save' means do it at both of those times.
349 : Any other non-nil value means ask user whether to add a newline, when saving.
350 :
351 : A value of nil means do not add newlines. That is a risky choice in this
352 : variable since this value is used for modes for files that ought to have
353 : final newlines. So if you set this to nil, you must explicitly check and
354 : add a final newline, whenever you save a file that really needs one."
355 : :type '(choice (const :tag "When visiting" visit)
356 : (const :tag "When saving" t)
357 : (const :tag "When visiting or saving" visit-save)
358 : (const :tag "Don't add newlines" nil)
359 : (other :tag "Ask each time" ask))
360 : :group 'editing-basics
361 : :version "22.1")
362 :
363 : (defcustom auto-save-default t
364 : "Non-nil says by default do auto-saving of every file-visiting buffer."
365 : :type 'boolean
366 : :group 'auto-save)
367 :
368 : (defcustom auto-save-file-name-transforms
369 : `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
370 : ;; Don't put "\\2" inside expand-file-name, since it will be
371 : ;; transformed to "/2" on DOS/Windows.
372 : ,(concat temporary-file-directory "\\2") t))
373 : "Transforms to apply to buffer file name before making auto-save file name.
374 : Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
375 : REGEXP is a regular expression to match against the file name.
376 : If it matches, `replace-match' is used to replace the
377 : matching part with REPLACEMENT.
378 : If the optional element UNIQUIFY is non-nil, the auto-save file name is
379 : constructed by taking the directory part of the replaced file-name,
380 : concatenated with the buffer file name with all directory separators
381 : changed to `!' to prevent clashes. This will not work
382 : correctly if your filesystem truncates the resulting name.
383 :
384 : All the transforms in the list are tried, in the order they are listed.
385 : When one transform applies, its result is final;
386 : no further transforms are tried.
387 :
388 : The default value is set up to put the auto-save file into the
389 : temporary directory (see the variable `temporary-file-directory') for
390 : editing a remote file.
391 :
392 : On MS-DOS filesystems without long names this variable is always
393 : ignored."
394 : :group 'auto-save
395 : :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
396 : (boolean :tag "Uniquify")))
397 : :initialize 'custom-initialize-delay
398 : :version "21.1")
399 :
400 : (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
401 :
402 : (defcustom auto-save-visited-interval 5
403 : "Interval in seconds for `auto-save-visited-mode'.
404 : If `auto-save-visited-mode' is enabled, Emacs will save all
405 : buffers visiting a file to the visited file after it has been
406 : idle for `auto-save-visited-interval' seconds."
407 : :group 'auto-save
408 : :type 'number
409 : :version "26.1"
410 : :set (lambda (symbol value)
411 : (set-default symbol value)
412 : (when auto-save--timer
413 : (timer-set-idle-time auto-save--timer value :repeat))))
414 :
415 : (define-minor-mode auto-save-visited-mode
416 : "Toggle automatic saving to file-visiting buffers on or off.
417 : With a prefix argument ARG, enable regular saving of all buffers
418 : visiting a file if ARG is positive, and disable it otherwise.
419 : Unlike `auto-save-mode', this mode will auto-save buffer contents
420 : to the visited files directly and will also run all save-related
421 : hooks. See Info node `Saving' for details of the save process.
422 :
423 : If called from Lisp, enable the mode if ARG is omitted or nil,
424 : and toggle it if ARG is `toggle'."
425 : :group 'auto-save
426 : :global t
427 0 : (when auto-save--timer (cancel-timer auto-save--timer))
428 0 : (setq auto-save--timer
429 0 : (when auto-save-visited-mode
430 0 : (run-with-idle-timer
431 0 : auto-save-visited-interval :repeat
432 0 : #'save-some-buffers :no-prompt
433 : (lambda ()
434 0 : (not (and buffer-auto-save-file-name
435 0 : auto-save-visited-file-name)))))))
436 :
437 : ;; The 'set' part is so we don't get a warning for using this variable
438 : ;; above, while still catching code that _sets_ the variable to get
439 : ;; the same effect as the new auto-save-visited-mode.
440 : (make-obsolete-variable 'auto-save-visited-file-name 'auto-save-visited-mode
441 : "Emacs 26.1" 'set)
442 :
443 : (defcustom save-abbrevs t
444 : "Non-nil means save word abbrevs too when files are saved.
445 : If `silently', don't ask the user before saving."
446 : :type '(choice (const t) (const nil) (const silently))
447 : :group 'abbrev)
448 :
449 : (defcustom find-file-run-dired t
450 : "Non-nil means allow `find-file' to visit directories.
451 : To visit the directory, `find-file' runs `find-directory-functions'."
452 : :type 'boolean
453 : :group 'find-file)
454 :
455 : (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
456 : "List of functions to try in sequence to visit a directory.
457 : Each function is called with the directory name as the sole argument
458 : and should return either a buffer or nil."
459 : :type '(hook :options (cvs-dired-noselect dired-noselect))
460 : :group 'find-file)
461 :
462 : ;; FIXME: also add a hook for `(thing-at-point 'filename)'
463 : (defcustom file-name-at-point-functions '(ffap-guess-file-name-at-point)
464 : "List of functions to try in sequence to get a file name at point.
465 : Each function should return either nil or a file name found at the
466 : location of point in the current buffer."
467 : :type '(hook :options (ffap-guess-file-name-at-point))
468 : :group 'find-file)
469 :
470 : ;;;It is not useful to make this a local variable.
471 : ;;;(put 'find-file-not-found-hooks 'permanent-local t)
472 : (define-obsolete-variable-alias 'find-file-not-found-hooks
473 : 'find-file-not-found-functions "22.1")
474 : (defvar find-file-not-found-functions nil
475 : "List of functions to be called for `find-file' on nonexistent file.
476 : These functions are called as soon as the error is detected.
477 : Variable `buffer-file-name' is already set up.
478 : The functions are called in the order given until one of them returns non-nil.")
479 :
480 : ;;;It is not useful to make this a local variable.
481 : ;;;(put 'find-file-hooks 'permanent-local t)
482 : (define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
483 : (defcustom find-file-hook nil
484 : "List of functions to be called after a buffer is loaded from a file.
485 : The buffer's local variables (if any) will have been processed before the
486 : functions are called."
487 : :group 'find-file
488 : :type 'hook
489 : :options '(auto-insert)
490 : :version "22.1")
491 :
492 : (define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
493 : (defvar write-file-functions nil
494 : "List of functions to be called before saving a buffer to a file.
495 : Only used by `save-buffer'.
496 : If one of them returns non-nil, the file is considered already written
497 : and the rest are not called.
498 : These hooks are considered to pertain to the visited file.
499 : So any buffer-local binding of this variable is discarded if you change
500 : the visited file name with \\[set-visited-file-name], but not when you
501 : change the major mode.
502 :
503 : This hook is not run if any of the functions in
504 : `write-contents-functions' returns non-nil. Both hooks pertain
505 : to how to save a buffer to file, for instance, choosing a suitable
506 : coding system and setting mode bits. (See Info
507 : node `(elisp)Saving Buffers'.) To perform various checks or
508 : updates before the buffer is saved, use `before-save-hook'.")
509 : (put 'write-file-functions 'permanent-local t)
510 :
511 : (defvar local-write-file-hooks nil)
512 : (make-variable-buffer-local 'local-write-file-hooks)
513 : (put 'local-write-file-hooks 'permanent-local t)
514 : (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
515 :
516 : (define-obsolete-variable-alias 'write-contents-hooks
517 : 'write-contents-functions "22.1")
518 : (defvar write-contents-functions nil
519 : "List of functions to be called before writing out a buffer to a file.
520 : Only used by `save-buffer'.
521 : If one of them returns non-nil, the file is considered already written
522 : and the rest are not called and neither are the functions in
523 : `write-file-functions'.
524 :
525 : This variable is meant to be used for hooks that pertain to the
526 : buffer's contents, not to the particular visited file; thus,
527 : `set-visited-file-name' does not clear this variable; but changing the
528 : major mode does clear it.
529 :
530 : For hooks that _do_ pertain to the particular visited file, use
531 : `write-file-functions'. Both this variable and
532 : `write-file-functions' relate to how a buffer is saved to file.
533 : To perform various checks or updates before the buffer is saved,
534 : use `before-save-hook'.")
535 : (make-variable-buffer-local 'write-contents-functions)
536 :
537 : (defcustom enable-local-variables t
538 : "Control use of local variables in files you visit.
539 : The value can be t, nil, :safe, :all, or something else.
540 :
541 : A value of t means file local variables specifications are obeyed
542 : if all the specified variable values are safe; if any values are
543 : not safe, Emacs queries you, once, whether to set them all.
544 : \(When you say yes to certain values, they are remembered as safe.)
545 :
546 : :safe means set the safe variables, and ignore the rest.
547 : :all means set all variables, whether safe or not.
548 : (Don't set it permanently to :all.)
549 : A value of nil means always ignore the file local variables.
550 :
551 : Any other value means always query you once whether to set them all.
552 : \(When you say yes to certain values, they are remembered as safe, but
553 : this has no effect when `enable-local-variables' is \"something else\".)
554 :
555 : This variable also controls use of major modes specified in
556 : a -*- line.
557 :
558 : The command \\[normal-mode], when used interactively,
559 : always obeys file local variable specifications and the -*- line,
560 : and ignores this variable."
561 : :risky t
562 : :type '(choice (const :tag "Query Unsafe" t)
563 : (const :tag "Safe Only" :safe)
564 : (const :tag "Do all" :all)
565 : (const :tag "Ignore" nil)
566 : (other :tag "Query" other))
567 : :group 'find-file)
568 :
569 : (defvar enable-dir-local-variables t
570 : "Non-nil means enable use of directory-local variables.
571 : Some modes may wish to set this to nil to prevent directory-local
572 : settings being applied, but still respect file-local ones.")
573 :
574 : ;; This is an odd variable IMO.
575 : ;; You might wonder why it is needed, when we could just do:
576 : ;; (set (make-local-variable 'enable-local-variables) nil)
577 : ;; These two are not precisely the same.
578 : ;; Setting this variable does not cause -*- mode settings to be
579 : ;; ignored, whereas setting enable-local-variables does.
580 : ;; Only three places in Emacs use this variable: tar and arc modes,
581 : ;; and rmail. The first two don't need it. They already use
582 : ;; inhibit-local-variables-regexps, which is probably enough, and
583 : ;; could also just set enable-local-variables locally to nil.
584 : ;; Them setting it has the side-effect that dir-locals cannot apply to
585 : ;; eg tar files (?). FIXME Is this appropriate?
586 : ;; AFAICS, rmail is the only thing that needs this, and the only
587 : ;; reason it uses it is for BABYL files (which are obsolete).
588 : ;; These contain "-*- rmail -*-" in the first line, which rmail wants
589 : ;; to respect, so that find-file on a BABYL file will switch to
590 : ;; rmail-mode automatically (this is nice, but hardly essential,
591 : ;; since most people are used to explicitly running a command to
592 : ;; access their mail; M-x gnus etc). Rmail files may happen to
593 : ;; contain Local Variables sections in messages, which Rmail wants to
594 : ;; ignore. So AFAICS the only reason this variable exists is for a
595 : ;; minor convenience feature for handling of an obsolete Rmail file format.
596 : (defvar local-enable-local-variables t
597 : "Like `enable-local-variables', except for major mode in a -*- line.
598 : The meaningful values are nil and non-nil. The default is non-nil.
599 : It should be set in a buffer-local fashion.
600 :
601 : Setting this to nil has the same effect as setting `enable-local-variables'
602 : to nil, except that it does not ignore any mode: setting in a -*- line.
603 : Unless this difference matters to you, you should set `enable-local-variables'
604 : instead of this variable.")
605 :
606 : (defcustom enable-local-eval 'maybe
607 : "Control processing of the \"variable\" `eval' in a file's local variables.
608 : The value can be t, nil or something else.
609 : A value of t means obey `eval' variables.
610 : A value of nil means ignore them; anything else means query."
611 : :risky t
612 : :type '(choice (const :tag "Obey" t)
613 : (const :tag "Ignore" nil)
614 : (other :tag "Query" other))
615 : :group 'find-file)
616 :
617 : (defcustom view-read-only nil
618 : "Non-nil means buffers visiting files read-only do so in view mode.
619 : In fact, this means that all read-only buffers normally have
620 : View mode enabled, including buffers that are read-only because
621 : you visit a file you cannot alter, and buffers you make read-only
622 : using \\[read-only-mode]."
623 : :type 'boolean
624 : :group 'view)
625 :
626 : (defvar file-name-history nil
627 : "History list of file names entered in the minibuffer.
628 :
629 : Maximum length of the history list is determined by the value
630 : of `history-length', which see.")
631 :
632 : (defvar save-silently nil
633 : "If non-nil, avoid messages when saving files.
634 : Error-related messages will still be printed, but all other
635 : messages will not.")
636 :
637 :
638 : (put 'ange-ftp-completion-hook-function 'safe-magic t)
639 : (defun ange-ftp-completion-hook-function (op &rest args)
640 : "Provides support for ange-ftp host name completion.
641 : Runs the usual ange-ftp hook, but only for completion operations."
642 : ;; Having this here avoids the need to load ange-ftp when it's not
643 : ;; really in use.
644 0 : (if (memq op '(file-name-completion file-name-all-completions))
645 0 : (apply 'ange-ftp-hook-function op args)
646 0 : (let ((inhibit-file-name-handlers
647 0 : (cons 'ange-ftp-completion-hook-function
648 0 : (and (eq inhibit-file-name-operation op)
649 0 : inhibit-file-name-handlers)))
650 0 : (inhibit-file-name-operation op))
651 0 : (apply op args))))
652 :
653 : (declare-function dos-convert-standard-filename "dos-fns.el" (filename))
654 : (declare-function w32-convert-standard-filename "w32-fns.el" (filename))
655 :
656 : (defun convert-standard-filename (filename)
657 : "Convert a standard file's name to something suitable for the OS.
658 : This means to guarantee valid names and perhaps to canonicalize
659 : certain patterns.
660 :
661 : FILENAME should be an absolute file name since the conversion rules
662 : sometimes vary depending on the position in the file name. E.g. c:/foo
663 : is a valid DOS file name, but c:/bar/c:/foo is not.
664 :
665 : This function's standard definition is trivial; it just returns
666 : the argument. However, on Windows and DOS, replace invalid
667 : characters. On DOS, make sure to obey the 8.3 limitations.
668 : In the native Windows build, turn Cygwin names into native names.
669 :
670 : See Info node `(elisp)Standard File Names' for more details."
671 3 : (cond
672 3 : ((eq system-type 'cygwin)
673 0 : (let ((name (copy-sequence filename))
674 : (start 0))
675 : ;; Replace invalid filename characters with !
676 0 : (while (string-match "[?*:<>|\"\000-\037]" name start)
677 0 : (aset name (match-beginning 0) ?!)
678 0 : (setq start (match-end 0)))
679 0 : name))
680 3 : ((eq system-type 'windows-nt)
681 0 : (w32-convert-standard-filename filename))
682 3 : ((eq system-type 'ms-dos)
683 0 : (dos-convert-standard-filename filename))
684 3 : (t filename)))
685 :
686 : (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
687 : "Read directory name, prompting with PROMPT and completing in directory DIR.
688 : Value is not expanded---you must call `expand-file-name' yourself.
689 : Default name to DEFAULT-DIRNAME if user exits with the same
690 : non-empty string that was inserted by this function.
691 : (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
692 : or just DIR if INITIAL is nil.)
693 : If the user exits with an empty minibuffer, this function returns
694 : an empty string. (This can only happen if the user erased the
695 : pre-inserted contents or if `insert-default-directory' is nil.)
696 : Fourth arg MUSTMATCH non-nil means require existing directory's name.
697 : Non-nil and non-t means also require confirmation after completion.
698 : Fifth arg INITIAL specifies text to start with.
699 : DIR should be an absolute directory name. It defaults to
700 : the value of `default-directory'."
701 0 : (unless dir
702 0 : (setq dir default-directory))
703 0 : (read-file-name prompt dir (or default-dirname
704 0 : (if initial (expand-file-name initial dir)
705 0 : dir))
706 0 : mustmatch initial
707 0 : 'file-directory-p))
708 :
709 :
710 : (defun pwd (&optional insert)
711 : "Show the current default directory.
712 : With prefix argument INSERT, insert the current default directory
713 : at point instead."
714 : (interactive "P")
715 0 : (if insert
716 0 : (insert default-directory)
717 0 : (message "Directory %s" default-directory)))
718 :
719 : (defvar cd-path nil
720 : "Value of the CDPATH environment variable, as a list.
721 : Not actually set up until the first time you use it.")
722 :
723 : (defun parse-colon-path (search-path)
724 : "Explode a search path into a list of directory names.
725 : Directories are separated by `path-separator' (which is colon in
726 : GNU and Unix systems). Substitute environment variables into the
727 : resulting list of directory names. For an empty path element (i.e.,
728 : a leading or trailing separator, or two adjacent separators), return
729 : nil (meaning `default-directory') as the associated list element."
730 0 : (when (stringp search-path)
731 0 : (mapcar (lambda (f)
732 0 : (if (equal "" f) nil
733 0 : (substitute-in-file-name (file-name-as-directory f))))
734 0 : (split-string search-path path-separator))))
735 :
736 : (defun cd-absolute (dir)
737 : "Change current directory to given absolute file name DIR."
738 : ;; Put the name into directory syntax now,
739 : ;; because otherwise expand-file-name may give some bad results.
740 148 : (setq dir (file-name-as-directory dir))
741 : ;; We used to additionally call abbreviate-file-name here, for an
742 : ;; unknown reason. Problem is that most buffers are setup
743 : ;; without going through cd-absolute and don't call
744 : ;; abbreviate-file-name on their default-directory, so the few that
745 : ;; do end up using a superficially different directory.
746 148 : (setq dir (expand-file-name dir))
747 148 : (if (not (file-directory-p dir))
748 0 : (if (file-exists-p dir)
749 0 : (error "%s is not a directory" dir)
750 0 : (error "%s: no such directory" dir))
751 148 : (unless (file-accessible-directory-p dir)
752 148 : (error "Cannot cd to %s: Permission denied" dir))
753 148 : (setq default-directory dir)
754 148 : (setq list-buffers-directory dir)))
755 :
756 : (defun cd (dir)
757 : "Make DIR become the current buffer's default directory.
758 : If your environment includes a `CDPATH' variable, try each one of
759 : that list of directories (separated by occurrences of
760 : `path-separator') when resolving a relative directory name.
761 : The path separator is colon in GNU and GNU-like systems."
762 : (interactive
763 0 : (list
764 : ;; FIXME: There's a subtle bug in the completion below. Seems linked
765 : ;; to a fundamental difficulty of implementing `predicate' correctly.
766 : ;; The manifestation is that TAB may list non-directories in the case where
767 : ;; those files also correspond to valid directories (if your cd-path is (A/
768 : ;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/'
769 : ;; will be listed as valid completions).
770 : ;; This is because `a' (listed because of A/a) is indeed a valid choice
771 : ;; (which will lead to the use of B/a).
772 0 : (minibuffer-with-setup-hook
773 : (lambda ()
774 0 : (setq-local minibuffer-completion-table
775 0 : (apply-partially #'locate-file-completion-table
776 0 : cd-path nil))
777 0 : (setq-local minibuffer-completion-predicate
778 : (lambda (dir)
779 0 : (locate-file dir cd-path nil
780 0 : (lambda (f) (and (file-directory-p f) 'dir-ok))))))
781 0 : (unless cd-path
782 0 : (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
783 0 : (list "./"))))
784 0 : (read-directory-name "Change default directory: "
785 0 : default-directory default-directory
786 0 : t))))
787 148 : (unless cd-path
788 0 : (setq cd-path (or (parse-colon-path (getenv "CDPATH"))
789 148 : (list "./"))))
790 148 : (cd-absolute
791 148 : (or (locate-file dir cd-path nil
792 296 : (lambda (f) (and (file-directory-p f) 'dir-ok)))
793 148 : (error "No such directory found via CDPATH environment variable"))))
794 :
795 : (defun directory-files-recursively (dir regexp &optional include-directories)
796 : "Return list of all files under DIR that have file names matching REGEXP.
797 : This function works recursively. Files are returned in \"depth first\"
798 : order, and files from each directory are sorted in alphabetical order.
799 : Each file name appears in the returned list in its absolute form.
800 : Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
801 : output directories whose names match REGEXP."
802 0 : (let ((result nil)
803 : (files nil)
804 : ;; When DIR is "/", remote file names like "/method:" could
805 : ;; also be offered. We shall suppress them.
806 0 : (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
807 0 : (dolist (file (sort (file-name-all-completions "" dir)
808 0 : 'string<))
809 0 : (unless (member file '("./" "../"))
810 0 : (if (directory-name-p file)
811 0 : (let* ((leaf (substring file 0 (1- (length file))))
812 0 : (full-file (expand-file-name leaf dir)))
813 : ;; Don't follow symlinks to other directories.
814 0 : (unless (file-symlink-p full-file)
815 0 : (setq result
816 0 : (nconc result (directory-files-recursively
817 0 : full-file regexp include-directories))))
818 0 : (when (and include-directories
819 0 : (string-match regexp leaf))
820 0 : (setq result (nconc result (list full-file)))))
821 0 : (when (string-match regexp file)
822 0 : (push (expand-file-name file dir) files)))))
823 0 : (nconc result (nreverse files))))
824 :
825 : (defvar module-file-suffix)
826 :
827 : (defun load-file (file)
828 : "Load the Lisp file named FILE."
829 : ;; This is a case where .elc and .so/.dll make a lot of sense.
830 0 : (interactive (list (let ((completion-ignored-extensions
831 0 : (remove module-file-suffix
832 0 : (remove ".elc"
833 0 : completion-ignored-extensions))))
834 0 : (read-file-name "Load file: " nil nil 'lambda))))
835 0 : (load (expand-file-name file) nil nil t))
836 :
837 : (defun locate-file (filename path &optional suffixes predicate)
838 : "Search for FILENAME through PATH.
839 : If found, return the absolute file name of FILENAME; otherwise
840 : return nil.
841 : PATH should be a list of directories to look in, like the lists in
842 : `exec-path' or `load-path'.
843 : If SUFFIXES is non-nil, it should be a list of suffixes to append to
844 : file name when searching. If SUFFIXES is nil, it is equivalent to (\"\").
845 : Use (\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
846 : If non-nil, PREDICATE is used instead of `file-readable-p'.
847 :
848 : This function will normally skip directories, so if you want it to find
849 : directories, make sure the PREDICATE function returns `dir-ok' for them.
850 :
851 : PREDICATE can also be an integer to pass to the `access' system call,
852 : in which case file-name handlers are ignored. This usage is deprecated.
853 : For compatibility, PREDICATE can also be one of the symbols
854 : `executable', `readable', `writable', or `exists', or a list of
855 : one or more of those symbols."
856 154 : (if (and predicate (symbolp predicate) (not (functionp predicate)))
857 154 : (setq predicate (list predicate)))
858 154 : (when (and (consp predicate) (not (functionp predicate)))
859 0 : (setq predicate
860 0 : (logior (if (memq 'executable predicate) 1 0)
861 0 : (if (memq 'writable predicate) 2 0)
862 154 : (if (memq 'readable predicate) 4 0))))
863 154 : (locate-file-internal filename path suffixes predicate))
864 :
865 : (defun locate-file-completion-table (dirs suffixes string pred action)
866 : "Do completion for file names passed to `locate-file'."
867 0 : (cond
868 0 : ((file-name-absolute-p string)
869 : ;; FIXME: maybe we should use completion-file-name-table instead,
870 : ;; tho at least for `load', the arg is passed through
871 : ;; substitute-in-file-name for historical reasons.
872 0 : (read-file-name-internal string pred action))
873 0 : ((eq (car-safe action) 'boundaries)
874 0 : (let ((suffix (cdr action)))
875 0 : `(boundaries
876 0 : ,(length (file-name-directory string))
877 0 : ,@(let ((x (file-name-directory suffix)))
878 0 : (if x (1- (length x)) (length suffix))))))
879 : (t
880 0 : (let ((names '())
881 : ;; If we have files like "foo.el" and "foo.elc", we could load one of
882 : ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
883 : ;; preferred way. So if we list all 3, that gives a lot of redundant
884 : ;; entries for the poor soul looking just for "foo". OTOH, sometimes
885 : ;; the user does want to pay attention to the extension. We try to
886 : ;; diffuse this tension by stripping the suffix, except when the
887 : ;; result is a single element (i.e. usually we only list "foo" unless
888 : ;; it's the only remaining element in the list, in which case we do
889 : ;; list "foo", "foo.elc" and "foo.el").
890 : (fullnames '())
891 0 : (suffix (concat (regexp-opt suffixes t) "\\'"))
892 0 : (string-dir (file-name-directory string))
893 0 : (string-file (file-name-nondirectory string)))
894 0 : (dolist (dir dirs)
895 0 : (unless dir
896 0 : (setq dir default-directory))
897 0 : (if string-dir (setq dir (expand-file-name string-dir dir)))
898 0 : (when (file-directory-p dir)
899 0 : (dolist (file (file-name-all-completions
900 0 : string-file dir))
901 0 : (if (not (string-match suffix file))
902 0 : (push file names)
903 0 : (push file fullnames)
904 0 : (push (substring file 0 (match-beginning 0)) names)))))
905 : ;; Switching from names to names+fullnames creates a non-monotonicity
906 : ;; which can cause problems with things like partial-completion.
907 : ;; To minimize the problem, filter out completion-regexp-list, so that
908 : ;; M-x load-library RET t/x.e TAB finds some files. Also remove elements
909 : ;; from `names' which only matched `string' when they still had
910 : ;; their suffix.
911 0 : (setq names (all-completions string names))
912 : ;; Remove duplicates of the first element, so that we can easily check
913 : ;; if `names' really only contains a single element.
914 0 : (when (cdr names) (setcdr names (delete (car names) (cdr names))))
915 0 : (unless (cdr names)
916 : ;; There's no more than one matching non-suffixed element, so expand
917 : ;; the list by adding the suffixed elements as well.
918 0 : (setq names (nconc names fullnames)))
919 0 : (completion-table-with-context
920 0 : string-dir names string-file pred action)))))
921 :
922 : (defun locate-file-completion (string path-and-suffixes action)
923 : "Do completion for file names passed to `locate-file'.
924 : PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
925 : (declare (obsolete locate-file-completion-table "23.1"))
926 0 : (locate-file-completion-table (car path-and-suffixes)
927 0 : (cdr path-and-suffixes)
928 0 : string nil action))
929 :
930 : (defvar locate-dominating-stop-dir-regexp
931 : (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
932 : "Regexp of directory names which stop the search in `locate-dominating-file'.
933 : Any directory whose name matches this regexp will be treated like
934 : a kind of root directory by `locate-dominating-file' which will stop its search
935 : when it bumps into it.
936 : The default regexp prevents fruitless and time-consuming attempts to find
937 : special files in directories in which filenames are interpreted as hostnames,
938 : or mount points potentially requiring authentication as a different user.")
939 :
940 : ;; (defun locate-dominating-files (file regexp)
941 : ;; "Look up the directory hierarchy from FILE for a file matching REGEXP.
942 : ;; Stop at the first parent where a matching file is found and return the list
943 : ;; of files that that match in this directory."
944 : ;; (catch 'found
945 : ;; ;; `user' is not initialized yet because `file' may not exist, so we may
946 : ;; ;; have to walk up part of the hierarchy before we find the "initial UID".
947 : ;; (let ((user nil)
948 : ;; ;; Abbreviate, so as to stop when we cross ~/.
949 : ;; (dir (abbreviate-file-name (file-name-as-directory file)))
950 : ;; files)
951 : ;; (while (and dir
952 : ;; ;; As a heuristic, we stop looking up the hierarchy of
953 : ;; ;; directories as soon as we find a directory belonging to
954 : ;; ;; another user. This should save us from looking in
955 : ;; ;; things like /net and /afs. This assumes that all the
956 : ;; ;; files inside a project belong to the same user.
957 : ;; (let ((prev-user user))
958 : ;; (setq user (nth 2 (file-attributes dir)))
959 : ;; (or (null prev-user) (equal user prev-user))))
960 : ;; (if (setq files (condition-case nil
961 : ;; (directory-files dir 'full regexp 'nosort)
962 : ;; (error nil)))
963 : ;; (throw 'found files)
964 : ;; (if (equal dir
965 : ;; (setq dir (file-name-directory
966 : ;; (directory-file-name dir))))
967 : ;; (setq dir nil))))
968 : ;; nil)))
969 :
970 : (defun locate-dominating-file (file name)
971 : "Starting from FILE, look up directory hierarchy for directory containing NAME.
972 : FILE can be a file or a directory. If it's a file, its directory will
973 : serve as the starting point for searching the hierarchy of directories.
974 : Stop at the first parent directory containing a file NAME,
975 : and return the directory. Return nil if not found.
976 : Instead of a string, NAME can also be a predicate taking one argument
977 : \(a directory) and returning a non-nil value if that directory is the one for
978 : which we're looking. The predicate will be called with every file/directory
979 : the function needs to examine, starting with FILE."
980 : ;; We used to use the above locate-dominating-files code, but the
981 : ;; directory-files call is very costly, so we're much better off doing
982 : ;; multiple calls using the code in here.
983 : ;;
984 : ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
985 : ;; `name' in /home or in /.
986 722 : (setq file (abbreviate-file-name (expand-file-name file)))
987 722 : (let ((root nil)
988 : ;; `user' is not initialized outside the loop because
989 : ;; `file' may not exist, so we may have to walk up part of the
990 : ;; hierarchy before we find the "initial UID". Note: currently unused
991 : ;; (user nil)
992 : try)
993 4780 : (while (not (or root
994 4483 : (null file)
995 : ;; FIXME: Disabled this heuristic because it is sometimes
996 : ;; inappropriate.
997 : ;; As a heuristic, we stop looking up the hierarchy of
998 : ;; directories as soon as we find a directory belonging
999 : ;; to another user. This should save us from looking in
1000 : ;; things like /net and /afs. This assumes that all the
1001 : ;; files inside a project belong to the same user.
1002 : ;; (let ((prev-user user))
1003 : ;; (setq user (nth 2 (file-attributes file)))
1004 : ;; (and prev-user (not (equal user prev-user))))
1005 4780 : (string-match locate-dominating-stop-dir-regexp file)))
1006 4058 : (setq try (if (stringp name)
1007 3666 : (file-exists-p (expand-file-name name file))
1008 4058 : (funcall name file)))
1009 4058 : (cond (try (setq root file))
1010 3761 : ((equal file (setq file (file-name-directory
1011 3761 : (directory-file-name file))))
1012 4058 : (setq file nil))))
1013 722 : (if root (file-name-as-directory root))))
1014 :
1015 : (defcustom user-emacs-directory-warning t
1016 : "Non-nil means warn if cannot access `user-emacs-directory'.
1017 : Set this to nil at your own risk..."
1018 : :type 'boolean
1019 : :group 'initialization
1020 : :version "24.4")
1021 :
1022 : (defun locate-user-emacs-file (new-name &optional old-name)
1023 : "Return an absolute per-user Emacs-specific file name.
1024 : If NEW-NAME exists in `user-emacs-directory', return it.
1025 : Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
1026 : Else return NEW-NAME in `user-emacs-directory', creating the
1027 : directory if it does not exist."
1028 1 : (convert-standard-filename
1029 1 : (let* ((home (concat "~" (or init-file-user "")))
1030 1 : (at-home (and old-name (expand-file-name old-name home)))
1031 1 : (bestname (abbreviate-file-name
1032 1 : (expand-file-name new-name user-emacs-directory))))
1033 1 : (if (and at-home (not (file-readable-p bestname))
1034 1 : (file-readable-p at-home))
1035 0 : at-home
1036 : ;; Make sure `user-emacs-directory' exists,
1037 : ;; unless we're in batch mode or dumping Emacs.
1038 1 : (or noninteractive
1039 0 : purify-flag
1040 0 : (let (errtype)
1041 0 : (if (file-directory-p user-emacs-directory)
1042 0 : (or (file-accessible-directory-p user-emacs-directory)
1043 0 : (setq errtype "access"))
1044 0 : (with-file-modes ?\700
1045 0 : (condition-case nil
1046 0 : (make-directory user-emacs-directory)
1047 0 : (error (setq errtype "create")))))
1048 0 : (when (and errtype
1049 0 : user-emacs-directory-warning
1050 0 : (not (get 'user-emacs-directory-warning 'this-session)))
1051 : ;; Only warn once per Emacs session.
1052 0 : (put 'user-emacs-directory-warning 'this-session t)
1053 0 : (display-warning 'initialization
1054 0 : (format "\
1055 : Unable to %s `user-emacs-directory' (%s).
1056 : Any data that would normally be written there may be lost!
1057 : If you never want to see this message again,
1058 : customize the variable `user-emacs-directory-warning'."
1059 1 : errtype user-emacs-directory)))))
1060 1 : bestname))))
1061 :
1062 :
1063 : (defun executable-find (command)
1064 : "Search for COMMAND in `exec-path' and return the absolute file name.
1065 : Return nil if COMMAND is not found anywhere in `exec-path'."
1066 : ;; Use 1 rather than file-executable-p to better match the behavior of
1067 : ;; call-process.
1068 2 : (locate-file command exec-path exec-suffixes 1))
1069 :
1070 : (defun load-library (library)
1071 : "Load the Emacs Lisp library named LIBRARY.
1072 : LIBRARY should be a string.
1073 : This is an interface to the function `load'. LIBRARY is searched
1074 : for in `load-path', both with and without `load-suffixes' (as
1075 : well as `load-file-rep-suffixes').
1076 :
1077 : See Info node `(emacs)Lisp Libraries' for more details.
1078 : See `load-file' for a different interface to `load'."
1079 : (interactive
1080 0 : (let (completion-ignored-extensions)
1081 0 : (list (completing-read "Load library: "
1082 0 : (apply-partially 'locate-file-completion-table
1083 0 : load-path
1084 0 : (get-load-suffixes))))))
1085 0 : (load library))
1086 :
1087 : (defun file-remote-p (file &optional identification connected)
1088 : "Test whether FILE specifies a location on a remote system.
1089 : A file is considered remote if accessing it is likely to
1090 : be slower or less reliable than accessing local files.
1091 :
1092 : `file-remote-p' never opens a new remote connection. It can
1093 : only reuse a connection that is already open.
1094 :
1095 : Return nil or a string identifying the remote connection
1096 : \(ideally a prefix of FILE). Return nil if FILE is a relative
1097 : file name.
1098 :
1099 : When IDENTIFICATION is nil, the returned string is a complete
1100 : remote identifier: with components method, user, and host. The
1101 : components are those present in FILE, with defaults filled in for
1102 : any that are missing.
1103 :
1104 : IDENTIFICATION can specify which part of the identification to
1105 : return. IDENTIFICATION can be the symbol `method', `user',
1106 : `host', or `localname'. Any other value is handled like nil and
1107 : means to return the complete identification. The string returned
1108 : for IDENTIFICATION `localname' can differ depending on whether
1109 : there is an existing connection.
1110 :
1111 : If CONNECTED is non-nil, return an identification only if FILE is
1112 : located on a remote system and a connection is established to
1113 : that remote system.
1114 :
1115 : Tip: You can use this expansion of remote identifier components
1116 : to derive a new remote file name from an existing one. For
1117 : example, if FILE is \"/sudo::/path/to/file\" then
1118 :
1119 : (concat (file-remote-p FILE) \"/bin/sh\")
1120 :
1121 : returns a remote file name for file \"/bin/sh\" that has the
1122 : same remote identifier as FILE but expanded; a name such as
1123 : \"/sudo:root@myhost:/bin/sh\"."
1124 244218 : (let ((handler (find-file-name-handler file 'file-remote-p)))
1125 244218 : (if handler
1126 15918 : (funcall handler 'file-remote-p file identification connected)
1127 244218 : nil)))
1128 :
1129 : ;; Probably this entire variable should be obsolete now, in favor of
1130 : ;; something Tramp-related (?). It is not used in many places.
1131 : ;; It's not clear what the best file for this to be in is, but given
1132 : ;; it uses custom-initialize-delay, it is easier if it is preloaded
1133 : ;; rather than autoloaded.
1134 : (defcustom remote-shell-program
1135 : ;; This used to try various hard-coded places for remsh, rsh, and
1136 : ;; rcmd, trying to guess based on location whether "rsh" was
1137 : ;; "restricted shell" or "remote shell", but I don't see the point
1138 : ;; in this day and age. Almost everyone will use ssh, and have
1139 : ;; whatever command they want to use in PATH.
1140 : (purecopy
1141 : (let ((list '("ssh" "remsh" "rcmd" "rsh")))
1142 : (while (and list
1143 : (not (executable-find (car list)))
1144 : (setq list (cdr list))))
1145 : (or (car list) "ssh")))
1146 : "Program to use to execute commands on a remote host (e.g. ssh or rsh)."
1147 : :version "24.3" ; ssh rather than rsh, etc
1148 : :initialize 'custom-initialize-delay
1149 : :group 'environment
1150 : :type 'file)
1151 :
1152 : (defcustom remote-file-name-inhibit-cache 10
1153 : "Whether to use the remote file-name cache for read access.
1154 : When nil, never expire cached values (caution)
1155 : When t, never use the cache (safe, but may be slow)
1156 : A number means use cached values for that amount of seconds since caching.
1157 :
1158 : The attributes of remote files are cached for better performance.
1159 : If they are changed outside of Emacs's control, the cached values
1160 : become invalid, and must be reread. If you are sure that nothing
1161 : other than Emacs changes the files, you can set this variable to nil.
1162 :
1163 : If a remote file is checked regularly, it might be a good idea to
1164 : let-bind this variable to a value less than the interval between
1165 : consecutive checks. For example:
1166 :
1167 : (defun display-time-file-nonempty-p (file)
1168 : (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
1169 : (and (file-exists-p file)
1170 : (< 0 (nth 7 (file-attributes (file-chase-links file)))))))"
1171 : :group 'files
1172 : :version "24.1"
1173 : :type `(choice
1174 : (const :tag "Do not inhibit file name cache" nil)
1175 : (const :tag "Do not use file name cache" t)
1176 : (integer :tag "Do not use file name cache"
1177 : :format "Do not use file name cache older then %v seconds"
1178 : :value 10)))
1179 :
1180 : (defun file-local-name (file)
1181 : "Return the local name component of FILE.
1182 : It returns a file name which can be used directly as argument of
1183 : `process-file', `start-file-process', or `shell-command'."
1184 159941 : (or (file-remote-p file 'localname) file))
1185 :
1186 : (defun file-local-copy (file)
1187 : "Copy the file FILE into a temporary file on this machine.
1188 : Returns the name of the local copy, or nil, if FILE is directly
1189 : accessible."
1190 : ;; This formerly had an optional BUFFER argument that wasn't used by
1191 : ;; anything.
1192 270 : (let ((handler (find-file-name-handler file 'file-local-copy)))
1193 270 : (if handler
1194 270 : (funcall handler 'file-local-copy file)
1195 270 : nil)))
1196 :
1197 : (defun file-truename (filename &optional counter prev-dirs)
1198 : "Return the truename of FILENAME.
1199 : If FILENAME is not absolute, first expands it against `default-directory'.
1200 : The truename of a file name is found by chasing symbolic links
1201 : both at the level of the file and at the level of the directories
1202 : containing it, until no links are left at any level.
1203 :
1204 : \(fn FILENAME)" ;; Don't document the optional arguments.
1205 : ;; COUNTER and PREV-DIRS are only used in recursive calls.
1206 : ;; COUNTER can be a cons cell whose car is the count of how many
1207 : ;; more links to chase before getting an error.
1208 : ;; PREV-DIRS can be a cons cell whose car is an alist
1209 : ;; of truenames we've just recently computed.
1210 6727 : (cond ((or (string= filename "") (string= filename "~"))
1211 0 : (setq filename (expand-file-name filename))
1212 0 : (if (string= filename "")
1213 0 : (setq filename "/")))
1214 6727 : ((and (string= (substring filename 0 1) "~")
1215 6727 : (string-match "~[^/]*/?" filename))
1216 11 : (let ((first-part
1217 11 : (substring filename 0 (match-end 0)))
1218 11 : (rest (substring filename (match-end 0))))
1219 6727 : (setq filename (concat (expand-file-name first-part) rest)))))
1220 :
1221 6727 : (or counter (setq counter (list 100)))
1222 6727 : (let (done
1223 : ;; For speed, remove the ange-ftp completion handler from the list.
1224 : ;; We know it's not needed here.
1225 : ;; For even more speed, do this only on the outermost call.
1226 : (file-name-handler-alist
1227 6727 : (if prev-dirs file-name-handler-alist
1228 2378 : (let ((tem (copy-sequence file-name-handler-alist)))
1229 6727 : (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
1230 6727 : (or prev-dirs (setq prev-dirs (list nil)))
1231 :
1232 : ;; andrewi@harlequin.co.uk - on Windows, there is an issue with
1233 : ;; case differences being ignored by the OS, and short "8.3 DOS"
1234 : ;; name aliases existing for all files. (The short names are not
1235 : ;; reported by directory-files, but can be used to refer to files.)
1236 : ;; It seems appropriate for file-truename to resolve these issues in
1237 : ;; the most natural way, which on Windows is to call the function
1238 : ;; `w32-long-file-name' - this returns the exact name of a file as
1239 : ;; it is stored on disk (expanding short name aliases with the full
1240 : ;; name in the process).
1241 6727 : (if (eq system-type 'windows-nt)
1242 0 : (unless (string-match "[[*?]" filename)
1243 : ;; If filename exists, use its long name. If it doesn't
1244 : ;; exist, the recursion below on the directory of filename
1245 : ;; will drill down until we find a directory that exists,
1246 : ;; and use the long name of that, with the extra
1247 : ;; non-existent path components concatenated.
1248 0 : (let ((longname (w32-long-file-name filename)))
1249 0 : (if longname
1250 6727 : (setq filename longname)))))
1251 :
1252 : ;; If this file directly leads to a link, process that iteratively
1253 : ;; so that we don't use lots of stack.
1254 13454 : (while (not done)
1255 6727 : (setcar counter (1- (car counter)))
1256 6727 : (if (< (car counter) 0)
1257 6727 : (error "Apparent cycle of symbolic links for %s" filename))
1258 6727 : (let ((handler (find-file-name-handler filename 'file-truename)))
1259 : ;; For file name that has a special handler, call handler.
1260 : ;; This is so that ange-ftp can save time by doing a no-op.
1261 6727 : (if handler
1262 1543 : (setq filename (funcall handler 'file-truename filename)
1263 1543 : done t)
1264 5184 : (let ((dir (or (file-name-directory filename) default-directory))
1265 : target dirfile)
1266 : ;; Get the truename of the directory.
1267 5184 : (setq dirfile (directory-file-name dir))
1268 : ;; If these are equal, we have the (or a) root directory.
1269 5184 : (or (string= dir dirfile)
1270 4349 : (and (file-name-case-insensitive-p dir)
1271 4349 : (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
1272 : ;; If this is the same dir we last got the truename for,
1273 : ;; save time--don't recalculate.
1274 4349 : (if (assoc dir (car prev-dirs))
1275 0 : (setq dir (cdr (assoc dir (car prev-dirs))))
1276 4349 : (let ((old dir)
1277 4349 : (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
1278 4349 : (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
1279 5184 : (setq dir new))))
1280 5184 : (if (equal ".." (file-name-nondirectory filename))
1281 0 : (setq filename
1282 0 : (directory-file-name (file-name-directory (directory-file-name dir)))
1283 0 : done t)
1284 5184 : (if (equal "." (file-name-nondirectory filename))
1285 0 : (setq filename (directory-file-name dir)
1286 0 : done t)
1287 : ;; Put it back on the file name.
1288 5184 : (setq filename (concat dir (file-name-nondirectory filename)))
1289 : ;; Is the file name the name of a link?
1290 5184 : (setq target (file-symlink-p filename))
1291 5184 : (if target
1292 : ;; Yes => chase that link, then start all over
1293 : ;; since the link may point to a directory name that uses links.
1294 : ;; We can't safely use expand-file-name here
1295 : ;; since target might look like foo/../bar where foo
1296 : ;; is itself a link. Instead, we handle . and .. above.
1297 0 : (setq filename
1298 0 : (if (file-name-absolute-p target)
1299 0 : target
1300 0 : (concat dir target))
1301 0 : done nil)
1302 : ;; No, we are done!
1303 6727 : (setq done t))))))))
1304 6727 : filename))
1305 :
1306 : (defun file-chase-links (filename &optional limit)
1307 : "Chase links in FILENAME until a name that is not a link.
1308 : Unlike `file-truename', this does not check whether a parent
1309 : directory name is a symbolic link.
1310 : If the optional argument LIMIT is a number,
1311 : it means chase no more than that many links and then stop."
1312 0 : (let (tem (newname filename)
1313 : (count 0))
1314 0 : (while (and (or (null limit) (< count limit))
1315 0 : (setq tem (file-symlink-p newname)))
1316 0 : (save-match-data
1317 0 : (if (and (null limit) (= count 100))
1318 0 : (error "Apparent cycle of symbolic links for %s" filename))
1319 : ;; In the context of a link, `//' doesn't mean what Emacs thinks.
1320 0 : (while (string-match "//+" tem)
1321 0 : (setq tem (replace-match "/" nil nil tem)))
1322 : ;; Handle `..' by hand, since it needs to work in the
1323 : ;; target of any directory symlink.
1324 : ;; This code is not quite complete; it does not handle
1325 : ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
1326 0 : (while (string-match "\\`\\.\\./" tem)
1327 0 : (setq tem (substring tem 3))
1328 0 : (setq newname (expand-file-name newname))
1329 : ;; Chase links in the default dir of the symlink.
1330 0 : (setq newname
1331 0 : (file-chase-links
1332 0 : (directory-file-name (file-name-directory newname))))
1333 : ;; Now find the parent of that dir.
1334 0 : (setq newname (file-name-directory newname)))
1335 0 : (setq newname (expand-file-name tem (file-name-directory newname)))
1336 0 : (setq count (1+ count))))
1337 0 : newname))
1338 :
1339 : ;; A handy function to display file sizes in human-readable form.
1340 : ;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
1341 : (defun file-size-human-readable (file-size &optional flavor)
1342 : "Produce a string showing FILE-SIZE in human-readable form.
1343 :
1344 : Optional second argument FLAVOR controls the units and the display format:
1345 :
1346 : If FLAVOR is nil or omitted, each kilobyte is 1024 bytes and the produced
1347 : suffixes are \"k\", \"M\", \"G\", \"T\", etc.
1348 : If FLAVOR is `si', each kilobyte is 1000 bytes and the produced suffixes
1349 : are \"k\", \"M\", \"G\", \"T\", etc.
1350 : If FLAVOR is `iec', each kilobyte is 1024 bytes and the produced suffixes
1351 : are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc."
1352 0 : (let ((power (if (or (null flavor) (eq flavor 'iec))
1353 : 1024.0
1354 0 : 1000.0))
1355 : (post-fixes
1356 : ;; none, kilo, mega, giga, tera, peta, exa, zetta, yotta
1357 0 : (list "" "k" "M" "G" "T" "P" "E" "Z" "Y")))
1358 0 : (while (and (>= file-size power) (cdr post-fixes))
1359 0 : (setq file-size (/ file-size power)
1360 0 : post-fixes (cdr post-fixes)))
1361 0 : (format (if (> (mod file-size 1.0) 0.05)
1362 : "%.1f%s%s"
1363 0 : "%.0f%s%s")
1364 0 : file-size
1365 0 : (if (and (eq flavor 'iec) (string= (car post-fixes) "k"))
1366 : "K"
1367 0 : (car post-fixes))
1368 0 : (if (eq flavor 'iec) "iB" ""))))
1369 :
1370 : (defcustom mounted-file-systems
1371 : (if (memq system-type '(windows-nt cygwin))
1372 : "^//[^/]+/"
1373 : ;; regexp-opt.el is not dumped into emacs binary.
1374 : ;;(concat
1375 : ;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
1376 : "^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
1377 : "File systems which ought to be mounted."
1378 : :group 'files
1379 : :version "26.1"
1380 : :require 'regexp-opt
1381 : :type 'regexp)
1382 :
1383 : (defun temporary-file-directory ()
1384 : "The directory for writing temporary files.
1385 : In case of a remote `default-directory', this is a directory for
1386 : temporary files on that remote host. If such a directory does
1387 : not exist, or `default-directory' ought to be located on a
1388 : mounted file system (see `mounted-file-systems'), the function
1389 : returns `default-directory'.
1390 : For a non-remote and non-mounted `default-directory', the value of
1391 : the variable `temporary-file-directory' is returned."
1392 4 : (let ((handler (find-file-name-handler
1393 4 : default-directory 'temporary-file-directory)))
1394 4 : (if handler
1395 4 : (funcall handler 'temporary-file-directory)
1396 0 : (if (string-match mounted-file-systems default-directory)
1397 0 : default-directory
1398 4 : temporary-file-directory))))
1399 :
1400 : (defun make-temp-file (prefix &optional dir-flag suffix text)
1401 : "Create a temporary file.
1402 : The returned file name (created by appending some random characters at the end
1403 : of PREFIX, and expanding against `temporary-file-directory' if necessary),
1404 : is guaranteed to point to a newly created file.
1405 : You can then use `write-region' to write new data into the file.
1406 :
1407 : If DIR-FLAG is non-nil, create a new empty directory instead of a file.
1408 :
1409 : If SUFFIX is non-nil, add that at the end of the file name.
1410 :
1411 : If TEXT is a string, insert it into the new file; DIR-FLAG should be nil.
1412 : Otherwise the file will be empty."
1413 677 : (let ((absolute-prefix
1414 677 : (if (or (zerop (length prefix)) (member prefix '("." "..")))
1415 0 : (concat (file-name-as-directory temporary-file-directory) prefix)
1416 677 : (expand-file-name prefix temporary-file-directory))))
1417 677 : (if (find-file-name-handler absolute-prefix 'write-region)
1418 2 : (files--make-magic-temp-file absolute-prefix dir-flag suffix text)
1419 675 : (make-temp-file-internal absolute-prefix
1420 677 : (if dir-flag t) (or suffix "") text))))
1421 :
1422 : (defun files--make-magic-temp-file (absolute-prefix
1423 : &optional dir-flag suffix text)
1424 : "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX TEXT).
1425 : This implementation works on magic file names."
1426 : ;; Create temp files with strict access rights. It's easy to
1427 : ;; loosen them later, whereas it's impossible to close the
1428 : ;; time-window of loose permissions otherwise.
1429 2 : (with-file-modes ?\700
1430 2 : (let ((contents (if (stringp text) text ""))
1431 : file)
1432 2 : (while (condition-case ()
1433 2 : (progn
1434 2 : (setq file (make-temp-name absolute-prefix))
1435 2 : (if suffix
1436 2 : (setq file (concat file suffix)))
1437 2 : (if dir-flag
1438 1 : (make-directory file)
1439 2 : (write-region contents nil file nil 'silent nil 'excl))
1440 2 : nil)
1441 2 : (file-already-exists t))
1442 : ;; the file was somehow created by someone else between
1443 : ;; `make-temp-name' and `write-region', let's try again.
1444 2 : nil)
1445 2 : file)))
1446 :
1447 : (defun make-nearby-temp-file (prefix &optional dir-flag suffix)
1448 : "Create a temporary file as close as possible to `default-directory'.
1449 : If PREFIX is a relative file name, and `default-directory' is a
1450 : remote file name or located on a mounted file systems, the
1451 : temporary file is created in the directory returned by the
1452 : function `temporary-file-directory'. Otherwise, the function
1453 : `make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
1454 : same meaning as in `make-temp-file'."
1455 2 : (let ((handler (find-file-name-handler
1456 2 : default-directory 'make-nearby-temp-file)))
1457 2 : (if (and handler (not (file-name-absolute-p default-directory)))
1458 0 : (funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
1459 2 : (let ((temporary-file-directory (temporary-file-directory)))
1460 2 : (make-temp-file prefix dir-flag suffix)))))
1461 :
1462 : (defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
1463 : "Change the encoding of FILE's name from CODING to NEW-CODING.
1464 : The value is a new name of FILE.
1465 : Signals a `file-already-exists' error if a file of the new name
1466 : already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
1467 : is non-nil. A number as fourth arg means request confirmation if
1468 : the new name already exists. This is what happens in interactive
1469 : use with M-x."
1470 : (interactive
1471 0 : (let ((default-coding (or file-name-coding-system
1472 0 : default-file-name-coding-system))
1473 0 : (filename (read-file-name "Recode filename: " nil nil t))
1474 : from-coding to-coding)
1475 0 : (if (and default-coding
1476 : ;; We provide the default coding only when it seems that
1477 : ;; the filename is correctly decoded by the default
1478 : ;; coding.
1479 0 : (let ((charsets (find-charset-string filename)))
1480 0 : (and (not (memq 'eight-bit-control charsets))
1481 0 : (not (memq 'eight-bit-graphic charsets)))))
1482 0 : (setq from-coding (read-coding-system
1483 0 : (format "Recode filename %s from (default %s): "
1484 0 : filename default-coding)
1485 0 : default-coding))
1486 0 : (setq from-coding (read-coding-system
1487 0 : (format "Recode filename %s from: " filename))))
1488 :
1489 : ;; We provide the default coding only when a user is going to
1490 : ;; change the encoding not from the default coding.
1491 0 : (if (eq from-coding default-coding)
1492 0 : (setq to-coding (read-coding-system
1493 0 : (format "Recode filename %s from %s to: "
1494 0 : filename from-coding)))
1495 0 : (setq to-coding (read-coding-system
1496 0 : (format "Recode filename %s from %s to (default %s): "
1497 0 : filename from-coding default-coding)
1498 0 : default-coding)))
1499 0 : (list filename from-coding to-coding)))
1500 :
1501 0 : (let* ((default-coding (or file-name-coding-system
1502 0 : default-file-name-coding-system))
1503 : ;; FILE should have been decoded by DEFAULT-CODING.
1504 0 : (encoded (encode-coding-string file default-coding))
1505 0 : (newname (decode-coding-string encoded coding))
1506 0 : (new-encoded (encode-coding-string newname new-coding))
1507 : ;; Suppress further encoding.
1508 : (file-name-coding-system nil)
1509 : (default-file-name-coding-system nil)
1510 : (locale-coding-system nil))
1511 0 : (rename-file encoded new-encoded ok-if-already-exists)
1512 0 : newname))
1513 :
1514 : (defcustom confirm-nonexistent-file-or-buffer 'after-completion
1515 : "Whether confirmation is requested before visiting a new file or buffer.
1516 : If nil, confirmation is not requested.
1517 : If the value is `after-completion', confirmation is only
1518 : requested if the user called `minibuffer-complete' right before
1519 : `minibuffer-complete-and-exit'.
1520 : Any other non-nil value means to request confirmation.
1521 :
1522 : This affects commands like `switch-to-buffer' and `find-file'."
1523 : :group 'find-file
1524 : :version "23.1"
1525 : :type '(choice (const :tag "After completion" after-completion)
1526 : (const :tag "Never" nil)
1527 : (other :tag "Always" t)))
1528 :
1529 : (defun confirm-nonexistent-file-or-buffer ()
1530 : "Whether to request confirmation before visiting a new file or buffer.
1531 : The variable `confirm-nonexistent-file-or-buffer' determines the
1532 : return value, which may be passed as the REQUIRE-MATCH arg to
1533 : `read-buffer' or `find-file-read-args'."
1534 0 : (cond ((eq confirm-nonexistent-file-or-buffer 'after-completion)
1535 : 'confirm-after-completion)
1536 0 : (confirm-nonexistent-file-or-buffer
1537 : 'confirm)
1538 0 : (t nil)))
1539 :
1540 : (defmacro minibuffer-with-setup-hook (fun &rest body)
1541 : "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
1542 :
1543 : By default, FUN is prepended to `minibuffer-setup-hook'. But if FUN is of
1544 : the form `(:append FUN1)', FUN1 will be appended to `minibuffer-setup-hook'
1545 : instead of prepending it.
1546 :
1547 : BODY should use the minibuffer at most once.
1548 : Recursive uses of the minibuffer are unaffected (FUN is not
1549 : called additional times).
1550 :
1551 : This macro actually adds an auxiliary function that calls FUN,
1552 : rather than FUN itself, to `minibuffer-setup-hook'."
1553 : (declare (indent 1) (debug t))
1554 5 : (let ((hook (make-symbol "setup-hook"))
1555 5 : (funsym (make-symbol "fun"))
1556 : (append nil))
1557 5 : (when (eq (car-safe fun) :append)
1558 5 : (setq append '(t) fun (cadr fun)))
1559 5 : `(let ((,funsym ,fun)
1560 5 : ,hook)
1561 5 : (setq ,hook
1562 : (lambda ()
1563 : ;; Clear out this hook so it does not interfere
1564 : ;; with any recursive minibuffer usage.
1565 5 : (remove-hook 'minibuffer-setup-hook ,hook)
1566 5 : (funcall ,funsym)))
1567 : (unwind-protect
1568 : (progn
1569 5 : (add-hook 'minibuffer-setup-hook ,hook ,@append)
1570 5 : ,@body)
1571 5 : (remove-hook 'minibuffer-setup-hook ,hook)))))
1572 :
1573 : (defun find-file-read-args (prompt mustmatch)
1574 0 : (list (read-file-name prompt nil default-directory mustmatch)
1575 0 : t))
1576 :
1577 : (defun find-file (filename &optional wildcards)
1578 : "Edit file FILENAME.
1579 : Switch to a buffer visiting file FILENAME,
1580 : creating one if none already exists.
1581 : Interactively, the default if you just type RET is the current directory,
1582 : but the visited file name is available through the minibuffer history:
1583 : type M-n to pull it into the minibuffer.
1584 :
1585 : You can visit files on remote machines by specifying something
1586 : like /ssh:SOME_REMOTE_MACHINE:FILE for the file name. You can
1587 : also visit local files as a different user by specifying
1588 : /sudo::FILE for the file name.
1589 : See the Info node `(tramp)File name Syntax' in the Tramp Info
1590 : manual, for more about this.
1591 :
1592 : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1593 : expand wildcards (if any) and visit multiple files. You can
1594 : suppress wildcard expansion by setting `find-file-wildcards' to nil.
1595 :
1596 : To visit a file without any kind of conversion and without
1597 : automatically choosing a major mode, use \\[find-file-literally]."
1598 : (interactive
1599 0 : (find-file-read-args "Find file: "
1600 0 : (confirm-nonexistent-file-or-buffer)))
1601 148 : (let ((value (find-file-noselect filename nil nil wildcards)))
1602 148 : (if (listp value)
1603 0 : (mapcar 'pop-to-buffer-same-window (nreverse value))
1604 148 : (pop-to-buffer-same-window value))))
1605 :
1606 : (defun find-file-other-window (filename &optional wildcards)
1607 : "Edit file FILENAME, in another window.
1608 :
1609 : Like \\[find-file] (which see), but creates a new window or reuses
1610 : an existing one. See the function `display-buffer'.
1611 :
1612 : Interactively, the default if you just type RET is the current directory,
1613 : but the visited file name is available through the minibuffer history:
1614 : type M-n to pull it into the minibuffer.
1615 :
1616 : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1617 : expand wildcards (if any) and visit multiple files."
1618 : (interactive
1619 0 : (find-file-read-args "Find file in other window: "
1620 0 : (confirm-nonexistent-file-or-buffer)))
1621 0 : (let ((value (find-file-noselect filename nil nil wildcards)))
1622 0 : (if (listp value)
1623 0 : (progn
1624 0 : (setq value (nreverse value))
1625 0 : (switch-to-buffer-other-window (car value))
1626 0 : (mapc 'switch-to-buffer (cdr value))
1627 0 : value)
1628 0 : (switch-to-buffer-other-window value))))
1629 :
1630 : (defun find-file-other-frame (filename &optional wildcards)
1631 : "Edit file FILENAME, in another frame.
1632 :
1633 : Like \\[find-file] (which see), but creates a new frame or reuses
1634 : an existing one. See the function `display-buffer'.
1635 :
1636 : Interactively, the default if you just type RET is the current directory,
1637 : but the visited file name is available through the minibuffer history:
1638 : type M-n to pull it into the minibuffer.
1639 :
1640 : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1641 : expand wildcards (if any) and visit multiple files."
1642 : (interactive
1643 0 : (find-file-read-args "Find file in other frame: "
1644 0 : (confirm-nonexistent-file-or-buffer)))
1645 0 : (let ((value (find-file-noselect filename nil nil wildcards)))
1646 0 : (if (listp value)
1647 0 : (progn
1648 0 : (setq value (nreverse value))
1649 0 : (switch-to-buffer-other-frame (car value))
1650 0 : (mapc 'switch-to-buffer (cdr value))
1651 0 : value)
1652 0 : (switch-to-buffer-other-frame value))))
1653 :
1654 : (defun find-file-existing (filename)
1655 : "Edit the existing file FILENAME.
1656 : Like \\[find-file], but only allow a file that exists, and do not allow
1657 : file names with wildcards."
1658 0 : (interactive (nbutlast (find-file-read-args "Find existing file: " t)))
1659 0 : (if (and (not (called-interactively-p 'interactive))
1660 0 : (not (file-exists-p filename)))
1661 0 : (error "%s does not exist" filename)
1662 0 : (find-file filename)
1663 0 : (current-buffer)))
1664 :
1665 : (defun find-file--read-only (fun filename wildcards)
1666 0 : (unless (or (and wildcards find-file-wildcards
1667 0 : (not (file-name-quoted-p filename))
1668 0 : (string-match "[[*?]" filename))
1669 0 : (file-exists-p filename))
1670 0 : (error "%s does not exist" filename))
1671 0 : (let ((value (funcall fun filename wildcards)))
1672 0 : (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
1673 0 : (if (listp value) value (list value)))
1674 0 : value))
1675 :
1676 : (defun find-file-read-only (filename &optional wildcards)
1677 : "Edit file FILENAME but don't allow changes.
1678 : Like \\[find-file], but marks buffer as read-only.
1679 : Use \\[read-only-mode] to permit editing."
1680 : (interactive
1681 0 : (find-file-read-args "Find file read-only: "
1682 0 : (confirm-nonexistent-file-or-buffer)))
1683 0 : (find-file--read-only #'find-file filename wildcards))
1684 :
1685 : (defun find-file-read-only-other-window (filename &optional wildcards)
1686 : "Edit file FILENAME in another window but don't allow changes.
1687 : Like \\[find-file-other-window], but marks buffer as read-only.
1688 : Use \\[read-only-mode] to permit editing."
1689 : (interactive
1690 0 : (find-file-read-args "Find file read-only other window: "
1691 0 : (confirm-nonexistent-file-or-buffer)))
1692 0 : (find-file--read-only #'find-file-other-window filename wildcards))
1693 :
1694 : (defun find-file-read-only-other-frame (filename &optional wildcards)
1695 : "Edit file FILENAME in another frame but don't allow changes.
1696 : Like \\[find-file-other-frame], but marks buffer as read-only.
1697 : Use \\[read-only-mode] to permit editing."
1698 : (interactive
1699 0 : (find-file-read-args "Find file read-only other frame: "
1700 0 : (confirm-nonexistent-file-or-buffer)))
1701 0 : (find-file--read-only #'find-file-other-frame filename wildcards))
1702 :
1703 : (defun find-alternate-file-other-window (filename &optional wildcards)
1704 : "Find file FILENAME as a replacement for the file in the next window.
1705 : This command does not select that window.
1706 :
1707 : See \\[find-file] for the possible forms of the FILENAME argument.
1708 :
1709 : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1710 : expand wildcards (if any) and replace the file with multiple files."
1711 : (interactive
1712 0 : (save-selected-window
1713 0 : (other-window 1)
1714 0 : (let ((file buffer-file-name)
1715 : (file-name nil)
1716 : (file-dir nil))
1717 0 : (and file
1718 0 : (setq file-name (file-name-nondirectory file)
1719 0 : file-dir (file-name-directory file)))
1720 0 : (list (read-file-name
1721 0 : "Find alternate file: " file-dir nil
1722 0 : (confirm-nonexistent-file-or-buffer) file-name)
1723 0 : t))))
1724 0 : (if (one-window-p)
1725 0 : (find-file-other-window filename wildcards)
1726 0 : (save-selected-window
1727 0 : (other-window 1)
1728 0 : (find-alternate-file filename wildcards))))
1729 :
1730 : ;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
1731 : (defvar kill-buffer-hook nil
1732 : "Hook run when a buffer is killed.
1733 : The buffer being killed is current while the hook is running.
1734 : See `kill-buffer'.
1735 :
1736 : Note: Be careful with let-binding this hook considering it is
1737 : frequently used for cleanup.")
1738 :
1739 : (defun find-alternate-file (filename &optional wildcards)
1740 : "Find file FILENAME, select its buffer, kill previous buffer.
1741 : If the current buffer now contains an empty file that you just visited
1742 : \(presumably by mistake), use this command to visit the file you really want.
1743 :
1744 : See \\[find-file] for the possible forms of the FILENAME argument.
1745 :
1746 : Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1747 : expand wildcards (if any) and replace the file with multiple files.
1748 :
1749 : If the current buffer is an indirect buffer, or the base buffer
1750 : for one or more indirect buffers, the other buffer(s) are not
1751 : killed."
1752 : (interactive
1753 0 : (let ((file buffer-file-name)
1754 : (file-name nil)
1755 : (file-dir nil))
1756 0 : (and file
1757 0 : (setq file-name (file-name-nondirectory file)
1758 0 : file-dir (file-name-directory file)))
1759 0 : (list (read-file-name
1760 0 : "Find alternate file: " file-dir nil
1761 0 : (confirm-nonexistent-file-or-buffer) file-name)
1762 0 : t)))
1763 0 : (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
1764 0 : (user-error "Aborted"))
1765 0 : (and (buffer-modified-p) buffer-file-name
1766 0 : (not (yes-or-no-p
1767 0 : (format-message "Kill and replace buffer `%s' without saving it? "
1768 0 : (buffer-name))))
1769 0 : (user-error "Aborted"))
1770 0 : (let ((obuf (current-buffer))
1771 0 : (ofile buffer-file-name)
1772 0 : (onum buffer-file-number)
1773 0 : (odir dired-directory)
1774 0 : (otrue buffer-file-truename)
1775 0 : (oname (buffer-name)))
1776 : ;; Run `kill-buffer-hook' here. It needs to happen before
1777 : ;; variables like `buffer-file-name' etc are set to nil below,
1778 : ;; because some of the hooks that could be invoked
1779 : ;; (e.g., `save-place-to-alist') depend on those variables.
1780 : ;;
1781 : ;; Note that `kill-buffer-hook' is not what queries whether to
1782 : ;; save a modified buffer visiting a file. Rather, `kill-buffer'
1783 : ;; asks that itself. Thus, there's no need to temporarily do
1784 : ;; `(set-buffer-modified-p nil)' before running this hook.
1785 0 : (run-hooks 'kill-buffer-hook)
1786 : ;; Okay, now we can end-of-life the old buffer.
1787 0 : (if (get-buffer " **lose**")
1788 0 : (kill-buffer " **lose**"))
1789 0 : (rename-buffer " **lose**")
1790 0 : (unwind-protect
1791 0 : (progn
1792 0 : (unlock-buffer)
1793 : ;; This prevents us from finding the same buffer
1794 : ;; if we specified the same file again.
1795 0 : (setq buffer-file-name nil)
1796 0 : (setq buffer-file-number nil)
1797 0 : (setq buffer-file-truename nil)
1798 : ;; Likewise for dired buffers.
1799 0 : (setq dired-directory nil)
1800 0 : (find-file filename wildcards))
1801 0 : (when (eq obuf (current-buffer))
1802 : ;; This executes if find-file gets an error
1803 : ;; and does not really find anything.
1804 : ;; We put things back as they were.
1805 : ;; If find-file actually finds something, we kill obuf below.
1806 0 : (setq buffer-file-name ofile)
1807 0 : (setq buffer-file-number onum)
1808 0 : (setq buffer-file-truename otrue)
1809 0 : (setq dired-directory odir)
1810 0 : (lock-buffer)
1811 0 : (rename-buffer oname)))
1812 0 : (unless (eq (current-buffer) obuf)
1813 0 : (with-current-buffer obuf
1814 : ;; We already ran these; don't run them again.
1815 0 : (let (kill-buffer-query-functions kill-buffer-hook)
1816 0 : (kill-buffer obuf))))))
1817 :
1818 : ;; FIXME we really need to fold the uniquify stuff in here by default,
1819 : ;; not using advice, and add it to the doc string.
1820 : (defun create-file-buffer (filename)
1821 : "Create a suitably named buffer for visiting FILENAME, and return it.
1822 : FILENAME (sans directory) is used unchanged if that name is free;
1823 : otherwise a string <2> or <3> or ... is appended to get an unused name.
1824 :
1825 : Emacs treats buffers whose names begin with a space as internal buffers.
1826 : To avoid confusion when visiting a file whose name begins with a space,
1827 : this function prepends a \"|\" to the final result if necessary."
1828 154 : (let ((lastname (file-name-nondirectory filename)))
1829 154 : (if (string= lastname "")
1830 154 : (setq lastname filename))
1831 154 : (generate-new-buffer (if (string-match-p "\\` " lastname)
1832 0 : (concat "|" lastname)
1833 154 : lastname))))
1834 :
1835 : (defun generate-new-buffer (name)
1836 : "Create and return a buffer with a name based on NAME.
1837 : Choose the buffer's name using `generate-new-buffer-name'."
1838 1666 : (get-buffer-create (generate-new-buffer-name name)))
1839 :
1840 : (defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
1841 : "Regexp to match the automounter prefix in a directory name."
1842 : :group 'files
1843 : :type 'regexp)
1844 : (make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
1845 :
1846 : (defvar abbreviated-home-dir nil
1847 : "Regexp matching the user's homedir at the beginning of file name.
1848 : The value includes abbreviation according to `directory-abbrev-alist'.")
1849 :
1850 : (defun abbreviate-file-name (filename)
1851 : "Return a version of FILENAME shortened using `directory-abbrev-alist'.
1852 : This also substitutes \"~\" for the user's home directory (unless the
1853 : home directory is a root directory) and removes automounter prefixes
1854 : \(see the variable `automount-dir-prefix')."
1855 : ;; Get rid of the prefixes added by the automounter.
1856 1471 : (save-match-data
1857 1471 : (if (and automount-dir-prefix
1858 1471 : (string-match automount-dir-prefix filename)
1859 0 : (file-exists-p (file-name-directory
1860 1471 : (substring filename (1- (match-end 0))))))
1861 1471 : (setq filename (substring filename (1- (match-end 0)))))
1862 : ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
1863 1471 : (let ((case-fold-search (file-name-case-insensitive-p filename)))
1864 : ;; If any elt of directory-abbrev-alist matches this name,
1865 : ;; abbreviate accordingly.
1866 1471 : (dolist (dir-abbrev directory-abbrev-alist)
1867 0 : (if (string-match (car dir-abbrev) filename)
1868 0 : (setq filename
1869 0 : (concat (cdr dir-abbrev)
1870 1471 : (substring filename (match-end 0))))))
1871 : ;; Compute and save the abbreviated homedir name.
1872 : ;; We defer computing this until the first time it's needed, to
1873 : ;; give time for directory-abbrev-alist to be set properly.
1874 : ;; We include a slash at the end, to avoid spurious matches
1875 : ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
1876 1471 : (or abbreviated-home-dir
1877 0 : (setq abbreviated-home-dir
1878 0 : (let ((abbreviated-home-dir "$foo"))
1879 0 : (setq abbreviated-home-dir
1880 0 : (concat "\\`"
1881 0 : (abbreviate-file-name (expand-file-name "~"))
1882 0 : "\\(/\\|\\'\\)"))
1883 : ;; Depending on whether default-directory does or
1884 : ;; doesn't include non-ASCII characters, the value
1885 : ;; of abbreviated-home-dir could be multibyte or
1886 : ;; unibyte. In the latter case, we need to decode
1887 : ;; it. Note that this function is called for the
1888 : ;; first time (from startup.el) when
1889 : ;; locale-coding-system is already set up.
1890 0 : (if (multibyte-string-p abbreviated-home-dir)
1891 0 : abbreviated-home-dir
1892 0 : (decode-coding-string abbreviated-home-dir
1893 0 : (if (eq system-type 'windows-nt)
1894 : 'utf-8
1895 1471 : locale-coding-system))))))
1896 :
1897 : ;; If FILENAME starts with the abbreviated homedir,
1898 : ;; make it start with `~' instead.
1899 1471 : (if (and (string-match abbreviated-home-dir filename)
1900 : ;; If the home dir is just /, don't change it.
1901 1 : (not (and (= (match-end 0) 1)
1902 1 : (= (aref filename 0) ?/)))
1903 : ;; MS-DOS root directories can come with a drive letter;
1904 : ;; Novell Netware allows drive letters beyond `Z:'.
1905 1 : (not (and (memq system-type '(ms-dos windows-nt cygwin))
1906 0 : (save-match-data
1907 1471 : (string-match "^[a-zA-`]:/$" filename)))))
1908 1 : (setq filename
1909 1 : (concat "~"
1910 1 : (match-string 1 filename)
1911 1471 : (substring filename (match-end 0)))))
1912 1471 : filename)))
1913 :
1914 : (defun find-buffer-visiting (filename &optional predicate)
1915 : "Return the buffer visiting file FILENAME (a string).
1916 : This is like `get-file-buffer', except that it checks for any buffer
1917 : visiting the same file, possibly under a different name.
1918 : If PREDICATE is non-nil, only buffers satisfying it are eligible,
1919 : and others are ignored.
1920 : If there is no such live buffer, return nil."
1921 148 : (let ((predicate (or predicate #'identity))
1922 148 : (truename (abbreviate-file-name (file-truename filename))))
1923 148 : (or (let ((buf (get-file-buffer filename)))
1924 148 : (when (and buf (funcall predicate buf)) buf))
1925 148 : (let ((list (buffer-list)) found)
1926 17578 : (while (and (not found) list)
1927 17430 : (with-current-buffer (car list)
1928 17430 : (if (and buffer-file-name
1929 16650 : (string= buffer-file-truename truename)
1930 17430 : (funcall predicate (current-buffer)))
1931 17430 : (setq found (car list))))
1932 17430 : (setq list (cdr list)))
1933 148 : found)
1934 148 : (let* ((attributes (file-attributes truename))
1935 148 : (number (nthcdr 10 attributes))
1936 148 : (list (buffer-list)) found)
1937 148 : (and buffer-file-numbers-unique
1938 148 : (car-safe number) ;Make sure the inode is not just nil.
1939 17578 : (while (and (not found) list)
1940 17430 : (with-current-buffer (car list)
1941 17430 : (if (and buffer-file-name
1942 16650 : (equal buffer-file-number number)
1943 : ;; Verify this buffer's file number
1944 : ;; still belongs to its file.
1945 0 : (file-exists-p buffer-file-name)
1946 0 : (equal (file-attributes buffer-file-truename)
1947 0 : attributes)
1948 17430 : (funcall predicate (current-buffer)))
1949 17430 : (setq found (car list))))
1950 17430 : (setq list (cdr list))))
1951 148 : found))))
1952 :
1953 : (defcustom find-file-wildcards t
1954 : "Non-nil means file-visiting commands should handle wildcards.
1955 : For example, if you specify `*.c', that would visit all the files
1956 : whose names match the pattern."
1957 : :group 'files
1958 : :version "20.4"
1959 : :type 'boolean)
1960 :
1961 : (defcustom find-file-suppress-same-file-warnings nil
1962 : "Non-nil means suppress warning messages for symlinked files.
1963 : When nil, Emacs prints a warning when visiting a file that is already
1964 : visited, but with a different name. Setting this option to t
1965 : suppresses this warning."
1966 : :group 'files
1967 : :version "21.1"
1968 : :type 'boolean)
1969 :
1970 : (defcustom large-file-warning-threshold 10000000
1971 : "Maximum size of file above which a confirmation is requested.
1972 : When nil, never request confirmation."
1973 : :group 'files
1974 : :group 'find-file
1975 : :version "22.1"
1976 : :type '(choice integer (const :tag "Never request confirmation" nil)))
1977 :
1978 : (defcustom out-of-memory-warning-percentage nil
1979 : "Warn if file size exceeds this percentage of available free memory.
1980 : When nil, never issue warning. Beware: This probably doesn't do what you
1981 : think it does, because \"free\" is pretty hard to define in practice."
1982 : :group 'files
1983 : :group 'find-file
1984 : :version "25.1"
1985 : :type '(choice integer (const :tag "Never issue warning" nil)))
1986 :
1987 : (defun abort-if-file-too-large (size op-type filename)
1988 : "If file SIZE larger than `large-file-warning-threshold', allow user to abort.
1989 : OP-TYPE specifies the file operation being performed (for message to user)."
1990 316 : (when (and large-file-warning-threshold size
1991 316 : (> size large-file-warning-threshold)
1992 0 : (not (y-or-n-p (format "File %s is large (%s), really %s? "
1993 0 : (file-name-nondirectory filename)
1994 316 : (file-size-human-readable size) op-type))))
1995 316 : (user-error "Aborted")))
1996 :
1997 : (defun warn-maybe-out-of-memory (size)
1998 : "Warn if an attempt to open file of SIZE bytes may run out of memory."
1999 148 : (when (and (numberp size) (not (zerop size))
2000 148 : (integerp out-of-memory-warning-percentage))
2001 0 : (let ((meminfo (memory-info)))
2002 0 : (when (consp meminfo)
2003 0 : (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
2004 0 : (when (> (/ size 1024)
2005 0 : (/ (* total-free-memory out-of-memory-warning-percentage)
2006 0 : 100.0))
2007 0 : (warn
2008 : "You are trying to open a file whose size (%s)
2009 : exceeds the %S%% of currently available free memory (%s).
2010 : If that fails, try to open it with `find-file-literally'
2011 : \(but note that some characters might be displayed incorrectly)."
2012 0 : (file-size-human-readable size)
2013 0 : out-of-memory-warning-percentage
2014 148 : (file-size-human-readable (* total-free-memory 1024)))))))))
2015 :
2016 : (defun files--message (format &rest args)
2017 : "Like `message', except sometimes don't print to minibuffer.
2018 : If the variable `save-silently' is non-nil, the message is not
2019 : displayed on the minibuffer."
2020 0 : (apply #'message format args)
2021 0 : (when save-silently (message nil)))
2022 :
2023 : (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
2024 : "Read file FILENAME into a buffer and return the buffer.
2025 : If a buffer exists visiting FILENAME, return that one, but
2026 : verify that the file has not changed since visited or saved.
2027 : The buffer is not selected, just returned to the caller.
2028 : Optional second arg NOWARN non-nil means suppress any warning messages.
2029 : Optional third arg RAWFILE non-nil means the file is read literally.
2030 : Optional fourth arg WILDCARDS non-nil means do wildcard processing
2031 : and visit all the matching files. When wildcards are actually
2032 : used and expanded, return a list of buffers that are visiting
2033 : the various files."
2034 297 : (setq filename
2035 297 : (abbreviate-file-name
2036 297 : (expand-file-name filename)))
2037 297 : (if (file-directory-p filename)
2038 0 : (or (and find-file-run-dired
2039 0 : (run-hook-with-args-until-success
2040 : 'find-directory-functions
2041 0 : (if find-file-visit-truename
2042 0 : (abbreviate-file-name (file-truename filename))
2043 0 : filename)))
2044 0 : (error "%s is a directory" filename))
2045 297 : (if (and wildcards
2046 0 : find-file-wildcards
2047 0 : (not (file-name-quoted-p filename))
2048 297 : (string-match "[[*?]" filename))
2049 0 : (let ((files (condition-case nil
2050 0 : (file-expand-wildcards filename t)
2051 0 : (error (list filename))))
2052 : (find-file-wildcards nil))
2053 0 : (if (null files)
2054 0 : (find-file-noselect filename)
2055 0 : (mapcar #'find-file-noselect files)))
2056 297 : (let* ((buf (get-file-buffer filename))
2057 297 : (truename (abbreviate-file-name (file-truename filename)))
2058 297 : (attributes (file-attributes truename))
2059 297 : (number (nthcdr 10 attributes))
2060 : ;; Find any buffer for a file which has same truename.
2061 297 : (other (and (not buf) (find-buffer-visiting filename))))
2062 : ;; Let user know if there is a buffer with the same truename.
2063 297 : (if other
2064 0 : (progn
2065 0 : (or nowarn
2066 0 : find-file-suppress-same-file-warnings
2067 0 : (string-equal filename (buffer-file-name other))
2068 0 : (files--message "%s and %s are the same file"
2069 0 : filename (buffer-file-name other)))
2070 : ;; Optionally also find that buffer.
2071 0 : (if (or find-file-existing-other-name find-file-visit-truename)
2072 297 : (setq buf other))))
2073 : ;; Check to see if the file looks uncommonly large.
2074 297 : (when (not (or buf nowarn))
2075 148 : (abort-if-file-too-large (nth 7 attributes) "open" filename)
2076 297 : (warn-maybe-out-of-memory (nth 7 attributes)))
2077 297 : (if buf
2078 : ;; We are using an existing buffer.
2079 149 : (let (nonexistent)
2080 149 : (or nowarn
2081 149 : (verify-visited-file-modtime buf)
2082 0 : (cond ((not (file-exists-p filename))
2083 0 : (setq nonexistent t)
2084 0 : (message "File %s no longer exists!" filename))
2085 : ;; Certain files should be reverted automatically
2086 : ;; if they have changed on disk and not in the buffer.
2087 0 : ((and (not (buffer-modified-p buf))
2088 0 : (let ((tail revert-without-query)
2089 : (found nil))
2090 0 : (while tail
2091 0 : (if (string-match (car tail) filename)
2092 0 : (setq found t))
2093 0 : (setq tail (cdr tail)))
2094 0 : found))
2095 0 : (with-current-buffer buf
2096 0 : (message "Reverting file %s..." filename)
2097 0 : (revert-buffer t t)
2098 0 : (message "Reverting file %s...done" filename)))
2099 0 : ((yes-or-no-p
2100 0 : (if (string= (file-name-nondirectory filename)
2101 0 : (buffer-name buf))
2102 0 : (format
2103 0 : (if (buffer-modified-p buf)
2104 : "File %s changed on disk. Discard your edits? "
2105 0 : "File %s changed on disk. Reread from disk? ")
2106 0 : (file-name-nondirectory filename))
2107 0 : (format
2108 0 : (if (buffer-modified-p buf)
2109 : "File %s changed on disk. Discard your edits in %s? "
2110 0 : "File %s changed on disk. Reread from disk into %s? ")
2111 0 : (file-name-nondirectory filename)
2112 0 : (buffer-name buf))))
2113 0 : (with-current-buffer buf
2114 149 : (revert-buffer t t)))))
2115 149 : (with-current-buffer buf
2116 :
2117 : ;; Check if a formerly read-only file has become
2118 : ;; writable and vice versa, but if the buffer agrees
2119 : ;; with the new state of the file, that is ok too.
2120 149 : (let ((read-only (not (file-writable-p buffer-file-name))))
2121 149 : (unless (or nonexistent
2122 149 : (eq read-only buffer-file-read-only)
2123 149 : (eq read-only buffer-read-only))
2124 0 : (when (or nowarn
2125 0 : (let* ((new-status
2126 0 : (if read-only "read-only" "writable"))
2127 : (question
2128 0 : (format "File %s is %s on disk. Make buffer %s, too? "
2129 0 : buffer-file-name
2130 0 : new-status new-status)))
2131 0 : (y-or-n-p question)))
2132 149 : (setq buffer-read-only read-only)))
2133 149 : (setq buffer-file-read-only read-only))
2134 :
2135 149 : (unless (or (eq (null rawfile) (null find-file-literally))
2136 0 : nonexistent
2137 : ;; It is confusing to ask whether to visit
2138 : ;; non-literally if they have the file in
2139 : ;; hexl-mode or image-mode.
2140 149 : (memq major-mode '(hexl-mode image-mode)))
2141 0 : (if (buffer-modified-p)
2142 0 : (if (y-or-n-p
2143 0 : (format
2144 0 : (if rawfile
2145 : "The file %s is already visited normally,
2146 : and you have edited the buffer. Now you have asked to visit it literally,
2147 : meaning no coding system handling, format conversion, or local variables.
2148 : Emacs can only visit a file in one way at a time.
2149 :
2150 : Do you want to save the file, and visit it literally instead? "
2151 : "The file %s is already visited literally,
2152 : meaning no coding system handling, format conversion, or local variables.
2153 : You have edited the buffer. Now you have asked to visit the file normally,
2154 : but Emacs can only visit a file in one way at a time.
2155 :
2156 0 : Do you want to save the file, and visit it normally instead? ")
2157 0 : (file-name-nondirectory filename)))
2158 0 : (progn
2159 0 : (save-buffer)
2160 0 : (find-file-noselect-1 buf filename nowarn
2161 0 : rawfile truename number))
2162 0 : (if (y-or-n-p
2163 0 : (format
2164 0 : (if rawfile
2165 : "\
2166 : Do you want to discard your changes, and visit the file literally now? "
2167 : "\
2168 0 : Do you want to discard your changes, and visit the file normally now? ")))
2169 0 : (find-file-noselect-1 buf filename nowarn
2170 0 : rawfile truename number)
2171 0 : (error (if rawfile "File already visited non-literally"
2172 0 : "File already visited literally"))))
2173 0 : (if (y-or-n-p
2174 0 : (format
2175 0 : (if rawfile
2176 : "The file %s is already visited normally.
2177 : You have asked to visit it literally,
2178 : meaning no coding system decoding, format conversion, or local variables.
2179 : But Emacs can only visit a file in one way at a time.
2180 :
2181 : Do you want to revisit the file literally now? "
2182 : "The file %s is already visited literally,
2183 : meaning no coding system decoding, format conversion, or local variables.
2184 : You have asked to visit it normally,
2185 : but Emacs can only visit a file in one way at a time.
2186 :
2187 0 : Do you want to revisit the file normally now? ")
2188 0 : (file-name-nondirectory filename)))
2189 0 : (find-file-noselect-1 buf filename nowarn
2190 0 : rawfile truename number)
2191 0 : (error (if rawfile "File already visited non-literally"
2192 149 : "File already visited literally"))))))
2193 : ;; Return the buffer we are using.
2194 149 : buf)
2195 : ;; Create a new buffer.
2196 148 : (setq buf (create-file-buffer filename))
2197 : ;; find-file-noselect-1 may use a different buffer.
2198 148 : (find-file-noselect-1 buf filename nowarn
2199 297 : rawfile truename number))))))
2200 :
2201 : (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
2202 148 : (let (error)
2203 148 : (with-current-buffer buf
2204 148 : (kill-local-variable 'find-file-literally)
2205 : ;; Needed in case we are re-visiting the file with a different
2206 : ;; text representation.
2207 148 : (kill-local-variable 'buffer-file-coding-system)
2208 148 : (kill-local-variable 'cursor-type)
2209 148 : (let ((inhibit-read-only t))
2210 148 : (erase-buffer))
2211 148 : (and (default-value 'enable-multibyte-characters)
2212 148 : (not rawfile)
2213 148 : (set-buffer-multibyte t))
2214 148 : (if rawfile
2215 0 : (condition-case ()
2216 0 : (let ((inhibit-read-only t))
2217 0 : (insert-file-contents-literally filename t))
2218 : (file-error
2219 0 : (when (and (file-exists-p filename)
2220 0 : (not (file-readable-p filename)))
2221 0 : (kill-buffer buf)
2222 0 : (signal 'file-error (list "File is not readable"
2223 0 : filename)))
2224 : ;; Unconditionally set error
2225 0 : (setq error t)))
2226 148 : (condition-case ()
2227 148 : (let ((inhibit-read-only t))
2228 148 : (insert-file-contents filename t))
2229 : (file-error
2230 0 : (when (and (file-exists-p filename)
2231 0 : (not (file-readable-p filename)))
2232 0 : (kill-buffer buf)
2233 0 : (signal 'file-error (list "File is not readable"
2234 0 : filename)))
2235 : ;; Run find-file-not-found-functions until one returns non-nil.
2236 0 : (or (run-hook-with-args-until-success 'find-file-not-found-functions)
2237 : ;; If they fail too, set error.
2238 148 : (setq error t)))))
2239 : ;; Record the file's truename, and maybe use that as visited name.
2240 148 : (if (equal filename buffer-file-name)
2241 148 : (setq buffer-file-truename truename)
2242 0 : (setq buffer-file-truename
2243 148 : (abbreviate-file-name (file-truename buffer-file-name))))
2244 148 : (setq buffer-file-number number)
2245 148 : (if find-file-visit-truename
2246 148 : (setq buffer-file-name (expand-file-name buffer-file-truename)))
2247 : ;; Set buffer's default directory to that of the file.
2248 148 : (setq default-directory (file-name-directory buffer-file-name))
2249 : ;; Turn off backup files for certain file names. Since
2250 : ;; this is a permanent local, the major mode won't eliminate it.
2251 148 : (and backup-enable-predicate
2252 148 : (not (funcall backup-enable-predicate buffer-file-name))
2253 0 : (progn
2254 0 : (make-local-variable 'backup-inhibited)
2255 148 : (setq backup-inhibited t)))
2256 148 : (if rawfile
2257 0 : (progn
2258 0 : (set-buffer-multibyte nil)
2259 0 : (setq buffer-file-coding-system 'no-conversion)
2260 0 : (set-buffer-major-mode buf)
2261 0 : (setq-local find-file-literally t))
2262 148 : (after-find-file error (not nowarn)))
2263 148 : (current-buffer))))
2264 :
2265 : (defun insert-file-contents-literally (filename &optional visit beg end replace)
2266 : "Like `insert-file-contents', but only reads in the file literally.
2267 : See `insert-file-contents' for an explanation of the parameters.
2268 : A buffer may be modified in several ways after reading into the buffer,
2269 : due to Emacs features such as format decoding, character code
2270 : conversion, `find-file-hook', automatic uncompression, etc.
2271 :
2272 : This function ensures that none of these modifications will take place."
2273 573 : (let ((format-alist nil)
2274 : (after-insert-file-functions nil)
2275 : (coding-system-for-read 'no-conversion)
2276 : (coding-system-for-write 'no-conversion)
2277 : (inhibit-file-name-handlers
2278 : ;; FIXME: Yuck!! We should turn insert-file-contents-literally
2279 : ;; into a file operation instead!
2280 573 : (append '(jka-compr-handler image-file-handler epa-file-handler)
2281 573 : inhibit-file-name-handlers))
2282 : (inhibit-file-name-operation 'insert-file-contents))
2283 573 : (insert-file-contents filename visit beg end replace)))
2284 :
2285 : (defun insert-file-1 (filename insert-func)
2286 0 : (if (file-directory-p filename)
2287 0 : (signal 'file-error (list "Opening input file" "Is a directory"
2288 0 : filename)))
2289 : ;; Check whether the file is uncommonly large
2290 0 : (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename)
2291 0 : (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
2292 0 : #'buffer-modified-p))
2293 0 : (tem (funcall insert-func filename)))
2294 0 : (push-mark (+ (point) (car (cdr tem))))
2295 0 : (when buffer
2296 0 : (message "File %s already visited and modified in buffer %s"
2297 0 : filename (buffer-name buffer)))))
2298 :
2299 : (defun insert-file-literally (filename)
2300 : "Insert contents of file FILENAME into buffer after point with no conversion.
2301 :
2302 : This function is meant for the user to run interactively.
2303 : Don't call it from programs! Use `insert-file-contents-literally' instead.
2304 : \(Its calling sequence is different; see its documentation)."
2305 : (declare (interactive-only insert-file-contents-literally))
2306 : (interactive "*fInsert file literally: ")
2307 0 : (insert-file-1 filename #'insert-file-contents-literally))
2308 :
2309 : (defvar find-file-literally nil
2310 : "Non-nil if this buffer was made by `find-file-literally' or equivalent.
2311 : This has the `permanent-local' property, which takes effect if you
2312 : make the variable buffer-local.")
2313 : (put 'find-file-literally 'permanent-local t)
2314 :
2315 : (defun find-file-literally (filename)
2316 : "Visit file FILENAME with no conversion of any kind.
2317 : Format conversion and character code conversion are both disabled,
2318 : and multibyte characters are disabled in the resulting buffer.
2319 : The major mode used is Fundamental mode regardless of the file name,
2320 : and local variable specifications in the file are ignored.
2321 : Automatic uncompression and adding a newline at the end of the
2322 : file due to `require-final-newline' is also disabled.
2323 :
2324 : You cannot absolutely rely on this function to result in
2325 : visiting the file literally. If Emacs already has a buffer
2326 : which is visiting the file, you get the existing buffer,
2327 : regardless of whether it was created literally or not.
2328 :
2329 : In a Lisp program, if you want to be sure of accessing a file's
2330 : contents literally, you should create a temporary buffer and then read
2331 : the file contents into it using `insert-file-contents-literally'."
2332 : (interactive
2333 0 : (list (read-file-name
2334 0 : "Find file literally: " nil default-directory
2335 0 : (confirm-nonexistent-file-or-buffer))))
2336 0 : (switch-to-buffer (find-file-noselect filename nil t)))
2337 :
2338 : (defun after-find-file (&optional error warn noauto
2339 : _after-find-file-from-revert-buffer
2340 : nomodes)
2341 : "Called after finding a file and by the default revert function.
2342 : Sets buffer mode, parses local variables.
2343 : Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
2344 : error in reading the file. WARN non-nil means warn if there
2345 : exists an auto-save file more recent than the visited file.
2346 : NOAUTO means don't mess with auto-save mode.
2347 : Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER is ignored
2348 : \(see `revert-buffer-in-progress-p' for similar functionality).
2349 : Fifth arg NOMODES non-nil means don't alter the file's modes.
2350 : Finishes by calling the functions in `find-file-hook'
2351 : unless NOMODES is non-nil."
2352 148 : (setq buffer-read-only (not (file-writable-p buffer-file-name)))
2353 148 : (if noninteractive
2354 : nil
2355 0 : (let* (not-serious
2356 : (msg
2357 0 : (cond
2358 0 : ((not warn) nil)
2359 0 : ((and error (file-attributes buffer-file-name))
2360 0 : (setq buffer-read-only t)
2361 0 : (if (and (file-symlink-p buffer-file-name)
2362 0 : (not (file-exists-p
2363 0 : (file-chase-links buffer-file-name))))
2364 : "Symbolic link that points to nonexistent file"
2365 0 : "File exists, but cannot be read"))
2366 0 : ((not buffer-read-only)
2367 0 : (if (and warn
2368 : ;; No need to warn if buffer is auto-saved
2369 : ;; under the name of the visited file.
2370 0 : (not (and buffer-file-name
2371 0 : auto-save-visited-file-name))
2372 0 : (file-newer-than-file-p (or buffer-auto-save-file-name
2373 0 : (make-auto-save-file-name))
2374 0 : buffer-file-name))
2375 0 : (format "%s has auto save data; consider M-x recover-this-file"
2376 0 : (file-name-nondirectory buffer-file-name))
2377 0 : (setq not-serious t)
2378 0 : (if error "(New file)" nil)))
2379 0 : ((not error)
2380 0 : (setq not-serious t)
2381 : "Note: file is write protected")
2382 0 : ((file-attributes (directory-file-name default-directory))
2383 : "File not found and directory write-protected")
2384 0 : ((file-exists-p (file-name-directory buffer-file-name))
2385 0 : (setq buffer-read-only nil))
2386 : (t
2387 0 : (setq buffer-read-only nil)
2388 0 : "Use M-x make-directory RET RET to create the directory and its parents"))))
2389 0 : (when msg
2390 0 : (message "%s" msg)
2391 0 : (or not-serious (sit-for 1 t))))
2392 0 : (when (and auto-save-default (not noauto))
2393 148 : (auto-save-mode 1)))
2394 : ;; Make people do a little extra work (C-x C-q)
2395 : ;; before altering a backup file.
2396 148 : (when (backup-file-name-p buffer-file-name)
2397 148 : (setq buffer-read-only t))
2398 : ;; When a file is marked read-only,
2399 : ;; make the buffer read-only even if root is looking at it.
2400 148 : (when (and (file-modes (buffer-file-name))
2401 148 : (zerop (logand (file-modes (buffer-file-name)) #o222)))
2402 148 : (setq buffer-read-only t))
2403 148 : (unless nomodes
2404 148 : (when (and view-read-only view-mode)
2405 148 : (view-mode -1))
2406 148 : (normal-mode t)
2407 : ;; If requested, add a newline at the end of the file.
2408 148 : (and (memq require-final-newline '(visit visit-save))
2409 0 : (> (point-max) (point-min))
2410 0 : (/= (char-after (1- (point-max))) ?\n)
2411 0 : (not (and (eq selective-display t)
2412 0 : (= (char-after (1- (point-max))) ?\r)))
2413 0 : (not buffer-read-only)
2414 0 : (save-excursion
2415 0 : (goto-char (point-max))
2416 148 : (ignore-errors (insert "\n"))))
2417 148 : (when (and buffer-read-only
2418 0 : view-read-only
2419 148 : (not (eq (get major-mode 'mode-class) 'special)))
2420 148 : (view-mode-enter))
2421 148 : (run-hooks 'find-file-hook)))
2422 :
2423 : (define-obsolete-function-alias 'report-errors 'with-demoted-errors "25.1")
2424 :
2425 : (defun normal-mode (&optional find-file)
2426 : "Choose the major mode for this buffer automatically.
2427 : Also sets up any specified local variables of the file.
2428 : Uses the visited file name, the -*- line, and the local variables spec.
2429 :
2430 : This function is called automatically from `find-file'. In that case,
2431 : we may set up the file-specified mode and local variables,
2432 : depending on the value of `enable-local-variables'.
2433 : In addition, if `local-enable-local-variables' is nil, we do
2434 : not set local variables (though we do notice a mode specified with -*-.)
2435 :
2436 : `enable-local-variables' is ignored if you run `normal-mode' interactively,
2437 : or from Lisp without specifying the optional argument FIND-FILE;
2438 : in that case, this function acts as if `enable-local-variables' were t."
2439 : (interactive)
2440 148 : (kill-all-local-variables)
2441 148 : (unless delay-mode-hooks
2442 148 : (run-hooks 'change-major-mode-after-body-hook
2443 148 : 'after-change-major-mode-hook))
2444 148 : (let ((enable-local-variables (or (not find-file) enable-local-variables)))
2445 : ;; FIXME this is less efficient than it could be, since both
2446 : ;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
2447 148 : (with-demoted-errors "File mode specification error: %s"
2448 148 : (set-auto-mode))
2449 : ;; `delay-mode-hooks' being non-nil will have prevented the major
2450 : ;; mode's call to `run-mode-hooks' from calling
2451 : ;; `hack-local-variables'. In that case, call it now.
2452 148 : (when delay-mode-hooks
2453 0 : (with-demoted-errors "File local-variables error: %s"
2454 148 : (hack-local-variables 'no-mode))))
2455 : ;; Turn font lock off and on, to make sure it takes account of
2456 : ;; whatever file local variables are relevant to it.
2457 148 : (when (and font-lock-mode
2458 : ;; Font-lock-mode (now in font-core.el) can be ON when
2459 : ;; font-lock.el still hasn't been loaded.
2460 0 : (boundp 'font-lock-keywords)
2461 148 : (eq (car font-lock-keywords) t))
2462 0 : (setq font-lock-keywords (cadr font-lock-keywords))
2463 148 : (font-lock-mode 1)))
2464 :
2465 : (defcustom auto-mode-case-fold t
2466 : "Non-nil means to try second pass through `auto-mode-alist'.
2467 : This means that if the first case-sensitive search through the alist fails
2468 : to find a matching major mode, a second case-insensitive search is made.
2469 : On systems with case-insensitive file names, this variable is ignored,
2470 : since only a single case-insensitive search through the alist is made."
2471 : :group 'files
2472 : :version "22.1"
2473 : :type 'boolean)
2474 :
2475 : (defvar auto-mode-alist
2476 : ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
2477 : ;; c++-mode, java-mode and more) are added through autoload
2478 : ;; directives in that file. That way is discouraged since it
2479 : ;; spreads out the definition of the initial value.
2480 : (mapcar
2481 : (lambda (elt)
2482 : (cons (purecopy (car elt)) (cdr elt)))
2483 : `(;; do this first, so that .html.pl is Polish html, not Perl
2484 : ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode)
2485 : ("\\.svgz?\\'" . image-mode)
2486 : ("\\.svgz?\\'" . xml-mode)
2487 : ("\\.x[bp]m\\'" . image-mode)
2488 : ("\\.x[bp]m\\'" . c-mode)
2489 : ("\\.p[bpgn]m\\'" . image-mode)
2490 : ("\\.tiff?\\'" . image-mode)
2491 : ("\\.gif\\'" . image-mode)
2492 : ("\\.png\\'" . image-mode)
2493 : ("\\.jpe?g\\'" . image-mode)
2494 : ("\\.te?xt\\'" . text-mode)
2495 : ("\\.[tT]e[xX]\\'" . tex-mode)
2496 : ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
2497 : ("\\.ltx\\'" . latex-mode)
2498 : ("\\.dtx\\'" . doctex-mode)
2499 : ("\\.org\\'" . org-mode)
2500 : ("\\.el\\'" . emacs-lisp-mode)
2501 : ("Project\\.ede\\'" . emacs-lisp-mode)
2502 : ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
2503 : ("\\.l\\'" . lisp-mode)
2504 : ("\\.li?sp\\'" . lisp-mode)
2505 : ("\\.[fF]\\'" . fortran-mode)
2506 : ("\\.for\\'" . fortran-mode)
2507 : ("\\.p\\'" . pascal-mode)
2508 : ("\\.pas\\'" . pascal-mode)
2509 : ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
2510 : ("\\.ad[abs]\\'" . ada-mode)
2511 : ("\\.ad[bs].dg\\'" . ada-mode)
2512 : ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
2513 : ("Imakefile\\'" . makefile-imake-mode)
2514 : ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
2515 : ("\\.makepp\\'" . makefile-makepp-mode)
2516 : ,@(if (memq system-type '(berkeley-unix darwin))
2517 : '(("\\.mk\\'" . makefile-bsdmake-mode)
2518 : ("\\.make\\'" . makefile-bsdmake-mode)
2519 : ("GNUmakefile\\'" . makefile-gmake-mode)
2520 : ("[Mm]akefile\\'" . makefile-bsdmake-mode))
2521 : '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
2522 : ("\\.make\\'" . makefile-gmake-mode)
2523 : ("[Mm]akefile\\'" . makefile-gmake-mode)))
2524 : ("\\.am\\'" . makefile-automake-mode)
2525 : ;; Less common extensions come here
2526 : ;; so more common ones above are found faster.
2527 : ("\\.texinfo\\'" . texinfo-mode)
2528 : ("\\.te?xi\\'" . texinfo-mode)
2529 : ("\\.[sS]\\'" . asm-mode)
2530 : ("\\.asm\\'" . asm-mode)
2531 : ("\\.css\\'" . css-mode)
2532 : ("\\.mixal\\'" . mixal-mode)
2533 : ("\\.gcov\\'" . compilation-mode)
2534 : ;; Besides .gdbinit, gdb documents other names to be usable for init
2535 : ;; files, cross-debuggers can use something like
2536 : ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
2537 : ;; don't interfere with each other.
2538 : ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)
2539 : ;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file
2540 : ;; named 'emacs-gdb.gdb', if it exists, will be automatically
2541 : ;; loaded when GDB reads an objfile called 'emacs'.
2542 : ("-gdb\\.gdb" . gdb-script-mode)
2543 : ("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
2544 : ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode)
2545 : ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
2546 : ("\\.scm\\.[0-9]*\\'" . scheme-mode)
2547 : ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
2548 : ("\\.bash\\'" . sh-mode)
2549 : ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
2550 : ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
2551 : ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
2552 : ("\\.m?spec\\'" . sh-mode)
2553 : ("\\.m[mes]\\'" . nroff-mode)
2554 : ("\\.man\\'" . nroff-mode)
2555 : ("\\.sty\\'" . latex-mode)
2556 : ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option
2557 : ("\\.bbl\\'" . latex-mode)
2558 : ("\\.bib\\'" . bibtex-mode)
2559 : ("\\.bst\\'" . bibtex-style-mode)
2560 : ("\\.sql\\'" . sql-mode)
2561 : ("\\.m[4c]\\'" . m4-mode)
2562 : ("\\.mf\\'" . metafont-mode)
2563 : ("\\.mp\\'" . metapost-mode)
2564 : ("\\.vhdl?\\'" . vhdl-mode)
2565 : ("\\.article\\'" . text-mode)
2566 : ("\\.letter\\'" . text-mode)
2567 : ("\\.i?tcl\\'" . tcl-mode)
2568 : ("\\.exp\\'" . tcl-mode)
2569 : ("\\.itk\\'" . tcl-mode)
2570 : ("\\.icn\\'" . icon-mode)
2571 : ("\\.sim\\'" . simula-mode)
2572 : ("\\.mss\\'" . scribe-mode)
2573 : ;; The Fortran standard does not say anything about file extensions.
2574 : ;; .f90 was widely used for F90, now we seem to be trapped into
2575 : ;; using a different extension for each language revision.
2576 : ;; Anyway, the following extensions are supported by gfortran.
2577 : ("\\.f9[05]\\'" . f90-mode)
2578 : ("\\.f0[38]\\'" . f90-mode)
2579 : ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
2580 : ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
2581 : ("\\.srt\\'" . srecode-template-mode)
2582 : ("\\.prolog\\'" . prolog-mode)
2583 : ("\\.tar\\'" . tar-mode)
2584 : ;; The list of archive file extensions should be in sync with
2585 : ;; `auto-coding-alist' with `no-conversion' coding system.
2586 : ("\\.\\(\
2587 : arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\
2588 : ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode)
2589 : ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
2590 : ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
2591 : ;; Mailer puts message to be edited in
2592 : ;; /tmp/Re.... or Message
2593 : ("\\`/tmp/Re" . text-mode)
2594 : ("/Message[0-9]*\\'" . text-mode)
2595 : ;; some news reader is reported to use this
2596 : ("\\`/tmp/fol/" . text-mode)
2597 : ("\\.oak\\'" . scheme-mode)
2598 : ("\\.sgml?\\'" . sgml-mode)
2599 : ("\\.x[ms]l\\'" . xml-mode)
2600 : ("\\.dbk\\'" . xml-mode)
2601 : ("\\.dtd\\'" . sgml-mode)
2602 : ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
2603 : ("\\.jsm?\\'" . javascript-mode)
2604 : ("\\.json\\'" . javascript-mode)
2605 : ("\\.jsx\\'" . js-jsx-mode)
2606 : ("\\.[ds]?vh?\\'" . verilog-mode)
2607 : ("\\.by\\'" . bovine-grammar-mode)
2608 : ("\\.wy\\'" . wisent-grammar-mode)
2609 : ;; .emacs or .gnus or .viper following a directory delimiter in
2610 : ;; Unix or MS-DOS syntax.
2611 : ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
2612 : ("\\`\\..*emacs\\'" . emacs-lisp-mode)
2613 : ;; _emacs following a directory delimiter in MS-DOS syntax
2614 : ("[:/]_emacs\\'" . emacs-lisp-mode)
2615 : ("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
2616 : ("\\.ml\\'" . lisp-mode)
2617 : ;; Linux-2.6.9 uses some different suffix for linker scripts:
2618 : ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo".
2619 : ;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*".
2620 : ("\\.ld[si]?\\'" . ld-script-mode)
2621 : ("ld\\.?script\\'" . ld-script-mode)
2622 : ;; .xs is also used for ld scripts, but seems to be more commonly
2623 : ;; associated with Perl .xs files (C with Perl bindings). (Bug#7071)
2624 : ("\\.xs\\'" . c-mode)
2625 : ;; Explained in binutils ld/genscripts.sh. Eg:
2626 : ;; A .x script file is the default script.
2627 : ;; A .xr script is for linking without relocation (-r flag). Etc.
2628 : ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode)
2629 : ("\\.zone\\'" . dns-mode)
2630 : ("\\.soa\\'" . dns-mode)
2631 : ;; Common Lisp ASDF package system.
2632 : ("\\.asd\\'" . lisp-mode)
2633 : ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
2634 : ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
2635 : ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
2636 : ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS
2637 : ("\\.[eE]?[pP][sS]\\'" . ps-mode)
2638 : ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
2639 : ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
2640 : ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
2641 : ("BROWSE\\'" . ebrowse-tree-mode)
2642 : ("\\.ebrowse\\'" . ebrowse-tree-mode)
2643 : ("#\\*mail\\*" . mail-mode)
2644 : ("\\.g\\'" . antlr-mode)
2645 : ("\\.mod\\'" . m2-mode)
2646 : ("\\.ses\\'" . ses-mode)
2647 : ("\\.docbook\\'" . sgml-mode)
2648 : ("\\.com\\'" . dcl-mode)
2649 : ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
2650 : ;; Windows candidates may be opened case sensitively on Unix
2651 : ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
2652 : ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode)
2653 : ("\\.ppd\\'" . conf-ppd-mode)
2654 : ("java.+\\.conf\\'" . conf-javaprop-mode)
2655 : ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
2656 : ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
2657 : ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
2658 : ;; ChangeLog.old etc. Other change-log-mode entries are above;
2659 : ;; this has lower priority to avoid matching changelog.sgml etc.
2660 : ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
2661 : ;; either user's dot-files or under /etc or some such
2662 : ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
2663 : ;; alas not all ~/.*rc files are like this
2664 : ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
2665 : ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
2666 : ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
2667 : ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode)
2668 : ("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
2669 : ;; this contains everything twice, with space and with colon :-(
2670 : ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
2671 : ;; Get rid of any trailing .n.m and try again.
2672 : ;; This is for files saved by cvs-merge that look like .#<file>.<rev>
2673 : ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
2674 : ;; Using mode nil rather than `ignore' would let the search continue
2675 : ;; through this list (with the shortened name) rather than start over.
2676 : ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
2677 : ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)
2678 : ;; This should come after "in" stripping (e.g. config.h.in).
2679 : ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
2680 : ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
2681 : ;; The following should come after the ChangeLog pattern
2682 : ;; for the sake of ChangeLog.1, etc.
2683 : ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
2684 : ("\\.[1-9]\\'" . nroff-mode)))
2685 : "Alist of filename patterns vs corresponding major mode functions.
2686 : Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
2687 : \(NON-NIL stands for anything that is not nil; the value does not matter.)
2688 : Visiting a file whose name matches REGEXP specifies FUNCTION as the
2689 : mode function to use. FUNCTION will be called, unless it is nil.
2690 :
2691 : If the element has the form (REGEXP FUNCTION NON-NIL), then after
2692 : calling FUNCTION (if it's not nil), we delete the suffix that matched
2693 : REGEXP and search the list again for another match.
2694 :
2695 : The extensions whose FUNCTION is `archive-mode' should also
2696 : appear in `auto-coding-alist' with `no-conversion' coding system.
2697 :
2698 : See also `interpreter-mode-alist', which detects executable script modes
2699 : based on the interpreters they specify to run,
2700 : and `magic-mode-alist', which determines modes based on file contents.")
2701 : (put 'auto-mode-alist 'risky-local-variable t)
2702 :
2703 : (defun conf-mode-maybe ()
2704 : "Select Conf mode or XML mode according to start of file."
2705 0 : (if (save-excursion
2706 0 : (save-restriction
2707 0 : (widen)
2708 0 : (goto-char (point-min))
2709 0 : (looking-at "<\\?xml \\|<!-- \\|<!DOCTYPE ")))
2710 0 : (xml-mode)
2711 0 : (conf-mode)))
2712 :
2713 : (defvar interpreter-mode-alist
2714 : ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
2715 : ;; and pike-mode) are added through autoload directives in that
2716 : ;; file. That way is discouraged since it spreads out the
2717 : ;; definition of the initial value.
2718 : (mapcar
2719 : (lambda (l)
2720 : (cons (purecopy (car l)) (cdr l)))
2721 : '(("\\(mini\\)?perl5?" . perl-mode)
2722 : ("wishx?" . tcl-mode)
2723 : ("tcl\\(sh\\)?" . tcl-mode)
2724 : ("expect" . tcl-mode)
2725 : ("octave" . octave-mode)
2726 : ("scm" . scheme-mode)
2727 : ("[acjkwz]sh" . sh-mode)
2728 : ("r?bash2?" . sh-mode)
2729 : ("dash" . sh-mode)
2730 : ("mksh" . sh-mode)
2731 : ("\\(dt\\|pd\\|w\\)ksh" . sh-mode)
2732 : ("es" . sh-mode)
2733 : ("i?tcsh" . sh-mode)
2734 : ("oash" . sh-mode)
2735 : ("rc" . sh-mode)
2736 : ("rpm" . sh-mode)
2737 : ("sh5?" . sh-mode)
2738 : ("tail" . text-mode)
2739 : ("more" . text-mode)
2740 : ("less" . text-mode)
2741 : ("pg" . text-mode)
2742 : ("make" . makefile-gmake-mode) ; Debian uses this
2743 : ("guile" . scheme-mode)
2744 : ("clisp" . lisp-mode)
2745 : ("emacs" . emacs-lisp-mode)))
2746 : "Alist mapping interpreter names to major modes.
2747 : This is used for files whose first lines match `auto-mode-interpreter-regexp'.
2748 : Each element looks like (REGEXP . MODE).
2749 : If REGEXP matches the entire name (minus any directory part) of
2750 : the interpreter specified in the first line of a script, enable
2751 : major mode MODE.
2752 :
2753 : See also `auto-mode-alist'.")
2754 :
2755 : (define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
2756 : 'inhibit-file-local-variables-regexps "24.1")
2757 :
2758 : ;; TODO really this should be a list of modes (eg tar-mode), not regexps,
2759 : ;; because we are duplicating info from auto-mode-alist.
2760 : ;; TODO many elements of this list are also in auto-coding-alist.
2761 : (defvar inhibit-local-variables-regexps
2762 : (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
2763 : "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
2764 : "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
2765 : "\\.7z\\'"
2766 : "\\.sx[dmicw]\\'" "\\.odt\\'"
2767 : "\\.diff\\'" "\\.patch\\'"
2768 : "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
2769 : "List of regexps matching file names in which to ignore local variables.
2770 : This includes `-*-' lines as well as trailing \"Local Variables\" sections.
2771 : Files matching this list are typically binary file formats.
2772 : They may happen to contain sequences that look like local variable
2773 : specifications, but are not really, or they may be containers for
2774 : member files with their own local variable sections, which are
2775 : not appropriate for the containing file.
2776 : The function `inhibit-local-variables-p' uses this.")
2777 :
2778 : (define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
2779 : 'inhibit-local-variables-suffixes "24.1")
2780 :
2781 : (defvar inhibit-local-variables-suffixes nil
2782 : "List of regexps matching suffixes to remove from file names.
2783 : The function `inhibit-local-variables-p' uses this: when checking
2784 : a file name, it first discards from the end of the name anything that
2785 : matches one of these regexps.")
2786 :
2787 : ;; Can't think of any situation in which you'd want this to be nil...
2788 : (defvar inhibit-local-variables-ignore-case t
2789 : "Non-nil means `inhibit-local-variables-p' ignores case.")
2790 :
2791 : (defun inhibit-local-variables-p ()
2792 : "Return non-nil if file local variables should be ignored.
2793 : This checks the file (or buffer) name against `inhibit-local-variables-regexps'
2794 : and `inhibit-local-variables-suffixes'. If
2795 : `inhibit-local-variables-ignore-case' is non-nil, this ignores case."
2796 909 : (let ((temp inhibit-local-variables-regexps)
2797 909 : (name (if buffer-file-name
2798 888 : (file-name-sans-versions buffer-file-name)
2799 909 : (buffer-name)))
2800 909 : (case-fold-search inhibit-local-variables-ignore-case))
2801 909 : (while (let ((sufs inhibit-local-variables-suffixes))
2802 8181 : (while (and sufs (not (string-match (car sufs) name)))
2803 7272 : (setq sufs (cdr sufs)))
2804 909 : sufs)
2805 909 : (setq name (substring name 0 (match-beginning 0))))
2806 18180 : (while (and temp
2807 18180 : (not (string-match (car temp) name)))
2808 17271 : (setq temp (cdr temp)))
2809 909 : temp))
2810 :
2811 : (defvar auto-mode-interpreter-regexp
2812 : (purecopy "#![ \t]?\\([^ \t\n]*\
2813 : /bin/env[ \t]\\)?\\([^ \t\n]+\\)")
2814 : "Regexp matching interpreters, for file mode determination.
2815 : This regular expression is matched against the first line of a file
2816 : to determine the file's mode in `set-auto-mode'. If it matches, the file
2817 : is assumed to be interpreted by the interpreter matched by the second group
2818 : of the regular expression. The mode is then determined as the mode
2819 : associated with that interpreter in `interpreter-mode-alist'.")
2820 :
2821 : (defvar magic-mode-alist nil
2822 : "Alist of buffer beginnings vs. corresponding major mode functions.
2823 : Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
2824 : After visiting a file, if REGEXP matches the text at the beginning of the
2825 : buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will
2826 : call FUNCTION rather than allowing `auto-mode-alist' to decide the buffer's
2827 : major mode.
2828 :
2829 : If FUNCTION is nil, then it is not called. (That is a way of saying
2830 : \"allow `auto-mode-alist' to decide for these files.\")")
2831 : (put 'magic-mode-alist 'risky-local-variable t)
2832 :
2833 : (defvar magic-fallback-mode-alist
2834 : (purecopy
2835 : `((image-type-auto-detected-p . image-mode)
2836 : ("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip
2837 : ;; The < comes before the groups (but the first) to reduce backtracking.
2838 : ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
2839 : ;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely.
2840 : (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
2841 : (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
2842 : (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
2843 : comment-re "*"
2844 : "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
2845 : "[Hh][Tt][Mm][Ll]"))
2846 : . mhtml-mode)
2847 : ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
2848 : ;; These two must come after html, because they are more general:
2849 : ("<\\?xml " . xml-mode)
2850 : (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
2851 : (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
2852 : (concat "[ \t\r\n]*<" comment-re "*!DOCTYPE "))
2853 : . sgml-mode)
2854 : ("%!PS" . ps-mode)
2855 : ("# xmcd " . conf-unix-mode)))
2856 : "Like `magic-mode-alist' but has lower priority than `auto-mode-alist'.
2857 : Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
2858 : After visiting a file, if REGEXP matches the text at the beginning of the
2859 : buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will
2860 : call FUNCTION, provided that `magic-mode-alist' and `auto-mode-alist'
2861 : have not specified a mode for this file.
2862 :
2863 : If FUNCTION is nil, then it is not called.")
2864 : (put 'magic-fallback-mode-alist 'risky-local-variable t)
2865 :
2866 : (defvar magic-mode-regexp-match-limit 4000
2867 : "Upper limit on `magic-mode-alist' regexp matches.
2868 : Also applies to `magic-fallback-mode-alist'.")
2869 :
2870 : (defun set-auto-mode (&optional keep-mode-if-same)
2871 : "Select major mode appropriate for current buffer.
2872 :
2873 : To find the right major mode, this function checks for a -*- mode tag
2874 : checks for a `mode:' entry in the Local Variables section of the file,
2875 : checks if it uses an interpreter listed in `interpreter-mode-alist',
2876 : matches the buffer beginning against `magic-mode-alist',
2877 : compares the filename against the entries in `auto-mode-alist',
2878 : then matches the buffer beginning against `magic-fallback-mode-alist'.
2879 :
2880 : If `enable-local-variables' is nil, or if the file name matches
2881 : `inhibit-local-variables-regexps', this function does not check
2882 : for any mode: tag anywhere in the file. If `local-enable-local-variables'
2883 : is nil, then the only mode: tag that can be relevant is a -*- one.
2884 :
2885 : If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
2886 : set the major mode only if that would change it. In other words
2887 : we don't actually set it to the same mode the buffer already has."
2888 : ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
2889 148 : (let ((try-locals (not (inhibit-local-variables-p)))
2890 : end done mode modes)
2891 : ;; Once we drop the deprecated feature where mode: is also allowed to
2892 : ;; specify minor-modes (ie, there can be more than one "mode:"), we can
2893 : ;; remove this section and just let (hack-local-variables t) handle it.
2894 : ;; Find a -*- mode tag.
2895 148 : (save-excursion
2896 148 : (goto-char (point-min))
2897 148 : (skip-chars-forward " \t\n")
2898 : ;; Note by design local-enable-local-variables does not matter here.
2899 148 : (and enable-local-variables
2900 148 : try-locals
2901 148 : (setq end (set-auto-mode-1))
2902 83 : (if (save-excursion (search-forward ":" end t))
2903 : ;; Find all specifications for the `mode:' variable
2904 : ;; and execute them left to right.
2905 83 : (while (let ((case-fold-search t))
2906 83 : (or (and (looking-at "mode:")
2907 83 : (goto-char (match-end 0)))
2908 83 : (re-search-forward "[ \t;]mode:" end t)))
2909 0 : (skip-chars-forward " \t")
2910 0 : (let ((beg (point)))
2911 0 : (if (search-forward ";" end t)
2912 0 : (forward-char -1)
2913 0 : (goto-char end))
2914 0 : (skip-chars-backward " \t")
2915 0 : (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
2916 83 : modes)))
2917 : ;; Simple -*-MODE-*- case.
2918 0 : (push (intern (concat (downcase (buffer-substring (point) end))
2919 0 : "-mode"))
2920 148 : modes))))
2921 : ;; If we found modes to use, invoke them now, outside the save-excursion.
2922 148 : (if modes
2923 0 : (catch 'nop
2924 0 : (dolist (mode (nreverse modes))
2925 0 : (if (not (functionp mode))
2926 0 : (message "Ignoring unknown mode `%s'" mode)
2927 0 : (setq done t)
2928 0 : (or (set-auto-mode-0 mode keep-mode-if-same)
2929 : ;; continuing would call minor modes again, toggling them off
2930 148 : (throw 'nop nil))))))
2931 : ;; hack-local-variables checks local-enable-local-variables etc, but
2932 : ;; we might as well be explicit here for the sake of clarity.
2933 148 : (and (not done)
2934 148 : enable-local-variables
2935 148 : local-enable-local-variables
2936 148 : try-locals
2937 148 : (setq mode (hack-local-variables t))
2938 2 : (not (memq mode modes)) ; already tried and failed
2939 2 : (if (not (functionp mode))
2940 0 : (message "Ignoring unknown mode `%s'" mode)
2941 2 : (setq done t)
2942 148 : (set-auto-mode-0 mode keep-mode-if-same)))
2943 : ;; If we didn't, look for an interpreter specified in the first line.
2944 : ;; As a special case, allow for things like "#!/bin/env perl", which
2945 : ;; finds the interpreter anywhere in $PATH.
2946 148 : (and (not done)
2947 146 : (setq mode (save-excursion
2948 146 : (goto-char (point-min))
2949 146 : (if (looking-at auto-mode-interpreter-regexp)
2950 146 : (match-string 2))))
2951 : ;; Map interpreter name to a mode, signaling we're done at the
2952 : ;; same time.
2953 0 : (setq done (assoc-default
2954 0 : (file-name-nondirectory mode)
2955 0 : (mapcar (lambda (e)
2956 0 : (cons
2957 0 : (format "\\`%s\\'" (car e))
2958 0 : (cdr e)))
2959 0 : interpreter-mode-alist)
2960 0 : #'string-match-p))
2961 : ;; If we found an interpreter mode to use, invoke it now.
2962 148 : (set-auto-mode-0 done keep-mode-if-same))
2963 : ;; Next try matching the buffer beginning against magic-mode-alist.
2964 148 : (unless done
2965 146 : (if (setq done (save-excursion
2966 146 : (goto-char (point-min))
2967 146 : (save-restriction
2968 146 : (narrow-to-region (point-min)
2969 146 : (min (point-max)
2970 146 : (+ (point-min) magic-mode-regexp-match-limit)))
2971 146 : (assoc-default
2972 146 : nil magic-mode-alist
2973 : (lambda (re _dummy)
2974 0 : (cond
2975 0 : ((functionp re)
2976 0 : (funcall re))
2977 0 : ((stringp re)
2978 0 : (looking-at re))
2979 : (t
2980 0 : (error
2981 : "Problem in magic-mode-alist with element %s"
2982 146 : re))))))))
2983 148 : (set-auto-mode-0 done keep-mode-if-same)))
2984 : ;; Next compare the filename against the entries in auto-mode-alist.
2985 148 : (unless done
2986 146 : (if buffer-file-name
2987 146 : (let ((name buffer-file-name)
2988 146 : (remote-id (file-remote-p buffer-file-name))
2989 146 : (case-insensitive-p (file-name-case-insensitive-p
2990 146 : buffer-file-name)))
2991 : ;; Remove backup-suffixes from file name.
2992 146 : (setq name (file-name-sans-versions name))
2993 : ;; Remove remote file name identification.
2994 146 : (when (and (stringp remote-id)
2995 146 : (string-match (regexp-quote remote-id) name))
2996 146 : (setq name (substring name (match-end 0))))
2997 292 : (while name
2998 : ;; Find first matching alist entry.
2999 146 : (setq mode
3000 146 : (if case-insensitive-p
3001 : ;; Filesystem is case-insensitive.
3002 0 : (let ((case-fold-search t))
3003 0 : (assoc-default name auto-mode-alist
3004 0 : 'string-match))
3005 : ;; Filesystem is case-sensitive.
3006 146 : (or
3007 : ;; First match case-sensitively.
3008 146 : (let ((case-fold-search nil))
3009 146 : (assoc-default name auto-mode-alist
3010 146 : 'string-match))
3011 : ;; Fallback to case-insensitive match.
3012 0 : (and auto-mode-case-fold
3013 0 : (let ((case-fold-search t))
3014 0 : (assoc-default name auto-mode-alist
3015 146 : 'string-match))))))
3016 146 : (if (and mode
3017 146 : (consp mode)
3018 146 : (cadr mode))
3019 0 : (setq mode (car mode)
3020 0 : name (substring name 0 (match-beginning 0)))
3021 146 : (setq name nil))
3022 146 : (when mode
3023 146 : (set-auto-mode-0 mode keep-mode-if-same)
3024 148 : (setq done t))))))
3025 : ;; Next try matching the buffer beginning against magic-fallback-mode-alist.
3026 148 : (unless done
3027 0 : (if (setq done (save-excursion
3028 0 : (goto-char (point-min))
3029 0 : (save-restriction
3030 0 : (narrow-to-region (point-min)
3031 0 : (min (point-max)
3032 0 : (+ (point-min) magic-mode-regexp-match-limit)))
3033 0 : (assoc-default nil magic-fallback-mode-alist
3034 : (lambda (re _dummy)
3035 0 : (cond
3036 0 : ((functionp re)
3037 0 : (funcall re))
3038 0 : ((stringp re)
3039 0 : (looking-at re))
3040 : (t
3041 0 : (error
3042 : "Problem with magic-fallback-mode-alist element: %s"
3043 0 : re))))))))
3044 148 : (set-auto-mode-0 done keep-mode-if-same)))
3045 148 : (unless done
3046 148 : (set-buffer-major-mode (current-buffer)))))
3047 :
3048 : ;; When `keep-mode-if-same' is set, we are working on behalf of
3049 : ;; set-visited-file-name. In that case, if the major mode specified is the
3050 : ;; same one we already have, don't actually reset it. We don't want to lose
3051 : ;; minor modes such as Font Lock.
3052 : (defun set-auto-mode-0 (mode &optional keep-mode-if-same)
3053 : "Apply MODE and return it.
3054 : If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
3055 : any aliases and compared to current major mode. If they are the
3056 : same, do nothing and return nil."
3057 148 : (unless (and keep-mode-if-same
3058 0 : (eq (indirect-function mode)
3059 148 : (indirect-function major-mode)))
3060 148 : (when mode
3061 148 : (funcall mode)
3062 148 : mode)))
3063 :
3064 : (defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
3065 : "Regexp of lines to skip when looking for file-local settings.
3066 : If the first line matches this regular expression, then the -*-...-*- file-
3067 : local settings will be consulted on the second line instead of the first.")
3068 :
3069 : (defun set-auto-mode-1 ()
3070 : "Find the -*- spec in the buffer.
3071 : Call with point at the place to start searching from.
3072 : If one is found, set point to the beginning and return the position
3073 : of the end. Otherwise, return nil; may change point.
3074 : The variable `inhibit-local-variables-regexps' can cause a -*- spec to
3075 : be ignored; but `enable-local-variables' and `local-enable-local-variables'
3076 : have no effect."
3077 465 : (let (beg end)
3078 465 : (and
3079 : ;; Don't look for -*- if this file name matches any
3080 : ;; of the regexps in inhibit-local-variables-regexps.
3081 465 : (not (inhibit-local-variables-p))
3082 465 : (search-forward "-*-" (line-end-position
3083 : ;; If the file begins with "#!" (exec
3084 : ;; interpreter magic), look for mode frobs
3085 : ;; in the first two lines. You cannot
3086 : ;; necessarily put them in the first line
3087 : ;; of such a file without screwing up the
3088 : ;; interpreter invocation. The same holds
3089 : ;; for '\" in man pages (preprocessor
3090 : ;; magic for the `man' program).
3091 465 : (and (looking-at file-auto-mode-skip) 2)) t)
3092 270 : (progn
3093 270 : (skip-chars-forward " \t")
3094 270 : (setq beg (point))
3095 270 : (search-forward "-*-" (line-end-position) t))
3096 270 : (progn
3097 270 : (forward-char -3)
3098 270 : (skip-chars-backward " \t")
3099 270 : (setq end (point))
3100 270 : (goto-char beg)
3101 465 : end))))
3102 :
3103 : ;;; Handling file local variables
3104 :
3105 : (defvar ignored-local-variables
3106 : '(ignored-local-variables safe-local-variable-values
3107 : file-local-variables-alist dir-local-variables-alist)
3108 : "Variables to be ignored in a file's local variable spec.")
3109 : (put 'ignored-local-variables 'risky-local-variable t)
3110 :
3111 : (defvar hack-local-variables-hook nil
3112 : "Normal hook run after processing a file's local variables specs.
3113 : Major modes can use this to examine user-specified local variables
3114 : in order to initialize other data structure based on them.")
3115 :
3116 : (defcustom safe-local-variable-values nil
3117 : "List variable-value pairs that are considered safe.
3118 : Each element is a cons cell (VAR . VAL), where VAR is a variable
3119 : symbol and VAL is a value that is considered safe."
3120 : :risky t
3121 : :group 'find-file
3122 : :type 'alist)
3123 :
3124 : (defcustom safe-local-eval-forms
3125 : ;; This should be here at least as long as Emacs supports write-file-hooks.
3126 : '((add-hook 'write-file-hooks 'time-stamp)
3127 : (add-hook 'write-file-functions 'time-stamp)
3128 : (add-hook 'before-save-hook 'time-stamp nil t)
3129 : (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
3130 : "Expressions that are considered safe in an `eval:' local variable.
3131 : Add expressions to this list if you want Emacs to evaluate them, when
3132 : they appear in an `eval' local variable specification, without first
3133 : asking you for confirmation."
3134 : :risky t
3135 : :group 'find-file
3136 : :version "24.1" ; added write-file-hooks
3137 : :type '(repeat sexp))
3138 :
3139 : ;; Risky local variables:
3140 : (mapc (lambda (var) (put var 'risky-local-variable t))
3141 : '(after-load-alist
3142 : buffer-auto-save-file-name
3143 : buffer-file-name
3144 : buffer-file-truename
3145 : buffer-undo-list
3146 : debugger
3147 : default-text-properties
3148 : eval
3149 : exec-directory
3150 : exec-path
3151 : file-name-handler-alist
3152 : frame-title-format
3153 : global-mode-string
3154 : header-line-format
3155 : icon-title-format
3156 : inhibit-quit
3157 : load-path
3158 : max-lisp-eval-depth
3159 : max-specpdl-size
3160 : minor-mode-map-alist
3161 : minor-mode-overriding-map-alist
3162 : mode-line-format
3163 : mode-name
3164 : overriding-local-map
3165 : overriding-terminal-local-map
3166 : process-environment
3167 : standard-input
3168 : standard-output
3169 : unread-command-events))
3170 :
3171 : ;; Safe local variables:
3172 : ;;
3173 : ;; For variables defined by major modes, the safety declarations can go into
3174 : ;; the major mode's file, since that will be loaded before file variables are
3175 : ;; processed.
3176 : ;;
3177 : ;; For variables defined by minor modes, put the safety declarations in the
3178 : ;; file defining the minor mode after the defcustom/defvar using an autoload
3179 : ;; cookie, e.g.:
3180 : ;;
3181 : ;; ;;;###autoload(put 'variable 'safe-local-variable 'stringp)
3182 : ;;
3183 : ;; Otherwise, when Emacs visits a file specifying that local variable, the
3184 : ;; minor mode file may not be loaded yet.
3185 : ;;
3186 : ;; For variables defined in the C source code the declaration should go here:
3187 :
3188 : (dolist (pair
3189 : '((buffer-read-only . booleanp) ;; C source code
3190 : (default-directory . stringp) ;; C source code
3191 : (fill-column . integerp) ;; C source code
3192 : (indent-tabs-mode . booleanp) ;; C source code
3193 : (left-margin . integerp) ;; C source code
3194 : (no-update-autoloads . booleanp)
3195 : (lexical-binding . booleanp) ;; C source code
3196 : (tab-width . integerp) ;; C source code
3197 : (truncate-lines . booleanp) ;; C source code
3198 : (word-wrap . booleanp) ;; C source code
3199 : (bidi-display-reordering . booleanp))) ;; C source code
3200 : (put (car pair) 'safe-local-variable (cdr pair)))
3201 :
3202 : (put 'bidi-paragraph-direction 'safe-local-variable
3203 : (lambda (v) (memq v '(nil right-to-left left-to-right))))
3204 :
3205 : (put 'c-set-style 'safe-local-eval-function t)
3206 :
3207 : (defvar file-local-variables-alist nil
3208 : "Alist of file-local variable settings in the current buffer.
3209 : Each element in this list has the form (VAR . VALUE), where VAR
3210 : is a file-local variable (a symbol) and VALUE is the value
3211 : specified. The actual value in the buffer may differ from VALUE,
3212 : if it is changed by the major or minor modes, or by the user.")
3213 : (make-variable-buffer-local 'file-local-variables-alist)
3214 : (put 'file-local-variables-alist 'permanent-local t)
3215 :
3216 : (defvar dir-local-variables-alist nil
3217 : "Alist of directory-local variable settings in the current buffer.
3218 : Each element in this list has the form (VAR . VALUE), where VAR
3219 : is a directory-local variable (a symbol) and VALUE is the value
3220 : specified in .dir-locals.el. The actual value in the buffer
3221 : may differ from VALUE, if it is changed by the major or minor modes,
3222 : or by the user.")
3223 : (make-variable-buffer-local 'dir-local-variables-alist)
3224 :
3225 : (defvar before-hack-local-variables-hook nil
3226 : "Normal hook run before setting file-local variables.
3227 : It is called after checking for unsafe/risky variables and
3228 : setting `file-local-variables-alist', and before applying the
3229 : variables stored in `file-local-variables-alist'. A hook
3230 : function is allowed to change the contents of this alist.
3231 :
3232 : This hook is called only if there is at least one file-local
3233 : variable to set.")
3234 :
3235 : (defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
3236 : "Get confirmation before setting up local variable values.
3237 : ALL-VARS is the list of all variables to be set up.
3238 : UNSAFE-VARS is the list of those that aren't marked as safe or risky.
3239 : RISKY-VARS is the list of those that are marked as risky.
3240 : If these settings come from directory-local variables, then
3241 : DIR-NAME is the name of the associated directory. Otherwise it is nil."
3242 0 : (unless noninteractive
3243 0 : (let ((name (cond (dir-name)
3244 0 : (buffer-file-name
3245 0 : (file-name-nondirectory buffer-file-name))
3246 0 : ((concat "buffer " (buffer-name)))))
3247 0 : (offer-save (and (eq enable-local-variables t)
3248 0 : unsafe-vars))
3249 0 : (buf (get-buffer-create "*Local Variables*")))
3250 : ;; Set up the contents of the *Local Variables* buffer.
3251 0 : (with-current-buffer buf
3252 0 : (erase-buffer)
3253 0 : (cond
3254 0 : (unsafe-vars
3255 0 : (insert "The local variables list in " name
3256 : "\ncontains values that may not be safe (*)"
3257 0 : (if risky-vars
3258 : ", and variables that are risky (**)."
3259 0 : ".")))
3260 0 : (risky-vars
3261 0 : (insert "The local variables list in " name
3262 0 : "\ncontains variables that are risky (**)."))
3263 : (t
3264 0 : (insert "A local variables list is specified in " name ".")))
3265 0 : (insert "\n\nDo you want to apply it? You can type
3266 : y -- to apply the local variables list.
3267 0 : n -- to ignore the local variables list.")
3268 0 : (if offer-save
3269 0 : (insert "
3270 : ! -- to apply the local variables list, and permanently mark these
3271 0 : values (*) as safe (in the future, they will be set automatically.)\n\n")
3272 0 : (insert "\n\n"))
3273 0 : (dolist (elt all-vars)
3274 0 : (cond ((member elt unsafe-vars)
3275 0 : (insert " * "))
3276 0 : ((member elt risky-vars)
3277 0 : (insert " ** "))
3278 : (t
3279 0 : (insert " ")))
3280 0 : (princ (car elt) buf)
3281 0 : (insert " : ")
3282 : ;; Make strings with embedded whitespace easier to read.
3283 0 : (let ((print-escape-newlines t))
3284 0 : (prin1 (cdr elt) buf))
3285 0 : (insert "\n"))
3286 0 : (set (make-local-variable 'cursor-type) nil)
3287 0 : (set-buffer-modified-p nil)
3288 0 : (goto-char (point-min)))
3289 :
3290 : ;; Display the buffer and read a choice.
3291 0 : (save-window-excursion
3292 0 : (pop-to-buffer buf)
3293 0 : (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
3294 0 : (prompt (format "Please type %s%s: "
3295 0 : (if offer-save "y, n, or !" "y or n")
3296 0 : (if (< (line-number-at-pos (point-max))
3297 0 : (window-body-height))
3298 : ""
3299 0 : (push ?\C-v exit-chars)
3300 0 : ", or C-v to scroll")))
3301 : char)
3302 0 : (if offer-save (push ?! exit-chars))
3303 0 : (while (null char)
3304 0 : (setq char (read-char-choice prompt exit-chars t))
3305 0 : (when (eq char ?\C-v)
3306 0 : (condition-case nil
3307 0 : (scroll-up)
3308 0 : (error (goto-char (point-min))
3309 0 : (recenter 1)))
3310 0 : (setq char nil)))
3311 0 : (when (and offer-save (= char ?!) unsafe-vars)
3312 0 : (customize-push-and-save 'safe-local-variable-values unsafe-vars))
3313 0 : (prog1 (memq char '(?! ?\s ?y))
3314 0 : (quit-window t)))))))
3315 :
3316 : (defconst hack-local-variable-regexp
3317 : "[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*")
3318 :
3319 : (defun hack-local-variables-prop-line (&optional handle-mode)
3320 : "Return local variables specified in the -*- line.
3321 : Usually returns an alist of elements (VAR . VAL), where VAR is a
3322 : variable and VAL is the specified value. Ignores any
3323 : specification for `coding:', and sometimes for `mode' (which
3324 : should have already been handled by `set-auto-coding' and
3325 : `set-auto-mode', respectively). Return nil if the -*- line is
3326 : malformed.
3327 :
3328 : If HANDLE-MODE is nil, we return the alist of all the local
3329 : variables in the line except `coding' as described above. If it
3330 : is neither nil nor t, we do the same, except that any settings of
3331 : `mode' and `coding' are ignored. If HANDLE-MODE is t, we ignore
3332 : all settings in the line except for `mode', which \(if present) we
3333 : return as the symbol specifying the mode."
3334 296 : (catch 'malformed-line
3335 296 : (save-excursion
3336 296 : (goto-char (point-min))
3337 296 : (let ((end (set-auto-mode-1))
3338 : result)
3339 296 : (cond ((not end)
3340 : nil)
3341 166 : ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
3342 : ;; Simple form: "-*- MODENAME -*-".
3343 0 : (if (eq handle-mode t)
3344 0 : (intern (concat (match-string 1) "-mode"))))
3345 : (t
3346 : ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
3347 : ;; (last ";" is optional).
3348 : ;; If HANDLE-MODE is t, just check for `mode'.
3349 : ;; Otherwise, parse the -*- line into the RESULT alist.
3350 332 : (while (not (or (and (eq handle-mode t) result)
3351 332 : (>= (point) end)))
3352 166 : (unless (looking-at hack-local-variable-regexp)
3353 0 : (message "Malformed mode-line: %S"
3354 0 : (buffer-substring-no-properties (point) end))
3355 166 : (throw 'malformed-line nil))
3356 166 : (goto-char (match-end 0))
3357 : ;; There used to be a downcase here,
3358 : ;; but the manual didn't say so,
3359 : ;; and people want to set var names that aren't all lc.
3360 166 : (let* ((key (intern (match-string 1)))
3361 166 : (val (save-restriction
3362 166 : (narrow-to-region (point) end)
3363 166 : (let ((read-circle nil))
3364 166 : (read (current-buffer)))))
3365 : ;; It is traditional to ignore
3366 : ;; case when checking for `mode' in set-auto-mode,
3367 : ;; so we must do that here as well.
3368 : ;; That is inconsistent, but we're stuck with it.
3369 : ;; The same can be said for `coding' in set-auto-coding.
3370 166 : (keyname (downcase (symbol-name key))))
3371 166 : (cond
3372 166 : ((eq handle-mode t)
3373 83 : (and (equal keyname "mode")
3374 0 : (setq result
3375 0 : (intern (concat (downcase (symbol-name val))
3376 83 : "-mode")))))
3377 83 : ((equal keyname "coding"))
3378 : (t
3379 62 : (when (or (not handle-mode)
3380 62 : (not (equal keyname "mode")))
3381 62 : (condition-case nil
3382 62 : (push (cons (cond ((eq key 'eval) 'eval)
3383 : ;; Downcase "Mode:".
3384 62 : ((equal keyname "mode") 'mode)
3385 62 : (t (indirect-variable key)))
3386 62 : val)
3387 124 : result)
3388 166 : (error nil)))))
3389 166 : (skip-chars-forward " \t;")))
3390 296 : result))))))
3391 :
3392 : (defun hack-local-variables-filter (variables dir-name)
3393 : "Filter local variable settings, querying the user if necessary.
3394 : VARIABLES is the alist of variable-value settings. This alist is
3395 : filtered based on the values of `ignored-local-variables',
3396 : `enable-local-eval', `enable-local-variables', and (if necessary)
3397 : user interaction. The results are added to
3398 : `file-local-variables-alist', without applying them.
3399 : If these settings come from directory-local variables, then
3400 : DIR-NAME is the name of the associated directory. Otherwise it is nil."
3401 : ;; Find those variables that we may want to save to
3402 : ;; `safe-local-variable-values'.
3403 296 : (let (all-vars risky-vars unsafe-vars)
3404 296 : (dolist (elt variables)
3405 713 : (let ((var (car elt))
3406 713 : (val (cdr elt)))
3407 713 : (cond ((memq var ignored-local-variables)
3408 : ;; Ignore any variable in `ignored-local-variables'.
3409 : nil)
3410 : ;; Obey `enable-local-eval'.
3411 713 : ((eq var 'eval)
3412 0 : (when enable-local-eval
3413 0 : (let ((safe (or (hack-one-local-variable-eval-safep val)
3414 : ;; In case previously marked safe (bug#5636).
3415 0 : (safe-local-variable-p var val))))
3416 : ;; If not safe and e-l-v = :safe, ignore totally.
3417 0 : (when (or safe (not (eq enable-local-variables :safe)))
3418 0 : (push elt all-vars)
3419 0 : (or (eq enable-local-eval t)
3420 0 : safe
3421 0 : (push elt unsafe-vars))))))
3422 : ;; Ignore duplicates (except `mode') in the present list.
3423 713 : ((and (assq var all-vars) (not (eq var 'mode))) nil)
3424 : ;; Accept known-safe variables.
3425 713 : ((or (memq var '(mode unibyte coding))
3426 713 : (safe-local-variable-p var val))
3427 1426 : (push elt all-vars))
3428 : ;; The variable is either risky or unsafe:
3429 0 : ((not (eq enable-local-variables :safe))
3430 0 : (push elt all-vars)
3431 0 : (if (risky-local-variable-p var val)
3432 0 : (push elt risky-vars)
3433 713 : (push elt unsafe-vars))))))
3434 296 : (and all-vars
3435 : ;; Query, unless all vars are safe or user wants no querying.
3436 229 : (or (and (eq enable-local-variables t)
3437 229 : (null unsafe-vars)
3438 229 : (null risky-vars))
3439 0 : (memq enable-local-variables '(:all :safe))
3440 0 : (hack-local-variables-confirm all-vars unsafe-vars
3441 229 : risky-vars dir-name))
3442 229 : (dolist (elt all-vars)
3443 713 : (unless (memq (car elt) '(eval mode))
3444 713 : (unless dir-name
3445 121 : (setq dir-local-variables-alist
3446 713 : (assq-delete-all (car elt) dir-local-variables-alist)))
3447 713 : (setq file-local-variables-alist
3448 713 : (assq-delete-all (car elt) file-local-variables-alist)))
3449 1426 : (push elt file-local-variables-alist)))))
3450 :
3451 : ;; TODO? Warn once per file rather than once per session?
3452 : (defvar hack-local-variables--warned-lexical nil)
3453 :
3454 : (defun hack-local-variables (&optional handle-mode)
3455 : "Parse and put into effect this buffer's local variables spec.
3456 : Uses `hack-local-variables-apply' to apply the variables.
3457 :
3458 : If HANDLE-MODE is nil, we apply all the specified local
3459 : variables. If HANDLE-MODE is neither nil nor t, we do the same,
3460 : except that any settings of `mode' are ignored.
3461 :
3462 : If HANDLE-MODE is t, all we do is check whether a \"mode:\"
3463 : is specified, and return the corresponding mode symbol, or nil.
3464 : In this case, we try to ignore minor-modes, and only return a
3465 : major-mode.
3466 :
3467 : If `enable-local-variables' or `local-enable-local-variables' is nil,
3468 : this function does nothing. If `inhibit-local-variables-regexps'
3469 : applies to the file in question, the file is not scanned for
3470 : local variables, but directory-local variables may still be applied."
3471 : ;; We don't let inhibit-local-variables-p influence the value of
3472 : ;; enable-local-variables, because then it would affect dir-local
3473 : ;; variables. We don't want to search eg tar files for file local
3474 : ;; variable sections, but there is no reason dir-locals cannot apply
3475 : ;; to them. The real meaning of inhibit-local-variables-p is "do
3476 : ;; not scan this file for local variables".
3477 296 : (let ((enable-local-variables
3478 296 : (and local-enable-local-variables enable-local-variables))
3479 : result)
3480 296 : (unless (eq handle-mode t)
3481 148 : (setq file-local-variables-alist nil)
3482 148 : (with-demoted-errors "Directory-local variables error: %s"
3483 : ;; Note this is a no-op if enable-local-variables is nil.
3484 296 : (hack-dir-local-variables)))
3485 : ;; This entire function is basically a no-op if enable-local-variables
3486 : ;; is nil. All it does is set file-local-variables-alist to nil.
3487 296 : (when enable-local-variables
3488 : ;; This part used to ignore enable-local-variables when handle-mode
3489 : ;; was t. That was inappropriate, eg consider the
3490 : ;; (artificial) example of:
3491 : ;; (setq local-enable-local-variables nil)
3492 : ;; Open a file foo.txt that contains "mode: sh".
3493 : ;; It correctly opens in text-mode.
3494 : ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
3495 296 : (unless (or (inhibit-local-variables-p)
3496 : ;; If HANDLE-MODE is t, and the prop line specifies a
3497 : ;; mode, then we're done, and have no need to scan further.
3498 296 : (and (setq result (hack-local-variables-prop-line
3499 296 : handle-mode))
3500 296 : (eq handle-mode t)))
3501 : ;; Look for "Local variables:" line in last page.
3502 296 : (save-excursion
3503 296 : (goto-char (point-max))
3504 296 : (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
3505 296 : 'move)
3506 296 : (when (let ((case-fold-search t))
3507 296 : (search-forward "Local Variables:" nil t))
3508 46 : (skip-chars-forward " \t")
3509 : ;; suffix is what comes after "local variables:" in its line.
3510 : ;; prefix is what comes before "local variables:" in its line.
3511 46 : (let ((suffix
3512 46 : (concat
3513 46 : (regexp-quote (buffer-substring (point)
3514 46 : (line-end-position)))
3515 46 : "$"))
3516 : (prefix
3517 46 : (concat "^" (regexp-quote
3518 46 : (buffer-substring (line-beginning-position)
3519 46 : (match-beginning 0))))))
3520 :
3521 46 : (forward-line 1)
3522 46 : (let ((startpos (point))
3523 : endpos
3524 46 : (thisbuf (current-buffer)))
3525 46 : (save-excursion
3526 46 : (unless (let ((case-fold-search t))
3527 46 : (re-search-forward
3528 46 : (concat prefix "[ \t]*End:[ \t]*" suffix)
3529 46 : nil t))
3530 : ;; This used to be an error, but really all it means is
3531 : ;; that this may simply not be a local-variables section,
3532 : ;; so just ignore it.
3533 46 : (message "Local variables list is not properly terminated"))
3534 46 : (beginning-of-line)
3535 46 : (setq endpos (point)))
3536 :
3537 46 : (with-temp-buffer
3538 46 : (insert-buffer-substring thisbuf startpos endpos)
3539 46 : (goto-char (point-min))
3540 46 : (subst-char-in-region (point) (point-max) ?\^m ?\n)
3541 208 : (while (not (eobp))
3542 : ;; Discard the prefix.
3543 162 : (if (looking-at prefix)
3544 162 : (delete-region (point) (match-end 0))
3545 162 : (error "Local variables entry is missing the prefix"))
3546 162 : (end-of-line)
3547 : ;; Discard the suffix.
3548 162 : (if (looking-back suffix (line-beginning-position))
3549 162 : (delete-region (match-beginning 0) (point))
3550 162 : (error "Local variables entry is missing the suffix"))
3551 162 : (forward-line 1))
3552 46 : (goto-char (point-min))
3553 :
3554 206 : (while (not (or (eobp)
3555 206 : (and (eq handle-mode t) result)))
3556 : ;; Find the variable name;
3557 160 : (unless (looking-at hack-local-variable-regexp)
3558 0 : (error "Malformed local variable line: %S"
3559 0 : (buffer-substring-no-properties
3560 160 : (point) (line-end-position))))
3561 160 : (goto-char (match-end 1))
3562 160 : (let* ((str (match-string 1))
3563 160 : (var (intern str))
3564 : val val2)
3565 160 : (and (equal (downcase (symbol-name var)) "mode")
3566 160 : (setq var 'mode))
3567 : ;; Read the variable value.
3568 160 : (skip-chars-forward "^:")
3569 160 : (forward-char 1)
3570 160 : (let ((read-circle nil))
3571 160 : (setq val (read (current-buffer))))
3572 160 : (if (eq handle-mode t)
3573 79 : (and (eq var 'mode)
3574 : ;; Specifying minor-modes via mode: is
3575 : ;; deprecated, but try to reject them anyway.
3576 2 : (not (string-match
3577 : "-minor\\'"
3578 2 : (setq val2 (downcase (symbol-name val)))))
3579 79 : (setq result (intern (concat val2 "-mode"))))
3580 81 : (cond ((eq var 'coding))
3581 61 : ((eq var 'lexical-binding)
3582 0 : (unless hack-local-variables--warned-lexical
3583 0 : (setq hack-local-variables--warned-lexical t)
3584 0 : (display-warning
3585 : 'files
3586 0 : (format-message
3587 : "%s: `lexical-binding' at end of file unreliable"
3588 0 : (file-name-nondirectory
3589 : ;; We are called from
3590 : ;; 'with-temp-buffer', so we need
3591 : ;; to use 'thisbuf's name in the
3592 : ;; warning message.
3593 0 : (or (buffer-file-name thisbuf) ""))))))
3594 61 : ((and (eq var 'mode) handle-mode))
3595 : (t
3596 59 : (ignore-errors
3597 59 : (push (cons (if (eq var 'eval)
3598 : 'eval
3599 59 : (indirect-variable var))
3600 160 : val) result))))))
3601 296 : (forward-line 1))))))))
3602 : ;; Now we've read all the local variables.
3603 : ;; If HANDLE-MODE is t, return whether the mode was specified.
3604 296 : (if (eq handle-mode t) result
3605 : ;; Otherwise, set the variables.
3606 148 : (hack-local-variables-filter result nil)
3607 296 : (hack-local-variables-apply)))))
3608 :
3609 : (defun hack-local-variables-apply ()
3610 : "Apply the elements of `file-local-variables-alist'.
3611 : If there are any elements, runs `before-hack-local-variables-hook',
3612 : then calls `hack-one-local-variable' to apply the alist elements one by one.
3613 : Finishes by running `hack-local-variables-hook', regardless of whether
3614 : the alist is empty or not.
3615 :
3616 : Note that this function ignores a `mode' entry if it specifies the same
3617 : major mode as the buffer already has."
3618 226 : (when file-local-variables-alist
3619 : ;; Any 'evals must run in the Right sequence.
3620 173 : (setq file-local-variables-alist
3621 173 : (nreverse file-local-variables-alist))
3622 173 : (run-hooks 'before-hack-local-variables-hook)
3623 173 : (dolist (elt file-local-variables-alist)
3624 763 : (hack-one-local-variable (car elt) (cdr elt))))
3625 226 : (run-hooks 'hack-local-variables-hook))
3626 :
3627 : (defun safe-local-variable-p (sym val)
3628 : "Non-nil if SYM is safe as a file-local variable with value VAL.
3629 : It is safe if any of these conditions are met:
3630 :
3631 : * There is a matching entry (SYM . VAL) in the
3632 : `safe-local-variable-values' user option.
3633 :
3634 : * The `safe-local-variable' property of SYM is a function that
3635 : evaluates to a non-nil value with VAL as an argument."
3636 713 : (or (member (cons sym val) safe-local-variable-values)
3637 713 : (let ((safep (get sym 'safe-local-variable)))
3638 713 : (and (functionp safep)
3639 : ;; If the function signals an error, that means it
3640 : ;; can't assure us that the value is safe.
3641 713 : (with-demoted-errors (funcall safep val))))))
3642 :
3643 : (defun risky-local-variable-p (sym &optional _ignored)
3644 : "Non-nil if SYM could be dangerous as a file-local variable.
3645 : It is dangerous if either of these conditions are met:
3646 :
3647 : * Its `risky-local-variable' property is non-nil.
3648 :
3649 : * Its name ends with \"hook(s)\", \"function(s)\", \"form(s)\", \"map\",
3650 : \"program\", \"command(s)\", \"predicate(s)\", \"frame-alist\",
3651 : \"mode-alist\", \"font-lock-(syntactic-)keyword*\",
3652 : \"map-alist\", or \"bindat-spec\"."
3653 : ;; If this is an alias, check the base name.
3654 0 : (condition-case nil
3655 0 : (setq sym (indirect-variable sym))
3656 0 : (error nil))
3657 0 : (or (get sym 'risky-local-variable)
3658 0 : (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|\
3659 : -commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords\
3660 : -[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|\
3661 0 : -map$\\|-map-alist$\\|-bindat-spec$" (symbol-name sym))))
3662 :
3663 : (defun hack-one-local-variable-quotep (exp)
3664 0 : (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
3665 :
3666 : (defun hack-one-local-variable-constantp (exp)
3667 0 : (or (and (not (symbolp exp)) (not (consp exp)))
3668 0 : (memq exp '(t nil))
3669 0 : (keywordp exp)
3670 0 : (hack-one-local-variable-quotep exp)))
3671 :
3672 : (defun hack-one-local-variable-eval-safep (exp)
3673 : "Return t if it is safe to eval EXP when it is found in a file."
3674 0 : (or (not (consp exp))
3675 : ;; Detect certain `put' expressions.
3676 0 : (and (eq (car exp) 'put)
3677 0 : (hack-one-local-variable-quotep (nth 1 exp))
3678 0 : (hack-one-local-variable-quotep (nth 2 exp))
3679 0 : (let ((prop (nth 1 (nth 2 exp)))
3680 0 : (val (nth 3 exp)))
3681 0 : (cond ((memq prop '(lisp-indent-hook
3682 : lisp-indent-function
3683 0 : scheme-indent-function))
3684 : ;; Only allow safe values (not functions).
3685 0 : (or (numberp val)
3686 0 : (and (hack-one-local-variable-quotep val)
3687 0 : (eq (nth 1 val) 'defun))))
3688 0 : ((eq prop 'edebug-form-spec)
3689 : ;; Only allow indirect form specs.
3690 : ;; During bootstrapping, edebug-basic-spec might not be
3691 : ;; defined yet.
3692 0 : (and (fboundp 'edebug-basic-spec)
3693 0 : (hack-one-local-variable-quotep val)
3694 0 : (edebug-basic-spec (nth 1 val)))))))
3695 : ;; Allow expressions that the user requested.
3696 0 : (member exp safe-local-eval-forms)
3697 : ;; Certain functions can be allowed with safe arguments
3698 : ;; or can specify verification functions to try.
3699 0 : (and (symbolp (car exp))
3700 : ;; Allow (minor)-modes calls with no arguments.
3701 : ;; This obsoletes the use of "mode:" for such things. (Bug#8613)
3702 0 : (or (and (member (cdr exp) '(nil (1) (0) (-1)))
3703 0 : (string-match "-mode\\'" (symbol-name (car exp))))
3704 0 : (let ((prop (get (car exp) 'safe-local-eval-function)))
3705 0 : (cond ((eq prop t)
3706 0 : (let ((ok t))
3707 0 : (dolist (arg (cdr exp))
3708 0 : (unless (hack-one-local-variable-constantp arg)
3709 0 : (setq ok nil)))
3710 0 : ok))
3711 0 : ((functionp prop)
3712 0 : (funcall prop exp))
3713 0 : ((listp prop)
3714 0 : (let ((ok nil))
3715 0 : (dolist (function prop)
3716 0 : (if (funcall function exp)
3717 0 : (setq ok t)))
3718 0 : ok))))))))
3719 :
3720 : (defun hack-one-local-variable--obsolete (var)
3721 763 : (let ((o (get var 'byte-obsolete-variable)))
3722 763 : (when o
3723 0 : (let ((instead (nth 0 o))
3724 0 : (since (nth 2 o)))
3725 0 : (message "%s is obsolete%s; %s"
3726 0 : var (if since (format " (since %s)" since))
3727 0 : (if (stringp instead)
3728 0 : (substitute-command-keys instead)
3729 763 : (format-message "use `%s' instead" instead)))))))
3730 :
3731 : (defun hack-one-local-variable (var val)
3732 : "Set local variable VAR with value VAL.
3733 : If VAR is `mode', call `VAL-mode' as a function unless it's
3734 : already the major mode."
3735 763 : (pcase var
3736 : (`mode
3737 0 : (let ((mode (intern (concat (downcase (symbol-name val))
3738 0 : "-mode"))))
3739 0 : (unless (eq (indirect-function mode)
3740 0 : (indirect-function major-mode))
3741 0 : (funcall mode))))
3742 : (`eval
3743 0 : (pcase val
3744 0 : (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
3745 0 : (save-excursion (eval val)))
3746 : (_
3747 763 : (hack-one-local-variable--obsolete var)
3748 : ;; Make sure the string has no text properties.
3749 : ;; Some text properties can get evaluated in various ways,
3750 : ;; so it is risky to put them on with a local variable list.
3751 763 : (if (stringp val)
3752 763 : (set-text-properties 0 (length val) nil val))
3753 763 : (set (make-local-variable var) val))))
3754 :
3755 : ;;; Handling directory-local variables, aka project settings.
3756 :
3757 : (defvar dir-locals-class-alist '()
3758 : "Alist mapping directory-local variable classes (symbols) to variable lists.")
3759 :
3760 : (defvar dir-locals-directory-cache '()
3761 : "List of cached directory roots for directory-local variable classes.
3762 : Each element in this list has the form (DIR CLASS MTIME).
3763 : DIR is the name of the directory.
3764 : CLASS is the name of a variable class (a symbol).
3765 : MTIME is the recorded modification time of the directory-local
3766 : variables file associated with this entry. This time is a list
3767 : of integers (the same format as `file-attributes'), and is
3768 : used to test whether the cache entry is still valid.
3769 : Alternatively, MTIME can be nil, which means the entry is always
3770 : considered valid.")
3771 :
3772 : (defsubst dir-locals-get-class-variables (class)
3773 : "Return the variable list for CLASS."
3774 148 : (cdr (assq class dir-locals-class-alist)))
3775 :
3776 : (defun dir-locals-collect-mode-variables (mode-variables variables)
3777 : "Collect directory-local variables from MODE-VARIABLES.
3778 : VARIABLES is the initial list of variables.
3779 : Returns the new list."
3780 296 : (dolist (pair mode-variables variables)
3781 592 : (let* ((variable (car pair))
3782 592 : (value (cdr pair))
3783 592 : (slot (assq variable variables)))
3784 : ;; If variables are specified more than once, only use the last. (Why?)
3785 : ;; The pseudo-variables mode and eval are different (bug#3430).
3786 592 : (if (and slot (not (memq variable '(mode eval))))
3787 0 : (setcdr slot value)
3788 : ;; Need a new cons in case we setcdr later.
3789 1184 : (push (cons variable value) variables)))))
3790 :
3791 : (defun dir-locals-collect-variables (class-variables root variables)
3792 : "Collect entries from CLASS-VARIABLES into VARIABLES.
3793 : ROOT is the root directory of the project.
3794 : Return the new variables list."
3795 148 : (let* ((file-name (or (buffer-file-name)
3796 : ;; Handle non-file buffers, too.
3797 148 : (expand-file-name default-directory)))
3798 148 : (sub-file-name (if (and file-name
3799 148 : (file-name-absolute-p file-name))
3800 : ;; FIXME: Why not use file-relative-name?
3801 148 : (substring file-name (length root)))))
3802 148 : (condition-case err
3803 148 : (dolist (entry class-variables variables)
3804 1036 : (let ((key (car entry)))
3805 1036 : (cond
3806 1036 : ((stringp key)
3807 : ;; Don't include this in the previous condition, because we
3808 : ;; want to filter all strings before the next condition.
3809 0 : (when (and sub-file-name
3810 0 : (>= (length sub-file-name) (length key))
3811 0 : (string-prefix-p key sub-file-name))
3812 0 : (setq variables (dir-locals-collect-variables
3813 0 : (cdr entry) root variables))))
3814 1036 : ((or (not key)
3815 1036 : (derived-mode-p key))
3816 296 : (let* ((alist (cdr entry))
3817 296 : (subdirs (assq 'subdirs alist)))
3818 296 : (if (or (not subdirs)
3819 0 : (progn
3820 0 : (setq alist (delq subdirs alist))
3821 0 : (cdr-safe subdirs))
3822 : ;; TODO someone might want to extend this to allow
3823 : ;; integer values for subdir, where N means
3824 : ;; variables apply to this directory and N levels
3825 : ;; below it (0 == nil).
3826 296 : (equal root default-directory))
3827 296 : (setq variables (dir-locals-collect-mode-variables
3828 1036 : alist variables))))))))
3829 : (error
3830 : ;; The file's content might be invalid (e.g. have a merge conflict), but
3831 : ;; that shouldn't prevent the user from opening the file.
3832 0 : (message "%s error: %s" dir-locals-file (error-message-string err))
3833 148 : nil))))
3834 :
3835 : (defun dir-locals-set-directory-class (directory class &optional mtime)
3836 : "Declare that the DIRECTORY root is an instance of CLASS.
3837 : DIRECTORY is the name of a directory, a string.
3838 : CLASS is the name of a project class, a symbol.
3839 : MTIME is either the modification time of the directory-local
3840 : variables file that defined this class, or nil.
3841 :
3842 : When a file beneath DIRECTORY is visited, the mode-specific
3843 : variables from CLASS are applied to the buffer. The variables
3844 : for a class are defined using `dir-locals-set-class-variables'."
3845 0 : (setq directory (file-name-as-directory (expand-file-name directory)))
3846 0 : (unless (assq class dir-locals-class-alist)
3847 0 : (error "No such class `%s'" (symbol-name class)))
3848 0 : (push (list directory class mtime) dir-locals-directory-cache))
3849 :
3850 : (defun dir-locals-set-class-variables (class variables)
3851 : "Map the type CLASS to a list of variable settings.
3852 : CLASS is the project class, a symbol. VARIABLES is a list
3853 : that declares directory-local variables for the class.
3854 : An element in VARIABLES is either of the form:
3855 : (MAJOR-MODE . ALIST)
3856 : or
3857 : (DIRECTORY . LIST)
3858 :
3859 : In the first form, MAJOR-MODE is a symbol, and ALIST is an alist
3860 : whose elements are of the form (VARIABLE . VALUE).
3861 :
3862 : In the second form, DIRECTORY is a directory name (a string), and
3863 : LIST is a list of the form accepted by the function.
3864 :
3865 : When a file is visited, the file's class is found. A directory
3866 : may be assigned a class using `dir-locals-set-directory-class'.
3867 : Then variables are set in the file's buffer according to the
3868 : VARIABLES list of the class. The list is processed in order.
3869 :
3870 : * If the element is of the form (MAJOR-MODE . ALIST), and the
3871 : buffer's major mode is derived from MAJOR-MODE (as determined
3872 : by `derived-mode-p'), then all the variables in ALIST are
3873 : applied. A MAJOR-MODE of nil may be used to match any buffer.
3874 : `make-local-variable' is called for each variable before it is
3875 : set.
3876 :
3877 : * If the element is of the form (DIRECTORY . LIST), and DIRECTORY
3878 : is an initial substring of the file's directory, then LIST is
3879 : applied by recursively following these rules."
3880 0 : (setf (alist-get class dir-locals-class-alist) variables))
3881 :
3882 : (defconst dir-locals-file ".dir-locals.el"
3883 : "File that contains directory-local variables.
3884 : It has to be constant to enforce uniform values across different
3885 : environments and users.
3886 : See also `dir-locals-file-2', whose values override this one's.
3887 : See Info node `(elisp)Directory Local Variables' for details.")
3888 :
3889 : (defconst dir-locals-file-2 ".dir-locals-2.el"
3890 : "File that contains directory-local variables.
3891 : This essentially a second file that can be used like
3892 : `dir-locals-file', so that users can have specify their personal
3893 : dir-local variables even if the current directory already has a
3894 : `dir-locals-file' that is shared with other users (such as in a
3895 : git repository).
3896 : See Info node `(elisp)Directory Local Variables' for details.")
3897 :
3898 : (defun dir-locals--all-files (directory)
3899 : "Return a list of all readable dir-locals files in DIRECTORY.
3900 : The returned list is sorted by increasing priority. That is,
3901 : values specified in the last file should take precedence over
3902 : those in the first."
3903 540 : (when (file-readable-p directory)
3904 540 : (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
3905 0 : (dosified-file-name dir-locals-file)
3906 540 : dir-locals-file)
3907 540 : directory))
3908 540 : (file-2 (when (string-match "\\.el\\'" file-1)
3909 540 : (replace-match "-2.el" t nil file-1)))
3910 : (out nil))
3911 : ;; The order here is important.
3912 540 : (dolist (f (list file-2 file-1))
3913 1080 : (when (and f
3914 1080 : (file-readable-p f)
3915 296 : (file-regular-p f)
3916 1080 : (not (file-directory-p f)))
3917 1080 : (push f out)))
3918 540 : out)))
3919 :
3920 : (defun dir-locals-find-file (file)
3921 : "Find the directory-local variables for FILE.
3922 : This searches upward in the directory tree from FILE.
3923 : It stops at the first directory that has been registered in
3924 : `dir-locals-directory-cache' or contains a `dir-locals-file'.
3925 : If it finds an entry in the cache, it checks that it is valid.
3926 : A cache entry with no modification time element (normally, one that
3927 : has been assigned directly using `dir-locals-set-directory-class', not
3928 : set from a file) is always valid.
3929 : A cache entry based on a `dir-locals-file' is valid if the modification
3930 : time stored in the cache matches the current file modification time.
3931 : If not, the cache entry is cleared so that the file will be re-read.
3932 :
3933 : This function returns either:
3934 : - nil (no directory local variables found),
3935 : - the matching entry from `dir-locals-directory-cache' (a list),
3936 : - or the full path to the directory (a string) containing at
3937 : least one `dir-locals-file' in the case of no valid cache
3938 : entry."
3939 148 : (setq file (expand-file-name file))
3940 148 : (let* ((locals-dir (locate-dominating-file (file-name-directory file)
3941 148 : #'dir-locals--all-files))
3942 : dir-elt)
3943 : ;; `locate-dominating-file' may have abbreviated the name.
3944 148 : (when locals-dir
3945 148 : (setq locals-dir (expand-file-name locals-dir)))
3946 : ;; Find the best cached value in `dir-locals-directory-cache'.
3947 148 : (dolist (elt dir-locals-directory-cache)
3948 148 : (when (and (string-prefix-p (car elt) file
3949 148 : (memq system-type
3950 148 : '(windows-nt cygwin ms-dos)))
3951 148 : (> (length (car elt)) (length (car dir-elt))))
3952 148 : (setq dir-elt elt)))
3953 148 : (if (and dir-elt
3954 148 : (or (null locals-dir)
3955 148 : (<= (length locals-dir)
3956 148 : (length (car dir-elt)))))
3957 : ;; Found a potential cache entry. Check validity.
3958 : ;; A cache entry with no MTIME is assumed to always be valid
3959 : ;; (ie, set directly, not from a dir-locals file).
3960 : ;; Note, we don't bother to check that there is a matching class
3961 : ;; element in dir-locals-class-alist, since that's done by
3962 : ;; dir-locals-set-directory-class.
3963 148 : (if (or (null (nth 2 dir-elt))
3964 148 : (let ((cached-files (dir-locals--all-files (car dir-elt))))
3965 : ;; The entry MTIME should match the most recent
3966 : ;; MTIME among matching files.
3967 148 : (and cached-files
3968 148 : (= (float-time (nth 2 dir-elt))
3969 148 : (apply #'max (mapcar (lambda (f)
3970 148 : (float-time
3971 148 : (nth 5 (file-attributes f))))
3972 148 : cached-files))))))
3973 : ;; This cache entry is OK.
3974 148 : dir-elt
3975 : ;; This cache entry is invalid; clear it.
3976 0 : (setq dir-locals-directory-cache
3977 0 : (delq dir-elt dir-locals-directory-cache))
3978 : ;; Return the first existing dir-locals file. Might be the same
3979 : ;; as dir-elt's, might not (eg latter might have been deleted).
3980 148 : locals-dir)
3981 : ;; No cache entry.
3982 148 : locals-dir)))
3983 :
3984 : (defun dir-locals-read-from-dir (dir)
3985 : "Load all variables files in DIR and register a new class and instance.
3986 : DIR is the absolute name of a directory which must contain at
3987 : least one dir-local file (which is a file holding variables to
3988 : apply).
3989 : Return the new class name, which is a symbol named DIR."
3990 0 : (require 'map)
3991 0 : (let* ((class-name (intern dir))
3992 0 : (files (dir-locals--all-files dir))
3993 : (read-circle nil)
3994 : (success nil)
3995 : (variables))
3996 0 : (with-demoted-errors "Error reading dir-locals: %S"
3997 0 : (dolist (file files)
3998 0 : (with-temp-buffer
3999 0 : (insert-file-contents file)
4000 0 : (condition-case-unless-debug nil
4001 0 : (setq variables
4002 0 : (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
4003 0 : variables
4004 0 : (read (current-buffer))))
4005 0 : (end-of-file nil))))
4006 0 : (setq success t))
4007 0 : (dir-locals-set-class-variables class-name variables)
4008 0 : (dir-locals-set-directory-class
4009 0 : dir class-name
4010 0 : (seconds-to-time
4011 0 : (if success
4012 0 : (apply #'max (mapcar (lambda (file)
4013 0 : (float-time (nth 5 (file-attributes file))))
4014 0 : files))
4015 : ;; If there was a problem, use the values we could get but
4016 : ;; don't let the cache prevent future reads.
4017 0 : 0)))
4018 0 : class-name))
4019 :
4020 : (define-obsolete-function-alias 'dir-locals-read-from-file
4021 : 'dir-locals-read-from-dir "25.1")
4022 :
4023 : (defcustom enable-remote-dir-locals nil
4024 : "Non-nil means dir-local variables will be applied to remote files."
4025 : :version "24.3"
4026 : :type 'boolean
4027 : :group 'find-file)
4028 :
4029 : (defvar hack-dir-local-variables--warned-coding nil)
4030 :
4031 : (defun hack-dir-local-variables ()
4032 : "Read per-directory local variables for the current buffer.
4033 : Store the directory-local variables in `dir-local-variables-alist'
4034 : and `file-local-variables-alist', without applying them.
4035 :
4036 : This does nothing if either `enable-local-variables' or
4037 : `enable-dir-local-variables' are nil."
4038 154 : (when (and enable-local-variables
4039 154 : enable-dir-local-variables
4040 154 : (or enable-remote-dir-locals
4041 154 : (not (file-remote-p (or (buffer-file-name)
4042 154 : default-directory)))))
4043 : ;; Find the variables file.
4044 148 : (let ((dir-or-cache (dir-locals-find-file
4045 148 : (or (buffer-file-name) default-directory)))
4046 : (class nil)
4047 : (dir-name nil))
4048 148 : (cond
4049 148 : ((stringp dir-or-cache)
4050 0 : (setq dir-name dir-or-cache
4051 0 : class (dir-locals-read-from-dir dir-or-cache)))
4052 148 : ((consp dir-or-cache)
4053 148 : (setq dir-name (nth 0 dir-or-cache))
4054 148 : (setq class (nth 1 dir-or-cache))))
4055 148 : (when class
4056 148 : (let ((variables
4057 148 : (dir-locals-collect-variables
4058 148 : (dir-locals-get-class-variables class) dir-name nil)))
4059 148 : (when variables
4060 148 : (dolist (elt variables)
4061 592 : (if (eq (car elt) 'coding)
4062 0 : (unless hack-dir-local-variables--warned-coding
4063 0 : (setq hack-dir-local-variables--warned-coding t)
4064 0 : (display-warning 'files
4065 0 : "Coding cannot be specified by dir-locals"))
4066 592 : (unless (memq (car elt) '(eval mode))
4067 592 : (setq dir-local-variables-alist
4068 592 : (assq-delete-all (car elt) dir-local-variables-alist)))
4069 1184 : (push elt dir-local-variables-alist)))
4070 154 : (hack-local-variables-filter variables dir-name)))))))
4071 :
4072 : (defun hack-dir-local-variables-non-file-buffer ()
4073 : "Apply directory-local variables to a non-file buffer.
4074 : For non-file buffers, such as Dired buffers, directory-local
4075 : variables are looked for in `default-directory' and its parent
4076 : directories."
4077 6 : (hack-dir-local-variables)
4078 6 : (hack-local-variables-apply))
4079 :
4080 :
4081 : (defcustom change-major-mode-with-file-name t
4082 : "Non-nil means \\[write-file] should set the major mode from the file name.
4083 : However, the mode will not be changed if
4084 : \(1) a local variables list or the `-*-' line specifies a major mode, or
4085 : \(2) the current major mode is a \"special\" mode,
4086 : not suitable for ordinary files, or
4087 : \(3) the new file name does not particularly specify any mode."
4088 : :type 'boolean
4089 : :group 'editing-basics)
4090 :
4091 : (defun set-visited-file-name (filename &optional no-query along-with-file)
4092 : "Change name of file visited in current buffer to FILENAME.
4093 : This also renames the buffer to correspond to the new file.
4094 : The next time the buffer is saved it will go in the newly specified file.
4095 : FILENAME nil or an empty string means mark buffer as not visiting any file.
4096 : Remember to delete the initial contents of the minibuffer
4097 : if you wish to pass an empty string as the argument.
4098 :
4099 : The optional second argument NO-QUERY, if non-nil, inhibits asking for
4100 : confirmation in the case where another buffer is already visiting FILENAME.
4101 :
4102 : The optional third argument ALONG-WITH-FILE, if non-nil, means that
4103 : the old visited file has been renamed to the new name FILENAME."
4104 : (interactive "FSet visited file name: ")
4105 0 : (if (buffer-base-buffer)
4106 0 : (error "An indirect buffer cannot visit a file"))
4107 0 : (let (truename old-try-locals)
4108 0 : (if filename
4109 0 : (setq filename
4110 0 : (if (string-equal filename "")
4111 : nil
4112 0 : (expand-file-name filename))))
4113 0 : (if filename
4114 0 : (progn
4115 0 : (setq truename (file-truename filename))
4116 0 : (if find-file-visit-truename
4117 0 : (setq filename truename))))
4118 0 : (if filename
4119 0 : (let ((new-name (file-name-nondirectory filename)))
4120 0 : (if (string= new-name "")
4121 0 : (error "Empty file name"))))
4122 0 : (let ((buffer (and filename (find-buffer-visiting filename))))
4123 0 : (and buffer (not (eq buffer (current-buffer)))
4124 0 : (not no-query)
4125 0 : (not (y-or-n-p (format "A buffer is visiting %s; proceed? "
4126 0 : filename)))
4127 0 : (user-error "Aborted")))
4128 0 : (or (equal filename buffer-file-name)
4129 0 : (progn
4130 0 : (and filename (lock-buffer filename))
4131 0 : (unlock-buffer)))
4132 0 : (setq old-try-locals (not (inhibit-local-variables-p))
4133 0 : buffer-file-name filename)
4134 0 : (if filename ; make buffer name reflect filename.
4135 0 : (let ((new-name (file-name-nondirectory buffer-file-name)))
4136 0 : (setq default-directory (file-name-directory buffer-file-name))
4137 : ;; If new-name == old-name, renaming would add a spurious <2>
4138 : ;; and it's considered as a feature in rename-buffer.
4139 0 : (or (string= new-name (buffer-name))
4140 0 : (rename-buffer new-name t))))
4141 0 : (setq buffer-backed-up nil)
4142 0 : (or along-with-file
4143 0 : (clear-visited-file-modtime))
4144 : ;; Abbreviate the file names of the buffer.
4145 0 : (if truename
4146 0 : (progn
4147 0 : (setq buffer-file-truename (abbreviate-file-name truename))
4148 0 : (if find-file-visit-truename
4149 0 : (setq buffer-file-name truename))))
4150 0 : (setq buffer-file-number
4151 0 : (if filename
4152 0 : (nthcdr 10 (file-attributes buffer-file-name))
4153 0 : nil))
4154 : ;; write-file-functions is normally used for things like ftp-find-file
4155 : ;; that visit things that are not local files as if they were files.
4156 : ;; Changing to visit an ordinary local file instead should flush the hook.
4157 0 : (kill-local-variable 'write-file-functions)
4158 0 : (kill-local-variable 'local-write-file-hooks)
4159 0 : (kill-local-variable 'revert-buffer-function)
4160 0 : (kill-local-variable 'backup-inhibited)
4161 : ;; If buffer was read-only because of version control,
4162 : ;; that reason is gone now, so make it writable.
4163 0 : (if vc-mode
4164 0 : (setq buffer-read-only nil))
4165 0 : (kill-local-variable 'vc-mode)
4166 : ;; Turn off backup files for certain file names.
4167 : ;; Since this is a permanent local, the major mode won't eliminate it.
4168 0 : (and buffer-file-name
4169 0 : backup-enable-predicate
4170 0 : (not (funcall backup-enable-predicate buffer-file-name))
4171 0 : (progn
4172 0 : (make-local-variable 'backup-inhibited)
4173 0 : (setq backup-inhibited t)))
4174 0 : (let ((oauto buffer-auto-save-file-name))
4175 0 : (cond ((null filename)
4176 0 : (setq buffer-auto-save-file-name nil))
4177 0 : ((not buffer-auto-save-file-name)
4178 : ;; If auto-save was not already on, turn it on if appropriate.
4179 0 : (and buffer-file-name auto-save-default (auto-save-mode t)))
4180 : (t
4181 : ;; If auto save is on, start using a new name. We
4182 : ;; deliberately don't rename or delete the old auto save
4183 : ;; for the old visited file name. This is because
4184 : ;; perhaps the user wants to save the new state and then
4185 : ;; compare with the previous state from the auto save
4186 : ;; file.
4187 0 : (setq buffer-auto-save-file-name (make-auto-save-file-name))))
4188 : ;; Rename the old auto save file if any.
4189 0 : (and oauto buffer-auto-save-file-name
4190 0 : (file-exists-p oauto)
4191 0 : (rename-file oauto buffer-auto-save-file-name t)))
4192 0 : (and buffer-file-name
4193 0 : (not along-with-file)
4194 0 : (set-buffer-modified-p t))
4195 : ;; Update the major mode, if the file name determines it.
4196 0 : (condition-case nil
4197 : ;; Don't change the mode if it is special.
4198 0 : (or (not change-major-mode-with-file-name)
4199 0 : (get major-mode 'mode-class)
4200 : ;; Don't change the mode if the local variable list specifies it.
4201 : ;; The file name can influence whether the local variables apply.
4202 0 : (and old-try-locals
4203 : ;; h-l-v also checks it, but might as well be explicit.
4204 0 : (not (inhibit-local-variables-p))
4205 0 : (hack-local-variables t))
4206 : ;; TODO consider making normal-mode handle this case.
4207 0 : (let ((old major-mode))
4208 0 : (set-auto-mode t)
4209 0 : (or (eq old major-mode)
4210 0 : (hack-local-variables))))
4211 0 : (error nil))))
4212 :
4213 : (defun write-file (filename &optional confirm)
4214 : "Write current buffer into file FILENAME.
4215 : This makes the buffer visit that file, and marks it as not modified.
4216 :
4217 : If you specify just a directory name as FILENAME, that means to use
4218 : the default file name but in that directory. You can also yank
4219 : the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
4220 :
4221 : If the buffer is not already visiting a file, the default file name
4222 : for the output file is the buffer name.
4223 :
4224 : If optional second arg CONFIRM is non-nil, this function
4225 : asks for confirmation before overwriting an existing file.
4226 : Interactively, confirmation is required unless you supply a prefix argument."
4227 : ;; (interactive "FWrite file: ")
4228 : (interactive
4229 0 : (list (if buffer-file-name
4230 0 : (read-file-name "Write file: "
4231 0 : nil nil nil nil)
4232 0 : (read-file-name "Write file: " default-directory
4233 0 : (expand-file-name
4234 0 : (file-name-nondirectory (buffer-name))
4235 0 : default-directory)
4236 0 : nil nil))
4237 0 : (not current-prefix-arg)))
4238 0 : (or (null filename) (string-equal filename "")
4239 0 : (progn
4240 : ;; If arg is just a directory,
4241 : ;; use the default file name, but in that directory.
4242 0 : (if (file-directory-p filename)
4243 0 : (setq filename (concat (file-name-as-directory filename)
4244 0 : (file-name-nondirectory
4245 0 : (or buffer-file-name (buffer-name))))))
4246 0 : (and confirm
4247 0 : (file-exists-p filename)
4248 : ;; NS does its own confirm dialog.
4249 0 : (not (and (eq (framep-on-display) 'ns)
4250 0 : (listp last-nonmenu-event)
4251 0 : use-dialog-box))
4252 0 : (or (y-or-n-p (format-message
4253 0 : "File `%s' exists; overwrite? " filename))
4254 0 : (user-error "Canceled")))
4255 0 : (set-visited-file-name filename (not confirm))))
4256 0 : (set-buffer-modified-p t)
4257 : ;; Make buffer writable if file is writable.
4258 0 : (and buffer-file-name
4259 0 : (file-writable-p buffer-file-name)
4260 0 : (setq buffer-read-only nil))
4261 0 : (save-buffer)
4262 : ;; It's likely that the VC status at the new location is different from
4263 : ;; the one at the old location.
4264 0 : (vc-refresh-state))
4265 :
4266 : (defun file-extended-attributes (filename)
4267 : "Return an alist of extended attributes of file FILENAME.
4268 :
4269 : Extended attributes are platform-specific metadata about the file,
4270 : such as SELinux context, list of ACL entries, etc."
4271 0 : `((acl . ,(file-acl filename))
4272 0 : (selinux-context . ,(file-selinux-context filename))))
4273 :
4274 : (defun set-file-extended-attributes (filename attributes)
4275 : "Set extended attributes of file FILENAME to ATTRIBUTES.
4276 :
4277 : ATTRIBUTES must be an alist of file attributes as returned by
4278 : `file-extended-attributes'.
4279 : Value is t if the function succeeds in setting the attributes."
4280 0 : (let (result rv)
4281 0 : (dolist (elt attributes)
4282 0 : (let ((attr (car elt))
4283 0 : (val (cdr elt)))
4284 0 : (cond ((eq attr 'acl)
4285 0 : (setq rv (set-file-acl filename val)))
4286 0 : ((eq attr 'selinux-context)
4287 0 : (setq rv (set-file-selinux-context filename val))))
4288 0 : (setq result (or result rv))))
4289 :
4290 0 : result))
4291 :
4292 : (defun backup-buffer ()
4293 : "Make a backup of the disk file visited by the current buffer, if appropriate.
4294 : This is normally done before saving the buffer the first time.
4295 :
4296 : A backup may be done by renaming or by copying; see documentation of
4297 : variable `make-backup-files'. If it's done by renaming, then the file is
4298 : no longer accessible under its old name.
4299 :
4300 : The value is non-nil after a backup was made by renaming.
4301 : It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME).
4302 : MODES is the result of `file-modes' on the original
4303 : file; this means that the caller, after saving the buffer, should change
4304 : the modes of the new file to agree with the old modes.
4305 : EXTENDED-ATTRIBUTES is the result of `file-extended-attributes'
4306 : on the original file; this means that the caller, after saving
4307 : the buffer, should change the extended attributes of the new file
4308 : to agree with the old attributes.
4309 : BACKUPNAME is the backup file name, which is the old file renamed."
4310 0 : (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
4311 0 : (let ((attributes (file-attributes buffer-file-name)))
4312 0 : (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
4313 : ;; If specified name is a symbolic link, chase it to the target.
4314 : ;; This makes backups in the directory where the real file is.
4315 0 : (let* ((real-file-name (file-chase-links buffer-file-name))
4316 0 : (backup-info (find-backup-file-name real-file-name)))
4317 0 : (when backup-info
4318 0 : (let* ((backupname (car backup-info))
4319 0 : (targets (cdr backup-info))
4320 : (old-versions
4321 : ;; If have old versions to maybe delete,
4322 : ;; ask the user to confirm now, before doing anything.
4323 : ;; But don't actually delete til later.
4324 0 : (and targets
4325 0 : (booleanp delete-old-versions)
4326 0 : (or delete-old-versions
4327 0 : (y-or-n-p
4328 0 : (format "Delete excess backup versions of %s? "
4329 0 : real-file-name)))
4330 0 : targets))
4331 0 : (modes (file-modes buffer-file-name))
4332 : (extended-attributes
4333 0 : (file-extended-attributes buffer-file-name))
4334 : (copy-when-priv-mismatch
4335 0 : backup-by-copying-when-privileged-mismatch)
4336 : (make-copy
4337 0 : (or file-precious-flag backup-by-copying
4338 : ;; Don't rename a suid or sgid file.
4339 0 : (and modes (< 0 (logand modes #o6000)))
4340 0 : (not (file-writable-p
4341 0 : (file-name-directory real-file-name)))
4342 0 : (and backup-by-copying-when-linked
4343 0 : (< 1 (file-nlinks real-file-name)))
4344 0 : (and (or backup-by-copying-when-mismatch
4345 0 : (and (integerp copy-when-priv-mismatch)
4346 0 : (let ((attr (file-attributes
4347 0 : real-file-name
4348 0 : 'integer)))
4349 0 : (<= (nth 2 attr)
4350 0 : copy-when-priv-mismatch))))
4351 0 : (not (file-ownership-preserved-p real-file-name
4352 0 : t)))))
4353 : setmodes)
4354 0 : (condition-case ()
4355 0 : (progn
4356 : ;; Actually make the backup file.
4357 0 : (if make-copy
4358 0 : (backup-buffer-copy real-file-name backupname
4359 0 : modes extended-attributes)
4360 : ;; rename-file should delete old backup.
4361 0 : (rename-file real-file-name backupname t)
4362 0 : (setq setmodes (list modes extended-attributes
4363 0 : backupname)))
4364 0 : (setq buffer-backed-up t)
4365 : ;; Now delete the old versions, if desired.
4366 0 : (dolist (old-version old-versions)
4367 0 : (delete-file old-version)))
4368 0 : (file-error nil))
4369 : ;; If trouble writing the backup, write it in .emacs.d/%backup%.
4370 0 : (when (not buffer-backed-up)
4371 0 : (setq backupname (locate-user-emacs-file "%backup%~"))
4372 0 : (message "Cannot write backup file; backing up in %s"
4373 0 : backupname)
4374 0 : (sleep-for 1)
4375 0 : (backup-buffer-copy real-file-name backupname
4376 0 : modes extended-attributes)
4377 0 : (setq buffer-backed-up t))
4378 0 : setmodes)))))))
4379 :
4380 : (defun backup-buffer-copy (from-name to-name modes extended-attributes)
4381 : ;; Create temp files with strict access rights. It's easy to
4382 : ;; loosen them later, whereas it's impossible to close the
4383 : ;; time-window of loose permissions otherwise.
4384 0 : (with-file-modes ?\700
4385 0 : (when (condition-case nil
4386 : ;; Try to overwrite old backup first.
4387 0 : (copy-file from-name to-name t t t)
4388 0 : (error t))
4389 0 : (while (condition-case nil
4390 0 : (progn
4391 0 : (when (file-exists-p to-name)
4392 0 : (delete-file to-name))
4393 0 : (copy-file from-name to-name nil t t)
4394 0 : nil)
4395 0 : (file-already-exists t))
4396 : ;; The file was somehow created by someone else between
4397 : ;; `delete-file' and `copy-file', so let's try again.
4398 : ;; rms says "I think there is also a possible race
4399 : ;; condition for making backup files" (emacs-devel 20070821).
4400 0 : nil)))
4401 : ;; If set-file-extended-attributes fails, fall back on set-file-modes.
4402 0 : (unless (and extended-attributes
4403 0 : (with-demoted-errors
4404 0 : (set-file-extended-attributes to-name extended-attributes)))
4405 0 : (and modes
4406 0 : (set-file-modes to-name (logand modes #o1777)))))
4407 :
4408 : (defvar file-name-version-regexp
4409 : "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
4410 : ;; The last ~[[:digit]]+ matches relative versions in git,
4411 : ;; e.g. `foo.js.~HEAD~1~'.
4412 : "Regular expression matching the backup/version part of a file name.
4413 : Used by `file-name-sans-versions'.")
4414 :
4415 : (defun file-name-sans-versions (name &optional keep-backup-version)
4416 : "Return file NAME sans backup versions or strings.
4417 : This is a separate procedure so your site-init or startup file can
4418 : redefine it.
4419 : If the optional argument KEEP-BACKUP-VERSION is non-nil,
4420 : we do not remove backup version numbers, only true file version numbers.
4421 : See also `file-name-version-regexp'."
4422 1758 : (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
4423 1758 : (if handler
4424 0 : (funcall handler 'file-name-sans-versions name keep-backup-version)
4425 1758 : (substring name 0
4426 1758 : (unless keep-backup-version
4427 1758 : (string-match (concat file-name-version-regexp "\\'")
4428 1758 : name))))))
4429 :
4430 : (defun file-ownership-preserved-p (file &optional group)
4431 : "Return t if deleting FILE and rewriting it would preserve the owner.
4432 : Return also t if FILE does not exist. If GROUP is non-nil, check whether
4433 : the group would be preserved too."
4434 12 : (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
4435 12 : (if handler
4436 12 : (funcall handler 'file-ownership-preserved-p file group)
4437 0 : (let ((attributes (file-attributes file 'integer)))
4438 : ;; Return t if the file doesn't exist, since it's true that no
4439 : ;; information would be lost by an (attempted) delete and create.
4440 0 : (or (null attributes)
4441 0 : (and (or (= (nth 2 attributes) (user-uid))
4442 : ;; Files created on Windows by Administrator (RID=500)
4443 : ;; have the Administrators group (RID=544) recorded as
4444 : ;; their owner. Rewriting them will still preserve the
4445 : ;; owner.
4446 0 : (and (eq system-type 'windows-nt)
4447 0 : (= (user-uid) 500) (= (nth 2 attributes) 544)))
4448 0 : (or (not group)
4449 : ;; On BSD-derived systems files always inherit the parent
4450 : ;; directory's group, so skip the group-gid test.
4451 0 : (memq system-type '(berkeley-unix darwin gnu/kfreebsd))
4452 0 : (= (nth 3 attributes) (group-gid)))
4453 0 : (let* ((parent (or (file-name-directory file) "."))
4454 0 : (parent-attributes (file-attributes parent 'integer)))
4455 0 : (and parent-attributes
4456 : ;; On some systems, a file created in a setuid directory
4457 : ;; inherits that directory's owner.
4458 0 : (or
4459 0 : (= (nth 2 parent-attributes) (user-uid))
4460 0 : (string-match "^...[^sS]" (nth 8 parent-attributes)))
4461 : ;; On many systems, a file created in a setgid directory
4462 : ;; inherits that directory's group. On some systems
4463 : ;; this happens even if the setgid bit is not set.
4464 0 : (or (not group)
4465 0 : (= (nth 3 parent-attributes)
4466 12 : (nth 3 attributes)))))))))))
4467 :
4468 : (defun file-name-sans-extension (filename)
4469 : "Return FILENAME sans final \"extension\".
4470 : The extension, in a file name, is the part that begins with the last `.',
4471 : except that a leading `.' of the file name, if there is one, doesn't count."
4472 42 : (save-match-data
4473 42 : (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
4474 : directory)
4475 42 : (if (and (string-match "\\.[^.]*\\'" file)
4476 42 : (not (eq 0 (match-beginning 0))))
4477 42 : (if (setq directory (file-name-directory filename))
4478 : ;; Don't use expand-file-name here; if DIRECTORY is relative,
4479 : ;; we don't want to expand it.
4480 0 : (concat directory (substring file 0 (match-beginning 0)))
4481 42 : (substring file 0 (match-beginning 0)))
4482 42 : filename))))
4483 :
4484 : (defun file-name-extension (filename &optional period)
4485 : "Return FILENAME's final \"extension\".
4486 : The extension, in a file name, is the part that begins with the last `.',
4487 : excluding version numbers and backup suffixes, except that a leading `.'
4488 : of the file name, if there is one, doesn't count.
4489 : Return nil for extensionless file names such as `foo'.
4490 : Return the empty string for file names such as `foo.'.
4491 :
4492 : By default, the returned value excludes the period that starts the
4493 : extension, but if the optional argument PERIOD is non-nil, the period
4494 : is included in the value, and in that case, if FILENAME has no
4495 : extension, the value is \"\"."
4496 682 : (save-match-data
4497 682 : (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
4498 682 : (if (and (string-match "\\.[^.]*\\'" file)
4499 682 : (not (eq 0 (match-beginning 0))))
4500 6 : (substring file (+ (match-beginning 0) (if period 0 1)))
4501 676 : (if period
4502 682 : "")))))
4503 :
4504 : (defun file-name-base (&optional filename)
4505 : "Return the base name of the FILENAME: no directory, no extension.
4506 : FILENAME defaults to `buffer-file-name'."
4507 0 : (file-name-sans-extension
4508 0 : (file-name-nondirectory (or filename (buffer-file-name)))))
4509 :
4510 : (defcustom make-backup-file-name-function
4511 : #'make-backup-file-name--default-function
4512 : "A function that `make-backup-file-name' uses to create backup file names.
4513 : The function receives a single argument, the original file name.
4514 :
4515 : If you change this, you may need to change `backup-file-name-p' and
4516 : `file-name-sans-versions' too.
4517 :
4518 : You could make this buffer-local to do something special for specific files.
4519 :
4520 : For historical reasons, a value of nil means to use the default function.
4521 : This should not be relied upon.
4522 :
4523 : See also `backup-directory-alist'."
4524 : :version "24.4" ; nil -> make-backup-file-name--default-function
4525 : :group 'backup
4526 : :type '(choice (const :tag "Deprecated way to get the default function" nil)
4527 : (function :tag "Function")))
4528 :
4529 : (defcustom backup-directory-alist nil
4530 : "Alist of filename patterns and backup directory names.
4531 : Each element looks like (REGEXP . DIRECTORY). Backups of files with
4532 : names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
4533 : relative or absolute. If it is absolute, so that all matching files
4534 : are backed up into the same directory, the file names in this
4535 : directory will be the full name of the file backed up with all
4536 : directory separators changed to `!' to prevent clashes. This will not
4537 : work correctly if your filesystem truncates the resulting name.
4538 :
4539 : For the common case of all backups going into one directory, the alist
4540 : should contain a single element pairing \".\" with the appropriate
4541 : directory name.
4542 :
4543 : If this variable is nil, or it fails to match a filename, the backup
4544 : is made in the original file's directory.
4545 :
4546 : On MS-DOS filesystems without long names this variable is always
4547 : ignored."
4548 : :group 'backup
4549 : :type '(repeat (cons (regexp :tag "Regexp matching filename")
4550 : (directory :tag "Backup directory name"))))
4551 :
4552 : (defun normal-backup-enable-predicate (name)
4553 : "Default `backup-enable-predicate' function.
4554 : Checks for files in `temporary-file-directory',
4555 : `small-temporary-file-directory', and \"/tmp\"."
4556 148 : (let ((temporary-file-directory temporary-file-directory)
4557 : caseless)
4558 : ;; On MS-Windows, file-truename will convert short 8+3 aliases to
4559 : ;; their long file-name equivalents, so compare-strings does TRT.
4560 148 : (if (memq system-type '(ms-dos windows-nt))
4561 0 : (setq temporary-file-directory (file-truename temporary-file-directory)
4562 0 : name (file-truename name)
4563 148 : caseless t))
4564 148 : (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
4565 148 : name 0 nil caseless)))
4566 : ;; Directory is under temporary-file-directory.
4567 148 : (and (not (eq comp t))
4568 148 : (< comp (- (length temporary-file-directory)))))
4569 148 : (let ((comp (compare-strings "/tmp" 0 nil
4570 148 : name 0 nil)))
4571 : ;; Directory is under /tmp.
4572 148 : (and (not (eq comp t))
4573 148 : (< comp (- (length "/tmp")))))
4574 148 : (if small-temporary-file-directory
4575 0 : (let ((comp (compare-strings small-temporary-file-directory
4576 : 0 nil
4577 0 : name 0 nil caseless)))
4578 : ;; Directory is under small-temporary-file-directory.
4579 0 : (and (not (eq comp t))
4580 148 : (< comp (- (length small-temporary-file-directory))))))))))
4581 :
4582 : (defun make-backup-file-name (file)
4583 : "Create the non-numeric backup file name for FILE.
4584 : This calls the function that `make-backup-file-name-function' specifies,
4585 : with a single argument FILE."
4586 0 : (funcall (or make-backup-file-name-function
4587 0 : #'make-backup-file-name--default-function)
4588 0 : file))
4589 :
4590 : (defun make-backup-file-name--default-function (file)
4591 : "Default function for `make-backup-file-name'.
4592 : Normally this just returns FILE's name with `~' appended.
4593 : It searches for a match for FILE in `backup-directory-alist'.
4594 : If the directory for the backup doesn't exist, it is created."
4595 0 : (if (and (eq system-type 'ms-dos)
4596 0 : (not (msdos-long-file-names)))
4597 0 : (let ((fn (file-name-nondirectory file)))
4598 0 : (concat (file-name-directory file)
4599 0 : (or (and (string-match "\\`[^.]+\\'" fn)
4600 0 : (concat (match-string 0 fn) ".~"))
4601 0 : (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
4602 0 : (concat (match-string 0 fn) "~")))))
4603 0 : (concat (make-backup-file-name-1 file) "~")))
4604 :
4605 : (defun make-backup-file-name-1 (file)
4606 : "Subroutine of `make-backup-file-name--default-function'.
4607 : The function `find-backup-file-name' also uses this."
4608 0 : (let ((alist backup-directory-alist)
4609 : elt backup-directory abs-backup-directory)
4610 0 : (while alist
4611 0 : (setq elt (pop alist))
4612 0 : (if (string-match (car elt) file)
4613 0 : (setq backup-directory (cdr elt)
4614 0 : alist nil)))
4615 : ;; If backup-directory is relative, it should be relative to the
4616 : ;; file's directory. By expanding explicitly here, we avoid
4617 : ;; depending on default-directory.
4618 0 : (if backup-directory
4619 0 : (setq abs-backup-directory
4620 0 : (expand-file-name backup-directory
4621 0 : (file-name-directory file))))
4622 0 : (if (and abs-backup-directory (not (file-exists-p abs-backup-directory)))
4623 0 : (condition-case nil
4624 0 : (make-directory abs-backup-directory 'parents)
4625 0 : (file-error (setq backup-directory nil
4626 0 : abs-backup-directory nil))))
4627 0 : (if (null backup-directory)
4628 0 : file
4629 0 : (if (file-name-absolute-p backup-directory)
4630 0 : (progn
4631 0 : (when (memq system-type '(windows-nt ms-dos cygwin))
4632 : ;; Normalize DOSish file names: downcase the drive
4633 : ;; letter, if any, and replace the leading "x:" with
4634 : ;; "/drive_x".
4635 0 : (or (file-name-absolute-p file)
4636 0 : (setq file (expand-file-name file))) ; make defaults explicit
4637 : ;; Replace any invalid file-name characters (for the
4638 : ;; case of backing up remote files).
4639 0 : (setq file (expand-file-name (convert-standard-filename file)))
4640 0 : (if (eq (aref file 1) ?:)
4641 0 : (setq file (concat "/"
4642 : "drive_"
4643 0 : (char-to-string (downcase (aref file 0)))
4644 0 : (if (eq (aref file 2) ?/)
4645 : ""
4646 0 : "/")
4647 0 : (substring file 2)))))
4648 : ;; Make the name unique by substituting directory
4649 : ;; separators. It may not really be worth bothering about
4650 : ;; doubling `!'s in the original name...
4651 0 : (expand-file-name
4652 0 : (subst-char-in-string
4653 : ?/ ?!
4654 0 : (replace-regexp-in-string "!" "!!" file))
4655 0 : backup-directory))
4656 0 : (expand-file-name (file-name-nondirectory file)
4657 0 : (file-name-as-directory abs-backup-directory))))))
4658 :
4659 : (defun backup-file-name-p (file)
4660 : "Return non-nil if FILE is a backup file name (numeric or not).
4661 : This is a separate function so you can redefine it for customization.
4662 : You may need to redefine `file-name-sans-versions' as well."
4663 148 : (string-match "~\\'" file))
4664 :
4665 : (defvar backup-extract-version-start)
4666 :
4667 : ;; This is used in various files.
4668 : ;; The usage of backup-extract-version-start is not very clean,
4669 : ;; but I can't see a good alternative, so as of now I am leaving it alone.
4670 : (defun backup-extract-version (fn)
4671 : "Given the name of a numeric backup file, FN, return the backup number.
4672 : Uses the free variable `backup-extract-version-start', whose value should be
4673 : the index in the name where the version number begins."
4674 0 : (if (and (string-match "[0-9]+~/?$" fn backup-extract-version-start)
4675 0 : (= (match-beginning 0) backup-extract-version-start))
4676 0 : (string-to-number (substring fn backup-extract-version-start -1))
4677 0 : 0))
4678 :
4679 : (defun find-backup-file-name (fn)
4680 : "Find a file name for a backup file FN, and suggestions for deletions.
4681 : Value is a list whose car is the name for the backup file
4682 : and whose cdr is a list of old versions to consider deleting now.
4683 : If the value is nil, don't make a backup.
4684 : Uses `backup-directory-alist' in the same way as
4685 : `make-backup-file-name--default-function' does."
4686 0 : (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
4687 : ;; Run a handler for this function so that ange-ftp can refuse to do it.
4688 0 : (if handler
4689 0 : (funcall handler 'find-backup-file-name fn)
4690 0 : (if (or (eq version-control 'never)
4691 : ;; We don't support numbered backups on plain MS-DOS
4692 : ;; when long file names are unavailable.
4693 0 : (and (eq system-type 'ms-dos)
4694 0 : (not (msdos-long-file-names))))
4695 0 : (list (make-backup-file-name fn))
4696 0 : (let* ((basic-name (make-backup-file-name-1 fn))
4697 0 : (base-versions (concat (file-name-nondirectory basic-name)
4698 0 : ".~"))
4699 0 : (backup-extract-version-start (length base-versions))
4700 : (high-water-mark 0)
4701 : (number-to-delete 0)
4702 : possibilities deserve-versions-p versions)
4703 0 : (condition-case ()
4704 0 : (setq possibilities (file-name-all-completions
4705 0 : base-versions
4706 0 : (file-name-directory basic-name))
4707 0 : versions (sort (mapcar #'backup-extract-version
4708 0 : possibilities)
4709 0 : #'<)
4710 0 : high-water-mark (apply 'max 0 versions)
4711 0 : deserve-versions-p (or version-control
4712 0 : (> high-water-mark 0))
4713 0 : number-to-delete (- (length versions)
4714 0 : kept-old-versions
4715 0 : kept-new-versions
4716 0 : -1))
4717 0 : (file-error (setq possibilities nil)))
4718 0 : (if (not deserve-versions-p)
4719 0 : (list (make-backup-file-name fn))
4720 0 : (cons (format "%s.~%d~" basic-name (1+ high-water-mark))
4721 0 : (if (and (> number-to-delete 0)
4722 : ;; Delete nothing if there is overflow
4723 : ;; in the number of versions to keep.
4724 0 : (>= (+ kept-new-versions kept-old-versions -1) 0))
4725 0 : (mapcar (lambda (n)
4726 0 : (format "%s.~%d~" basic-name n))
4727 0 : (let ((v (nthcdr kept-old-versions versions)))
4728 0 : (rplacd (nthcdr (1- number-to-delete) v) ())
4729 0 : v))))))))))
4730 :
4731 : (defun file-nlinks (filename)
4732 : "Return number of names file FILENAME has."
4733 0 : (car (cdr (file-attributes filename))))
4734 :
4735 : ;; (defun file-relative-name (filename &optional directory)
4736 : ;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
4737 : ;; This function returns a relative file name which is equivalent to FILENAME
4738 : ;; when used with that default directory as the default.
4739 : ;; If this is impossible (which can happen on MSDOS and Windows
4740 : ;; when the file name and directory use different drive names)
4741 : ;; then it returns FILENAME."
4742 : ;; (save-match-data
4743 : ;; (let ((fname (expand-file-name filename)))
4744 : ;; (setq directory (file-name-as-directory
4745 : ;; (expand-file-name (or directory default-directory))))
4746 : ;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
4747 : ;; ;; drive names, they can't be relative, so return the absolute name.
4748 : ;; (if (and (or (eq system-type 'ms-dos)
4749 : ;; (eq system-type 'cygwin)
4750 : ;; (eq system-type 'windows-nt))
4751 : ;; (not (string-equal (substring fname 0 2)
4752 : ;; (substring directory 0 2))))
4753 : ;; filename
4754 : ;; (let ((ancestor ".")
4755 : ;; (fname-dir (file-name-as-directory fname)))
4756 : ;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
4757 : ;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
4758 : ;; (setq directory (file-name-directory (substring directory 0 -1))
4759 : ;; ancestor (if (equal ancestor ".")
4760 : ;; ".."
4761 : ;; (concat "../" ancestor))))
4762 : ;; ;; Now ancestor is empty, or .., or ../.., etc.
4763 : ;; (if (string-match (concat "^" (regexp-quote directory)) fname)
4764 : ;; ;; We matched within FNAME's directory part.
4765 : ;; ;; Add the rest of FNAME onto ANCESTOR.
4766 : ;; (let ((rest (substring fname (match-end 0))))
4767 : ;; (if (and (equal ancestor ".")
4768 : ;; (not (equal rest "")))
4769 : ;; ;; But don't bother with ANCESTOR if it would give us `./'.
4770 : ;; rest
4771 : ;; (concat (file-name-as-directory ancestor) rest)))
4772 : ;; ;; We matched FNAME's directory equivalent.
4773 : ;; ancestor))))))
4774 :
4775 : (defun file-relative-name (filename &optional directory)
4776 : "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
4777 : This function returns a relative file name which is equivalent to FILENAME
4778 : when used with that default directory as the default.
4779 : If FILENAME is a relative file name, it will be interpreted as existing in
4780 : `default-directory'.
4781 : If FILENAME and DIRECTORY lie on different machines or on different drives
4782 : on a DOS/Windows machine, it returns FILENAME in expanded form."
4783 418 : (save-match-data
4784 418 : (setq directory
4785 418 : (file-name-as-directory (expand-file-name (or directory
4786 418 : default-directory))))
4787 418 : (setq filename (expand-file-name filename))
4788 418 : (let ((fremote (file-remote-p filename))
4789 418 : (dremote (file-remote-p directory))
4790 418 : (fold-case (or (file-name-case-insensitive-p filename)
4791 418 : read-file-name-completion-ignore-case)))
4792 418 : (if ;; Conditions for separate trees
4793 418 : (or
4794 : ;; Test for different filesystems on DOS/Windows
4795 418 : (and
4796 : ;; Should `cygwin' really be included here? --stef
4797 418 : (memq system-type '(ms-dos cygwin windows-nt))
4798 0 : (or
4799 : ;; Test for different drive letters
4800 0 : (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
4801 : ;; Test for UNCs on different servers
4802 0 : (not (eq t (compare-strings
4803 0 : (progn
4804 0 : (if (string-match "\\`//\\([^:/]+\\)/" filename)
4805 0 : (match-string 1 filename)
4806 : ;; Windows file names cannot have ? in
4807 : ;; them, so use that to detect when
4808 : ;; neither FILENAME nor DIRECTORY is a
4809 : ;; UNC.
4810 0 : "?"))
4811 : 0 nil
4812 0 : (progn
4813 0 : (if (string-match "\\`//\\([^:/]+\\)/" directory)
4814 0 : (match-string 1 directory)
4815 0 : "?"))
4816 418 : 0 nil t)))))
4817 : ;; Test for different remote file system identification
4818 418 : (not (equal fremote dremote)))
4819 6 : filename
4820 412 : (let ((ancestor ".")
4821 412 : (filename-dir (file-name-as-directory filename)))
4822 412 : (while (not
4823 412 : (or (string-prefix-p directory filename-dir fold-case)
4824 412 : (string-prefix-p directory filename fold-case)))
4825 0 : (setq directory (file-name-directory (substring directory 0 -1))
4826 0 : ancestor (if (equal ancestor ".")
4827 : ".."
4828 412 : (concat "../" ancestor))))
4829 : ;; Now ancestor is empty, or .., or ../.., etc.
4830 412 : (if (string-prefix-p directory filename fold-case)
4831 : ;; We matched within FILENAME's directory part.
4832 : ;; Add the rest of FILENAME onto ANCESTOR.
4833 412 : (let ((rest (substring filename (length directory))))
4834 412 : (if (and (equal ancestor ".") (not (equal rest "")))
4835 : ;; But don't bother with ANCESTOR if it would give us `./'.
4836 412 : rest
4837 412 : (concat (file-name-as-directory ancestor) rest)))
4838 : ;; We matched FILENAME's directory equivalent.
4839 418 : ancestor))))))
4840 :
4841 : (defun save-buffer (&optional arg)
4842 : "Save current buffer in visited file if modified.
4843 : Variations are described below.
4844 :
4845 : By default, makes the previous version into a backup file
4846 : if previously requested or if this is the first save.
4847 : Prefixed with one \\[universal-argument], marks this version
4848 : to become a backup when the next save is done.
4849 : Prefixed with two \\[universal-argument]'s,
4850 : makes the previous version into a backup file.
4851 : Prefixed with three \\[universal-argument]'s, marks this version
4852 : to become a backup when the next save is done,
4853 : and makes the previous version into a backup file.
4854 :
4855 : With a numeric prefix argument of 0, never make the previous version
4856 : into a backup file.
4857 :
4858 : Note that the various variables that control backups, such
4859 : as `version-control', `backup-enable-predicate', `vc-make-backup-files',
4860 : and `backup-inhibited', to name just the more popular ones, still
4861 : control whether a backup will actually be produced, even when you
4862 : invoke this command prefixed with two or three \\[universal-argument]'s.
4863 :
4864 : If a file's name is FOO, the names of its numbered backup versions are
4865 : FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
4866 : Numeric backups (rather than FOO~) will be made if value of
4867 : `version-control' is not the atom `never' and either there are already
4868 : numeric versions of the file being backed up, or `version-control' is
4869 : non-nil.
4870 : We don't want excessive versions piling up, so there are variables
4871 : `kept-old-versions', which tells Emacs how many oldest versions to keep,
4872 : and `kept-new-versions', which tells how many newest versions to keep.
4873 : Defaults are 2 old versions and 2 new.
4874 : `dired-kept-versions' controls dired's clean-directory (.) command.
4875 : If `delete-old-versions' is nil, system will query user
4876 : before trimming versions. Otherwise it does it silently.
4877 :
4878 : If `vc-make-backup-files' is nil, which is the default,
4879 : no backup files are made for files managed by version control.
4880 : (This is because the version control system itself records previous versions.)
4881 :
4882 : See the subroutine `basic-save-buffer' for more information."
4883 : (interactive "p")
4884 0 : (let ((modp (buffer-modified-p))
4885 0 : (make-backup-files (or (and make-backup-files (not (eq arg 0)))
4886 0 : (memq arg '(16 64)))))
4887 0 : (and modp (memq arg '(16 64)) (setq buffer-backed-up nil))
4888 : ;; We used to display the message below only for files > 50KB, but
4889 : ;; then Rmail-mbox never displays it due to buffer swapping. If
4890 : ;; the test is ever re-introduced, be sure to handle saving of
4891 : ;; Rmail files.
4892 0 : (if (and modp
4893 0 : (buffer-file-name)
4894 0 : (not noninteractive)
4895 0 : (not save-silently))
4896 0 : (message "Saving file %s..." (buffer-file-name)))
4897 0 : (basic-save-buffer (called-interactively-p 'any))
4898 0 : (and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
4899 :
4900 : (defun delete-auto-save-file-if-necessary (&optional force)
4901 : "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
4902 : Normally delete only if the file was written by this Emacs since
4903 : the last real save, but optional arg FORCE non-nil means delete anyway."
4904 0 : (and buffer-auto-save-file-name delete-auto-save-files
4905 0 : (not (string= buffer-file-name buffer-auto-save-file-name))
4906 0 : (or force (recent-auto-save-p))
4907 0 : (progn
4908 0 : (condition-case ()
4909 0 : (delete-file buffer-auto-save-file-name)
4910 0 : (file-error nil))
4911 0 : (set-buffer-auto-saved))))
4912 :
4913 : (defvar auto-save-hook nil
4914 : "Normal hook run just before auto-saving.")
4915 :
4916 : (defcustom before-save-hook nil
4917 : "Normal hook that is run before a buffer is saved to its file.
4918 : Only used by `save-buffer'."
4919 : :options '(copyright-update time-stamp)
4920 : :type 'hook
4921 : :group 'files)
4922 :
4923 : (defcustom after-save-hook nil
4924 : "Normal hook that is run after a buffer is saved to its file.
4925 : Only used by `save-buffer'."
4926 : :options '(executable-make-buffer-file-executable-if-script-p)
4927 : :type 'hook
4928 : :group 'files)
4929 :
4930 : (defvar save-buffer-coding-system nil
4931 : "If non-nil, use this coding system for saving the buffer.
4932 : More precisely, use this coding system in place of the
4933 : value of `buffer-file-coding-system', when saving the buffer.
4934 : Calling `write-region' for any purpose other than saving the buffer
4935 : will still use `buffer-file-coding-system'; this variable has no effect
4936 : in such cases.")
4937 :
4938 : (make-variable-buffer-local 'save-buffer-coding-system)
4939 : (put 'save-buffer-coding-system 'permanent-local t)
4940 :
4941 : (defun basic-save-buffer (&optional called-interactively)
4942 : "Save the current buffer in its visited file, if it has been modified.
4943 : The hooks `write-contents-functions' and `write-file-functions' get a chance
4944 : to do the job of saving; if they do not, then the buffer is saved in
4945 : the visited file in the usual way.
4946 : Before and after saving the buffer, this function runs
4947 : `before-save-hook' and `after-save-hook', respectively."
4948 : (interactive '(called-interactively))
4949 0 : (save-current-buffer
4950 : ;; In an indirect buffer, save its base buffer instead.
4951 0 : (if (buffer-base-buffer)
4952 0 : (set-buffer (buffer-base-buffer)))
4953 0 : (if (or (buffer-modified-p)
4954 : ;; handle the case when no modification has been made but
4955 : ;; the file disappeared since visited
4956 0 : (and buffer-file-name
4957 0 : (not (file-exists-p buffer-file-name))))
4958 0 : (let ((recent-save (recent-auto-save-p))
4959 : setmodes)
4960 : ;; If buffer has no file name, ask user for one.
4961 0 : (or buffer-file-name
4962 0 : (let ((filename
4963 0 : (expand-file-name
4964 0 : (read-file-name "File to save in: "
4965 0 : nil (expand-file-name (buffer-name))))))
4966 0 : (if (file-exists-p filename)
4967 0 : (if (file-directory-p filename)
4968 : ;; Signal an error if the user specified the name of an
4969 : ;; existing directory.
4970 0 : (error "%s is a directory" filename)
4971 0 : (unless (y-or-n-p (format-message
4972 : "File `%s' exists; overwrite? "
4973 0 : filename))
4974 0 : (error "Canceled"))))
4975 0 : (set-visited-file-name filename)))
4976 0 : (or (verify-visited-file-modtime (current-buffer))
4977 0 : (not (file-exists-p buffer-file-name))
4978 0 : (yes-or-no-p
4979 0 : (format
4980 : "%s has changed since visited or saved. Save anyway? "
4981 0 : (file-name-nondirectory buffer-file-name)))
4982 0 : (user-error "Save not confirmed"))
4983 0 : (save-restriction
4984 0 : (widen)
4985 0 : (save-excursion
4986 0 : (and (> (point-max) (point-min))
4987 0 : (not find-file-literally)
4988 0 : (/= (char-after (1- (point-max))) ?\n)
4989 0 : (not (and (eq selective-display t)
4990 0 : (= (char-after (1- (point-max))) ?\r)))
4991 0 : (or (eq require-final-newline t)
4992 0 : (eq require-final-newline 'visit-save)
4993 0 : (and require-final-newline
4994 0 : (y-or-n-p
4995 0 : (format "Buffer %s does not end in newline. Add one? "
4996 0 : (buffer-name)))))
4997 0 : (save-excursion
4998 0 : (goto-char (point-max))
4999 0 : (insert ?\n))))
5000 : ;; Support VC version backups.
5001 0 : (vc-before-save)
5002 : ;; Don't let errors prevent saving the buffer.
5003 0 : (with-demoted-errors (run-hooks 'before-save-hook))
5004 0 : (or (run-hook-with-args-until-success 'write-contents-functions)
5005 0 : (run-hook-with-args-until-success 'local-write-file-hooks)
5006 0 : (run-hook-with-args-until-success 'write-file-functions)
5007 : ;; If a hook returned t, file is already "written".
5008 : ;; Otherwise, write it the usual way now.
5009 0 : (let ((dir (file-name-directory
5010 0 : (expand-file-name buffer-file-name))))
5011 0 : (unless (file-exists-p dir)
5012 0 : (if (y-or-n-p
5013 0 : (format-message
5014 0 : "Directory `%s' does not exist; create? " dir))
5015 0 : (make-directory dir t)
5016 0 : (error "Canceled")))
5017 0 : (setq setmodes (basic-save-buffer-1))))
5018 : ;; Now we have saved the current buffer. Let's make sure
5019 : ;; that buffer-file-coding-system is fixed to what
5020 : ;; actually used for saving by binding it locally.
5021 0 : (if save-buffer-coding-system
5022 0 : (setq save-buffer-coding-system last-coding-system-used)
5023 0 : (setq buffer-file-coding-system last-coding-system-used))
5024 0 : (setq buffer-file-number
5025 0 : (nthcdr 10 (file-attributes buffer-file-name)))
5026 0 : (if setmodes
5027 0 : (condition-case ()
5028 0 : (progn
5029 0 : (unless
5030 0 : (with-demoted-errors
5031 0 : (set-file-modes buffer-file-name (car setmodes)))
5032 0 : (set-file-extended-attributes buffer-file-name
5033 0 : (nth 1 setmodes))))
5034 0 : (error nil))))
5035 : ;; If the auto-save file was recent before this command,
5036 : ;; delete it now.
5037 0 : (delete-auto-save-file-if-necessary recent-save)
5038 : ;; Support VC `implicit' locking.
5039 0 : (vc-after-save)
5040 0 : (run-hooks 'after-save-hook))
5041 0 : (or noninteractive
5042 0 : (not called-interactively)
5043 0 : (files--message "(No changes need to be saved)")))))
5044 :
5045 : ;; This does the "real job" of writing a buffer into its visited file
5046 : ;; and making a backup file. This is what is normally done
5047 : ;; but inhibited if one of write-file-functions returns non-nil.
5048 : ;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
5049 : ;; backup-buffer.
5050 : (defun basic-save-buffer-1 ()
5051 0 : (prog1
5052 0 : (if save-buffer-coding-system
5053 0 : (let ((coding-system-for-write save-buffer-coding-system))
5054 0 : (basic-save-buffer-2))
5055 0 : (basic-save-buffer-2))
5056 0 : (if buffer-file-coding-system-explicit
5057 0 : (setcar buffer-file-coding-system-explicit last-coding-system-used))))
5058 :
5059 : ;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
5060 : ;; backup-buffer.
5061 : (defun basic-save-buffer-2 ()
5062 0 : (let (tempsetmodes setmodes)
5063 0 : (if (not (file-writable-p buffer-file-name))
5064 0 : (let ((dir (file-name-directory buffer-file-name)))
5065 0 : (if (not (file-directory-p dir))
5066 0 : (if (file-exists-p dir)
5067 0 : (error "%s is not a directory" dir)
5068 0 : (error "%s: no such directory" dir))
5069 0 : (if (not (file-exists-p buffer-file-name))
5070 0 : (error "Directory %s write-protected" dir)
5071 0 : (if (yes-or-no-p
5072 0 : (format
5073 : "File %s is write-protected; try to save anyway? "
5074 0 : (file-name-nondirectory
5075 0 : buffer-file-name)))
5076 0 : (setq tempsetmodes t)
5077 0 : (error "Attempt to save to a file which you aren't allowed to write"))))))
5078 0 : (or buffer-backed-up
5079 0 : (setq setmodes (backup-buffer)))
5080 0 : (let* ((dir (file-name-directory buffer-file-name))
5081 0 : (dir-writable (file-writable-p dir)))
5082 0 : (if (or (and file-precious-flag dir-writable)
5083 0 : (and break-hardlink-on-save
5084 0 : (file-exists-p buffer-file-name)
5085 0 : (> (file-nlinks buffer-file-name) 1)
5086 0 : (or dir-writable
5087 0 : (error (concat "Directory %s write-protected; "
5088 0 : "cannot break hardlink when saving")
5089 0 : dir))))
5090 : ;; Write temp name, then rename it.
5091 : ;; This requires write access to the containing dir,
5092 : ;; which is why we don't try it if we don't have that access.
5093 0 : (let ((realname buffer-file-name)
5094 : tempname
5095 0 : (old-modtime (visited-file-modtime)))
5096 : ;; Create temp files with strict access rights. It's easy to
5097 : ;; loosen them later, whereas it's impossible to close the
5098 : ;; time-window of loose permissions otherwise.
5099 0 : (condition-case err
5100 0 : (progn
5101 0 : (clear-visited-file-modtime)
5102 : ;; Call write-region in the appropriate way
5103 : ;; for saving the buffer.
5104 0 : (setq tempname
5105 0 : (make-temp-file
5106 0 : (expand-file-name "tmp" dir)))
5107 : ;; Pass in nil&nil rather than point-min&max
5108 : ;; cause we're saving the whole buffer.
5109 : ;; write-region-annotate-functions may use it.
5110 0 : (write-region nil nil tempname nil realname
5111 0 : buffer-file-truename)
5112 0 : (when save-silently (message nil)))
5113 : ;; If we failed, restore the buffer's modtime.
5114 0 : (error (set-visited-file-modtime old-modtime)
5115 0 : (signal (car err) (cdr err))))
5116 : ;; Since we have created an entirely new file,
5117 : ;; make sure it gets the right permission bits set.
5118 0 : (setq setmodes (or setmodes
5119 0 : (list (or (file-modes buffer-file-name)
5120 0 : (logand ?\666 (default-file-modes)))
5121 0 : (file-extended-attributes buffer-file-name)
5122 0 : buffer-file-name)))
5123 : ;; We succeeded in writing the temp file,
5124 : ;; so rename it.
5125 0 : (rename-file tempname buffer-file-name t))
5126 : ;; If file not writable, see if we can make it writable
5127 : ;; temporarily while we write it.
5128 : ;; But no need to do so if we have just backed it up
5129 : ;; (setmodes is set) because that says we're superseding.
5130 0 : (cond ((and tempsetmodes (not setmodes))
5131 : ;; Change the mode back, after writing.
5132 0 : (setq setmodes (list (file-modes buffer-file-name)
5133 0 : (file-extended-attributes buffer-file-name)
5134 0 : buffer-file-name))
5135 : ;; If set-file-extended-attributes fails, fall back on
5136 : ;; set-file-modes.
5137 0 : (unless
5138 0 : (with-demoted-errors
5139 0 : (set-file-extended-attributes buffer-file-name
5140 0 : (nth 1 setmodes)))
5141 0 : (set-file-modes buffer-file-name
5142 0 : (logior (car setmodes) 128))))))
5143 0 : (let (success)
5144 0 : (unwind-protect
5145 0 : (progn
5146 : ;; Pass in nil&nil rather than point-min&max to indicate
5147 : ;; we're saving the buffer rather than just a region.
5148 : ;; write-region-annotate-functions may make us of it.
5149 0 : (write-region nil nil
5150 0 : buffer-file-name nil t buffer-file-truename)
5151 0 : (when save-silently (message nil))
5152 0 : (setq success t))
5153 : ;; If we get an error writing the new file, and we made
5154 : ;; the backup by renaming, undo the backing-up.
5155 0 : (and setmodes (not success)
5156 0 : (progn
5157 0 : (rename-file (nth 2 setmodes) buffer-file-name t)
5158 0 : (setq buffer-backed-up nil))))))
5159 0 : setmodes))
5160 :
5161 : (declare-function diff-no-select "diff"
5162 : (old new &optional switches no-async buf))
5163 :
5164 : (defvar save-some-buffers-action-alist
5165 : `((?\C-r
5166 : ,(lambda (buf)
5167 : (if (not enable-recursive-minibuffers)
5168 : (progn (display-buffer buf)
5169 : (setq other-window-scroll-buffer buf))
5170 : (view-buffer buf (lambda (_) (exit-recursive-edit)))
5171 : (recursive-edit))
5172 : ;; Return nil to ask about BUF again.
5173 : nil)
5174 : ,(purecopy "view this buffer"))
5175 : (?d ,(lambda (buf)
5176 : (if (null (buffer-file-name buf))
5177 : (message "Not applicable: no file")
5178 : (require 'diff) ;for diff-no-select.
5179 : (let ((diffbuf (diff-no-select (buffer-file-name buf) buf
5180 : nil 'noasync)))
5181 : (if (not enable-recursive-minibuffers)
5182 : (progn (display-buffer diffbuf)
5183 : (setq other-window-scroll-buffer diffbuf))
5184 : (view-buffer diffbuf (lambda (_) (exit-recursive-edit)))
5185 : (recursive-edit))))
5186 : ;; Return nil to ask about BUF again.
5187 : nil)
5188 : ,(purecopy "view changes in this buffer")))
5189 : "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
5190 : (put 'save-some-buffers-action-alist 'risky-local-variable t)
5191 :
5192 : (defvar buffer-save-without-query nil
5193 : "Non-nil means `save-some-buffers' should save this buffer without asking.")
5194 : (make-variable-buffer-local 'buffer-save-without-query)
5195 :
5196 : (defcustom save-some-buffers-default-predicate nil
5197 : "Default predicate for `save-some-buffers'.
5198 : This allows you to stop `save-some-buffers' from asking
5199 : about certain files that you'd usually rather not save."
5200 : :group 'auto-save
5201 : :type 'function
5202 : :version "26.1")
5203 :
5204 : (defun save-some-buffers (&optional arg pred)
5205 : "Save some modified file-visiting buffers. Asks user about each one.
5206 : You can answer `y' to save, `n' not to save, `C-r' to look at the
5207 : buffer in question with `view-buffer' before deciding or `d' to
5208 : view the differences using `diff-buffer-with-file'.
5209 :
5210 : This command first saves any buffers where `buffer-save-without-query' is
5211 : non-nil, without asking.
5212 :
5213 : Optional argument (the prefix) non-nil means save all with no questions.
5214 : Optional second argument PRED determines which buffers are considered:
5215 : If PRED is nil, all the file-visiting buffers are considered.
5216 : If PRED is t, then certain non-file buffers will also be considered.
5217 : If PRED is a zero-argument function, it indicates for each buffer whether
5218 : to consider it or not when called with that buffer current.
5219 : PRED defaults to the value of `save-some-buffers-default-predicate'.
5220 :
5221 : See `save-some-buffers-action-alist' if you want to
5222 : change the additional actions you can take on files."
5223 : (interactive "P")
5224 0 : (unless pred
5225 0 : (setq pred save-some-buffers-default-predicate))
5226 0 : (save-window-excursion
5227 0 : (let* (queried autosaved-buffers
5228 : files-done abbrevs-done)
5229 0 : (dolist (buffer (buffer-list))
5230 : ;; First save any buffers that we're supposed to save unconditionally.
5231 : ;; That way the following code won't ask about them.
5232 0 : (with-current-buffer buffer
5233 0 : (when (and buffer-save-without-query (buffer-modified-p))
5234 0 : (push (buffer-name) autosaved-buffers)
5235 0 : (save-buffer))))
5236 : ;; Ask about those buffers that merit it,
5237 : ;; and record the number thus saved.
5238 0 : (setq files-done
5239 0 : (map-y-or-n-p
5240 : (lambda (buffer)
5241 : ;; Note that killing some buffers may kill others via
5242 : ;; hooks (e.g. Rmail and its viewing buffer).
5243 0 : (and (buffer-live-p buffer)
5244 0 : (buffer-modified-p buffer)
5245 0 : (not (buffer-base-buffer buffer))
5246 0 : (or
5247 0 : (buffer-file-name buffer)
5248 0 : (and pred
5249 0 : (progn
5250 0 : (set-buffer buffer)
5251 0 : (and buffer-offer-save (> (buffer-size) 0)))))
5252 0 : (or (not (functionp pred))
5253 0 : (with-current-buffer buffer (funcall pred)))
5254 0 : (if arg
5255 : t
5256 0 : (setq queried t)
5257 0 : (if (buffer-file-name buffer)
5258 0 : (format "Save file %s? "
5259 0 : (buffer-file-name buffer))
5260 0 : (format "Save buffer %s? "
5261 0 : (buffer-name buffer))))))
5262 : (lambda (buffer)
5263 0 : (with-current-buffer buffer
5264 0 : (save-buffer)))
5265 0 : (buffer-list)
5266 : '("buffer" "buffers" "save")
5267 0 : save-some-buffers-action-alist))
5268 : ;; Maybe to save abbrevs, and record whether
5269 : ;; we either saved them or asked to.
5270 0 : (and save-abbrevs abbrevs-changed
5271 0 : (progn
5272 0 : (if (or arg
5273 0 : (eq save-abbrevs 'silently)
5274 0 : (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
5275 0 : (write-abbrev-file nil))
5276 : ;; Don't keep bothering user if he says no.
5277 0 : (setq abbrevs-changed nil)
5278 0 : (setq abbrevs-done t)))
5279 0 : (or queried (> files-done 0) abbrevs-done
5280 0 : (cond
5281 0 : ((null autosaved-buffers)
5282 0 : (when (called-interactively-p 'any)
5283 0 : (files--message "(No files need saving)")))
5284 0 : ((= (length autosaved-buffers) 1)
5285 0 : (files--message "(Saved %s)" (car autosaved-buffers)))
5286 : (t
5287 0 : (files--message "(Saved %d files: %s)"
5288 0 : (length autosaved-buffers)
5289 0 : (mapconcat 'identity autosaved-buffers ", "))))))))
5290 :
5291 : (defun clear-visited-file-modtime ()
5292 : "Clear out records of last mod time of visited file.
5293 : Next attempt to save will not complain of a discrepancy."
5294 27 : (set-visited-file-modtime 0))
5295 :
5296 : (defun not-modified (&optional arg)
5297 : "Mark current buffer as unmodified, not needing to be saved.
5298 : With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
5299 :
5300 : It is not a good idea to use this function in Lisp programs, because it
5301 : prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
5302 : (declare (interactive-only set-buffer-modified-p))
5303 : (interactive "P")
5304 0 : (files--message (if arg "Modification-flag set"
5305 0 : "Modification-flag cleared"))
5306 0 : (set-buffer-modified-p arg))
5307 :
5308 : (defun toggle-read-only (&optional arg interactive)
5309 : "Change whether this buffer is read-only."
5310 : (declare (obsolete read-only-mode "24.3"))
5311 0 : (interactive (list current-prefix-arg t))
5312 0 : (if interactive
5313 0 : (call-interactively 'read-only-mode)
5314 0 : (read-only-mode (or arg 'toggle))))
5315 :
5316 : (defun insert-file (filename)
5317 : "Insert contents of file FILENAME into buffer after point.
5318 : Set mark after the inserted text.
5319 :
5320 : This function is meant for the user to run interactively.
5321 : Don't call it from programs! Use `insert-file-contents' instead.
5322 : \(Its calling sequence is different; see its documentation)."
5323 : (declare (interactive-only insert-file-contents))
5324 : (interactive "*fInsert file: ")
5325 0 : (insert-file-1 filename #'insert-file-contents))
5326 :
5327 : (defun append-to-file (start end filename)
5328 : "Append the contents of the region to the end of file FILENAME.
5329 : When called from a function, expects three arguments,
5330 : START, END and FILENAME. START and END are normally buffer positions
5331 : specifying the part of the buffer to write.
5332 : If START is nil, that means to use the entire buffer contents.
5333 : If START is a string, then output that string to the file
5334 : instead of any buffer contents; END is ignored.
5335 :
5336 : This does character code conversion and applies annotations
5337 : like `write-region' does."
5338 : (interactive "r\nFAppend to file: ")
5339 0 : (prog1 (write-region start end filename t)
5340 0 : (when save-silently (message nil))))
5341 :
5342 : (defun file-newest-backup (filename)
5343 : "Return most recent backup file for FILENAME or nil if no backups exist."
5344 : ;; `make-backup-file-name' will get us the right directory for
5345 : ;; ordinary or numeric backups. It might create a directory for
5346 : ;; backups as a side-effect, according to `backup-directory-alist'.
5347 0 : (let* ((filename (file-name-sans-versions
5348 0 : (make-backup-file-name (expand-file-name filename))))
5349 0 : (file (file-name-nondirectory filename))
5350 0 : (dir (file-name-directory filename))
5351 0 : (comp (file-name-all-completions file dir))
5352 : (newest nil)
5353 : tem)
5354 0 : (while comp
5355 0 : (setq tem (pop comp))
5356 0 : (cond ((and (backup-file-name-p tem)
5357 0 : (string= (file-name-sans-versions tem) file))
5358 0 : (setq tem (concat dir tem))
5359 0 : (if (or (null newest)
5360 0 : (file-newer-than-file-p tem newest))
5361 0 : (setq newest tem)))))
5362 0 : newest))
5363 :
5364 : (defun rename-uniquely ()
5365 : "Rename current buffer to a similar name not already taken.
5366 : This function is useful for creating multiple shell process buffers
5367 : or multiple mail buffers, etc.
5368 :
5369 : Note that some commands, in particular those based on `compilation-mode'
5370 : \(`compile', `grep', etc.) will reuse the current buffer if it has the
5371 : appropriate mode even if it has been renamed. So as well as renaming
5372 : the buffer, you also need to switch buffers before running another
5373 : instance of such commands."
5374 : (interactive)
5375 0 : (save-match-data
5376 0 : (let ((base-name (buffer-name)))
5377 0 : (and (string-match "<[0-9]+>\\'" base-name)
5378 0 : (not (and buffer-file-name
5379 0 : (string= base-name
5380 0 : (file-name-nondirectory buffer-file-name))))
5381 : ;; If the existing buffer name has a <NNN>,
5382 : ;; which isn't part of the file name (if any),
5383 : ;; then get rid of that.
5384 0 : (setq base-name (substring base-name 0 (match-beginning 0))))
5385 0 : (rename-buffer (generate-new-buffer-name base-name))
5386 0 : (force-mode-line-update))))
5387 :
5388 : (defun make-directory (dir &optional parents)
5389 : "Create the directory DIR and optionally any nonexistent parent dirs.
5390 : If DIR already exists as a directory, signal an error, unless
5391 : PARENTS is non-nil.
5392 :
5393 : Interactively, the default choice of directory to create is the
5394 : current buffer's default directory. That is useful when you have
5395 : visited a file in a nonexistent directory.
5396 :
5397 : Noninteractively, the second (optional) argument PARENTS, if
5398 : non-nil, says whether to create parent directories that don't
5399 : exist. Interactively, this happens by default.
5400 :
5401 : If creating the directory or directories fail, an error will be
5402 : raised."
5403 : (interactive
5404 0 : (list (read-file-name "Make directory: " default-directory default-directory
5405 0 : nil nil)
5406 0 : t))
5407 : ;; If default-directory is a remote directory,
5408 : ;; make sure we find its make-directory handler.
5409 142 : (setq dir (expand-file-name dir))
5410 142 : (let ((handler (find-file-name-handler dir 'make-directory)))
5411 142 : (if handler
5412 132 : (funcall handler 'make-directory dir parents)
5413 10 : (if (not parents)
5414 10 : (make-directory-internal dir)
5415 0 : (let ((dir (directory-file-name (expand-file-name dir)))
5416 : create-list)
5417 0 : (while (and (not (file-exists-p dir))
5418 : ;; If directory is its own parent, then we can't
5419 : ;; keep looping forever
5420 0 : (not (equal dir
5421 0 : (directory-file-name
5422 0 : (file-name-directory dir)))))
5423 0 : (setq create-list (cons dir create-list)
5424 0 : dir (directory-file-name (file-name-directory dir))))
5425 0 : (while create-list
5426 0 : (make-directory-internal (car create-list))
5427 140 : (setq create-list (cdr create-list))))))))
5428 :
5429 : (defconst directory-files-no-dot-files-regexp
5430 : "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
5431 : "Regexp matching any file name except \".\" and \"..\".")
5432 :
5433 : (defun files--force (no-such fn &rest args)
5434 : "Use NO-SUCH to affect behavior of function FN applied to list ARGS.
5435 : This acts like (apply FN ARGS) except it returns NO-SUCH if it is
5436 : non-nil and if FN fails due to a missing file or directory."
5437 102 : (condition-case err
5438 102 : (apply fn args)
5439 102 : (file-missing (or no-such (signal (car err) (cdr err))))))
5440 :
5441 : (defun delete-directory (directory &optional recursive trash)
5442 : "Delete the directory named DIRECTORY. Does not follow symlinks.
5443 : If RECURSIVE is non-nil, delete files in DIRECTORY as well, with
5444 : no error if something else is simultaneously deleting them.
5445 : TRASH non-nil means to trash the directory instead, provided
5446 : `delete-by-moving-to-trash' is non-nil.
5447 :
5448 : When called interactively, TRASH is nil if and only if a prefix
5449 : argument is given, and a further prompt asks the user for
5450 : RECURSIVE if DIRECTORY is nonempty."
5451 : (interactive
5452 0 : (let* ((trashing (and delete-by-moving-to-trash
5453 0 : (null current-prefix-arg)))
5454 0 : (dir (expand-file-name
5455 0 : (read-directory-name
5456 0 : (if trashing
5457 : "Move directory to trash: "
5458 0 : "Delete directory: ")
5459 0 : default-directory default-directory nil nil))))
5460 0 : (list dir
5461 0 : (if (directory-files dir nil directory-files-no-dot-files-regexp)
5462 0 : (y-or-n-p
5463 0 : (format-message "Directory `%s' is not empty, really %s? "
5464 0 : dir (if trashing "trash" "delete")))
5465 0 : nil)
5466 0 : (null current-prefix-arg))))
5467 : ;; If default-directory is a remote directory, make sure we find its
5468 : ;; delete-directory handler.
5469 134 : (setq directory (directory-file-name (expand-file-name directory)))
5470 134 : (let ((handler (find-file-name-handler directory 'delete-directory)))
5471 134 : (cond
5472 134 : (handler
5473 124 : (funcall handler 'delete-directory directory recursive trash))
5474 10 : ((and delete-by-moving-to-trash trash)
5475 : ;; Only move non-empty dir to trash if recursive deletion was
5476 : ;; requested. This mimics the non-`delete-by-moving-to-trash'
5477 : ;; case, where the operation fails in delete-directory-internal.
5478 : ;; As `move-file-to-trash' trashes directories (empty or
5479 : ;; otherwise) as a unit, we do not need to recurse here.
5480 0 : (if (and (not recursive)
5481 : ;; Check if directory is empty apart from "." and "..".
5482 0 : (directory-files
5483 0 : directory 'full directory-files-no-dot-files-regexp))
5484 0 : (error "Directory is not empty, not moving to trash")
5485 0 : (move-file-to-trash directory)))
5486 : ;; Otherwise, call ourselves recursively if needed.
5487 : (t
5488 10 : (when (or (not recursive) (file-symlink-p directory)
5489 10 : (let* ((files
5490 10 : (files--force t #'directory-files directory 'full
5491 10 : directory-files-no-dot-files-regexp))
5492 10 : (directory-exists (listp files)))
5493 10 : (when directory-exists
5494 10 : (mapc (lambda (file)
5495 : ;; This test is equivalent to but more efficient
5496 : ;; than (and (file-directory-p fn)
5497 : ;; (not (file-symlink-p fn))).
5498 82 : (if (eq t (car (file-attributes file)))
5499 0 : (delete-directory file recursive)
5500 82 : (files--force t #'delete-file file)))
5501 10 : files))
5502 10 : directory-exists))
5503 132 : (files--force recursive #'delete-directory-internal directory))))))
5504 :
5505 : (defun file-equal-p (file1 file2)
5506 : "Return non-nil if files FILE1 and FILE2 name the same file.
5507 : If FILE1 or FILE2 does not exist, the return value is unspecified."
5508 4 : (let ((handler (or (find-file-name-handler file1 'file-equal-p)
5509 4 : (find-file-name-handler file2 'file-equal-p))))
5510 4 : (if handler
5511 2 : (funcall handler 'file-equal-p file1 file2)
5512 2 : (let (f1-attr f2-attr)
5513 2 : (and (setq f1-attr (file-attributes (file-truename file1)))
5514 2 : (setq f2-attr (file-attributes (file-truename file2)))
5515 4 : (equal f1-attr f2-attr))))))
5516 :
5517 : (defun file-in-directory-p (file dir)
5518 : "Return non-nil if FILE is in DIR or a subdirectory of DIR.
5519 : A directory is considered to be \"in\" itself.
5520 : Return nil if DIR is not an existing directory."
5521 32 : (let ((handler (or (find-file-name-handler file 'file-in-directory-p)
5522 32 : (find-file-name-handler dir 'file-in-directory-p))))
5523 32 : (if handler
5524 16 : (funcall handler 'file-in-directory-p file dir)
5525 16 : (when (file-directory-p dir) ; DIR must exist.
5526 16 : (setq file (file-truename file)
5527 16 : dir (file-truename dir))
5528 16 : (let ((ls1 (split-string file "/" t))
5529 16 : (ls2 (split-string dir "/" t))
5530 : (root
5531 16 : (cond
5532 : ;; A UNC on Windows systems, or a "super-root" on Apollo.
5533 16 : ((string-match "\\`//" file) "//")
5534 16 : ((string-match "\\`/" file) "/")
5535 16 : (t "")))
5536 : (mismatch nil))
5537 104 : (while (and ls1 ls2 (not mismatch))
5538 88 : (if (string-equal (car ls1) (car ls2))
5539 72 : (setq root (concat root (car ls1) "/"))
5540 88 : (setq mismatch t))
5541 88 : (setq ls1 (cdr ls1)
5542 88 : ls2 (cdr ls2)))
5543 16 : (unless mismatch
5544 32 : (file-equal-p root dir)))))))
5545 :
5546 : (defun copy-directory (directory newname &optional keep-time parents copy-contents)
5547 : "Copy DIRECTORY to NEWNAME. Both args must be strings.
5548 : This function always sets the file modes of the output files to match
5549 : the corresponding input file.
5550 :
5551 : The third arg KEEP-TIME non-nil means give the output files the same
5552 : last-modified time as the old ones. (This works on only some systems.)
5553 :
5554 : A prefix arg makes KEEP-TIME non-nil.
5555 :
5556 : Noninteractively, the last argument PARENTS says whether to
5557 : create parent directories if they don't exist. Interactively,
5558 : this happens by default.
5559 :
5560 : If NEWNAME names an existing directory, copy DIRECTORY as a
5561 : subdirectory there. However, if called from Lisp with a non-nil
5562 : optional argument COPY-CONTENTS, copy the contents of DIRECTORY
5563 : directly into NEWNAME instead."
5564 : (interactive
5565 0 : (let ((dir (read-directory-name
5566 0 : "Copy directory: " default-directory default-directory t nil)))
5567 0 : (list dir
5568 0 : (read-directory-name
5569 0 : (format "Copy directory %s to: " dir)
5570 0 : default-directory default-directory nil nil)
5571 0 : current-prefix-arg t nil)))
5572 16 : (when (file-in-directory-p newname directory)
5573 0 : (error "Cannot copy `%s' into its subdirectory `%s'"
5574 16 : directory newname))
5575 : ;; If default-directory is a remote directory, make sure we find its
5576 : ;; copy-directory handler.
5577 16 : (let ((handler (or (find-file-name-handler directory 'copy-directory)
5578 16 : (find-file-name-handler newname 'copy-directory))))
5579 16 : (if handler
5580 8 : (funcall handler 'copy-directory directory
5581 8 : newname keep-time parents copy-contents)
5582 :
5583 : ;; Compute target name.
5584 8 : (setq directory (directory-file-name (expand-file-name directory))
5585 8 : newname (directory-file-name (expand-file-name newname)))
5586 :
5587 8 : (cond ((not (file-directory-p newname))
5588 : ;; If NEWNAME is not an existing directory, create it;
5589 : ;; that is where we will copy the files of DIRECTORY.
5590 4 : (make-directory newname parents))
5591 : ;; If NEWNAME is an existing directory and COPY-CONTENTS
5592 : ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
5593 4 : ((not copy-contents)
5594 2 : (setq newname (expand-file-name
5595 2 : (file-name-nondirectory
5596 2 : (directory-file-name directory))
5597 2 : newname))
5598 2 : (and (file-exists-p newname)
5599 0 : (not (file-directory-p newname))
5600 0 : (error "Cannot overwrite non-directory %s with a directory"
5601 2 : newname))
5602 8 : (make-directory newname t)))
5603 :
5604 : ;; Copy recursively.
5605 8 : (dolist (file
5606 : ;; We do not want to copy "." and "..".
5607 8 : (directory-files directory 'full
5608 8 : directory-files-no-dot-files-regexp))
5609 8 : (let ((target (expand-file-name (file-name-nondirectory file) newname))
5610 8 : (filetype (car (file-attributes file))))
5611 8 : (cond
5612 8 : ((eq filetype t) ; Directory but not a symlink.
5613 0 : (copy-directory file newname keep-time parents))
5614 8 : ((stringp filetype) ; Symbolic link
5615 0 : (make-symbolic-link filetype target t))
5616 8 : ((copy-file file target t keep-time)))))
5617 :
5618 : ;; Set directory attributes.
5619 8 : (let ((modes (file-modes directory))
5620 8 : (times (and keep-time (nth 5 (file-attributes directory)))))
5621 8 : (if modes (set-file-modes newname modes))
5622 16 : (if times (set-file-times newname times))))))
5623 :
5624 :
5625 : ;; At time of writing, only info uses this.
5626 : (defun prune-directory-list (dirs &optional keep reject)
5627 : "Return a copy of DIRS with all non-existent directories removed.
5628 : The optional argument KEEP is a list of directories to retain even if
5629 : they don't exist, and REJECT is a list of directories to remove from
5630 : DIRS, even if they exist; REJECT takes precedence over KEEP.
5631 :
5632 : Note that membership in REJECT and KEEP is checked using simple string
5633 : comparison."
5634 0 : (apply #'nconc
5635 0 : (mapcar (lambda (dir)
5636 0 : (and (not (member dir reject))
5637 0 : (or (member dir keep) (file-directory-p dir))
5638 0 : (list dir)))
5639 0 : dirs)))
5640 :
5641 :
5642 : (put 'revert-buffer-function 'permanent-local t)
5643 : (defvar revert-buffer-function #'revert-buffer--default
5644 : "Function to use to revert this buffer.
5645 : The function receives two arguments IGNORE-AUTO and NOCONFIRM,
5646 : which are the arguments that `revert-buffer' received.
5647 : It also has access to the `preserve-modes' argument of `revert-buffer'
5648 : via the `revert-buffer-preserve-modes' dynamic variable.
5649 :
5650 : For historical reasons, a value of nil means to use the default function.
5651 : This should not be relied upon.")
5652 :
5653 : (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
5654 : (defvar revert-buffer-insert-file-contents-function
5655 : #'revert-buffer-insert-file-contents--default-function
5656 : "Function to use to insert contents when reverting this buffer.
5657 : The function receives two arguments: the first the nominal file name to use;
5658 : the second is t if reading the auto-save file.
5659 :
5660 : The function is responsible for updating (or preserving) point.
5661 :
5662 : For historical reasons, a value of nil means to use the default function.
5663 : This should not be relied upon.")
5664 :
5665 : (defun buffer-stale--default-function (&optional _noconfirm)
5666 : "Default function to use for `buffer-stale-function'.
5667 : This function ignores its argument.
5668 : This returns non-nil if the current buffer is visiting a readable file
5669 : whose modification time does not match that of the buffer.
5670 :
5671 : This function only handles buffers that are visiting files.
5672 : Non-file buffers need a custom function"
5673 0 : (and buffer-file-name
5674 0 : (file-readable-p buffer-file-name)
5675 0 : (not (buffer-modified-p (current-buffer)))
5676 0 : (not (verify-visited-file-modtime (current-buffer)))))
5677 :
5678 : (defvar buffer-stale-function #'buffer-stale--default-function
5679 : "Function to check whether a buffer needs reverting.
5680 : This should be a function with one optional argument NOCONFIRM.
5681 : Auto Revert Mode passes t for NOCONFIRM. The function should return
5682 : non-nil if the buffer should be reverted. A return value of
5683 : `fast' means that the need for reverting was not checked, but
5684 : that reverting the buffer is fast. The buffer is current when
5685 : this function is called.
5686 :
5687 : The idea behind the NOCONFIRM argument is that it should be
5688 : non-nil if the buffer is going to be reverted without asking the
5689 : user. In such situations, one has to be careful with potentially
5690 : time consuming operations.
5691 :
5692 : For historical reasons, a value of nil means to use the default function.
5693 : This should not be relied upon.
5694 :
5695 : For more information on how this variable is used by Auto Revert mode,
5696 : see Info node `(emacs)Supporting additional buffers'.")
5697 :
5698 : (defvar before-revert-hook nil
5699 : "Normal hook for `revert-buffer' to run before reverting.
5700 : The function `revert-buffer--default' runs this.
5701 : A customized `revert-buffer-function' need not run this hook.")
5702 :
5703 : (defvar after-revert-hook nil
5704 : "Normal hook for `revert-buffer' to run after reverting.
5705 : Note that the hook value that it runs is the value that was in effect
5706 : before reverting; that makes a difference if you have buffer-local
5707 : hook functions.
5708 :
5709 : The function `revert-buffer--default' runs this.
5710 : A customized `revert-buffer-function' need not run this hook.")
5711 :
5712 : (defvar revert-buffer-in-progress-p nil
5713 : "Non-nil if a `revert-buffer' operation is in progress, nil otherwise.")
5714 :
5715 : (defvar revert-buffer-internal-hook)
5716 :
5717 : ;; `revert-buffer-function' was defined long ago to be a function of only
5718 : ;; 2 arguments, so we have to use a dynbind variable to pass the
5719 : ;; `preserve-modes' argument of `revert-buffer'.
5720 : (defvar revert-buffer-preserve-modes)
5721 :
5722 : (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
5723 : "Replace current buffer text with the text of the visited file on disk.
5724 : This undoes all changes since the file was visited or saved.
5725 : With a prefix argument, offer to revert from latest auto-save file, if
5726 : that is more recent than the visited file.
5727 :
5728 : This command also implements an interface for special buffers
5729 : that contain text which doesn't come from a file, but reflects
5730 : some other data instead (e.g. Dired buffers, `buffer-list'
5731 : buffers). This is done via the variable `revert-buffer-function'.
5732 : In these cases, it should reconstruct the buffer contents from the
5733 : appropriate data.
5734 :
5735 : When called from Lisp, the first argument is IGNORE-AUTO; only offer
5736 : to revert from the auto-save file when this is nil. Note that the
5737 : sense of this argument is the reverse of the prefix argument, for the
5738 : sake of backward compatibility. IGNORE-AUTO is optional, defaulting
5739 : to nil.
5740 :
5741 : Optional second argument NOCONFIRM means don't ask for confirmation
5742 : at all. (The variable `revert-without-query' offers another way to
5743 : revert buffers without querying for confirmation.)
5744 :
5745 : Optional third argument PRESERVE-MODES non-nil means don't alter
5746 : the files modes. Normally we reinitialize them using `normal-mode'.
5747 :
5748 : This function binds `revert-buffer-in-progress-p' non-nil while it operates.
5749 :
5750 : This function calls the function that `revert-buffer-function' specifies
5751 : to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
5752 : The default function runs the hooks `before-revert-hook' and
5753 : `after-revert-hook'."
5754 : ;; I admit it's odd to reverse the sense of the prefix argument, but
5755 : ;; there is a lot of code out there which assumes that the first
5756 : ;; argument should be t to avoid consulting the auto-save file, and
5757 : ;; there's no straightforward way to encourage authors to notice a
5758 : ;; reversal of the argument sense. So I'm just changing the user
5759 : ;; interface, but leaving the programmatic interface the same.
5760 0 : (interactive (list (not current-prefix-arg)))
5761 0 : (let ((revert-buffer-in-progress-p t)
5762 0 : (revert-buffer-preserve-modes preserve-modes))
5763 0 : (funcall (or revert-buffer-function #'revert-buffer--default)
5764 0 : ignore-auto noconfirm)))
5765 :
5766 : (defun revert-buffer--default (ignore-auto noconfirm)
5767 : "Default function for `revert-buffer'.
5768 : The arguments IGNORE-AUTO and NOCONFIRM are as described for `revert-buffer'.
5769 : Runs the hooks `before-revert-hook' and `after-revert-hook' at the
5770 : start and end.
5771 :
5772 : Calls `revert-buffer-insert-file-contents-function' to reread the
5773 : contents of the visited file, with two arguments: the first is the file
5774 : name, the second is non-nil if reading an auto-save file.
5775 :
5776 : This function only handles buffers that are visiting files.
5777 : Non-file buffers need a custom function."
5778 0 : (with-current-buffer (or (buffer-base-buffer (current-buffer))
5779 0 : (current-buffer))
5780 0 : (let* ((auto-save-p (and (not ignore-auto)
5781 0 : (recent-auto-save-p)
5782 0 : buffer-auto-save-file-name
5783 0 : (file-readable-p buffer-auto-save-file-name)
5784 0 : (y-or-n-p
5785 0 : "Buffer has been auto-saved recently. Revert from auto-save file? ")))
5786 0 : (file-name (if auto-save-p
5787 0 : buffer-auto-save-file-name
5788 0 : buffer-file-name)))
5789 0 : (cond ((null file-name)
5790 0 : (error "Buffer does not seem to be associated with any file"))
5791 0 : ((or noconfirm
5792 0 : (and (not (buffer-modified-p))
5793 0 : (catch 'found
5794 0 : (dolist (regexp revert-without-query)
5795 0 : (when (string-match regexp file-name)
5796 0 : (throw 'found t)))))
5797 0 : (yes-or-no-p (format "Revert buffer from file %s? "
5798 0 : file-name)))
5799 0 : (run-hooks 'before-revert-hook)
5800 : ;; If file was backed up but has changed since,
5801 : ;; we should make another backup.
5802 0 : (and (not auto-save-p)
5803 0 : (not (verify-visited-file-modtime (current-buffer)))
5804 0 : (setq buffer-backed-up nil))
5805 : ;; Effectively copy the after-revert-hook status,
5806 : ;; since after-find-file will clobber it.
5807 0 : (let ((global-hook (default-value 'after-revert-hook))
5808 0 : (local-hook (when (local-variable-p 'after-revert-hook)
5809 0 : after-revert-hook))
5810 : (inhibit-read-only t))
5811 : ;; FIXME: Throw away undo-log when preserve-modes is nil?
5812 0 : (funcall
5813 0 : (or revert-buffer-insert-file-contents-function
5814 0 : #'revert-buffer-insert-file-contents--default-function)
5815 0 : file-name auto-save-p)
5816 : ;; Recompute the truename in case changes in symlinks
5817 : ;; have changed the truename.
5818 0 : (setq buffer-file-truename
5819 0 : (abbreviate-file-name (file-truename buffer-file-name)))
5820 0 : (after-find-file nil nil t nil revert-buffer-preserve-modes)
5821 : ;; Run after-revert-hook as it was before we reverted.
5822 0 : (setq-default revert-buffer-internal-hook global-hook)
5823 0 : (if local-hook
5824 0 : (set (make-local-variable 'revert-buffer-internal-hook)
5825 0 : local-hook)
5826 0 : (kill-local-variable 'revert-buffer-internal-hook))
5827 0 : (run-hooks 'revert-buffer-internal-hook))
5828 0 : t)))))
5829 :
5830 : (defun revert-buffer-insert-file-contents--default-function (file-name auto-save-p)
5831 : "Default function for `revert-buffer-insert-file-contents-function'.
5832 : The function `revert-buffer--default' calls this.
5833 : FILE-NAME is the name of the file. AUTO-SAVE-P is non-nil if this is
5834 : an auto-save file."
5835 0 : (cond
5836 0 : ((not (file-exists-p file-name))
5837 0 : (error (if buffer-file-number
5838 : "File %s no longer exists!"
5839 0 : "Cannot revert nonexistent file %s")
5840 0 : file-name))
5841 0 : ((not (file-readable-p file-name))
5842 0 : (error (if buffer-file-number
5843 : "File %s no longer readable!"
5844 0 : "Cannot revert unreadable file %s")
5845 0 : file-name))
5846 : (t
5847 : ;; Bind buffer-file-name to nil
5848 : ;; so that we don't try to lock the file.
5849 0 : (let ((buffer-file-name nil))
5850 0 : (or auto-save-p
5851 0 : (unlock-buffer)))
5852 0 : (widen)
5853 0 : (let ((coding-system-for-read
5854 : ;; Auto-saved file should be read by Emacs's
5855 : ;; internal coding.
5856 0 : (if auto-save-p 'auto-save-coding
5857 0 : (or coding-system-for-read
5858 0 : (and
5859 0 : buffer-file-coding-system-explicit
5860 0 : (car buffer-file-coding-system-explicit))))))
5861 0 : (if (and (not enable-multibyte-characters)
5862 0 : coding-system-for-read
5863 0 : (not (memq (coding-system-base
5864 0 : coding-system-for-read)
5865 0 : '(no-conversion raw-text))))
5866 : ;; As a coding system suitable for multibyte
5867 : ;; buffer is specified, make the current
5868 : ;; buffer multibyte.
5869 0 : (set-buffer-multibyte t))
5870 :
5871 : ;; This force after-insert-file-set-coding
5872 : ;; (called from insert-file-contents) to set
5873 : ;; buffer-file-coding-system to a proper value.
5874 0 : (kill-local-variable 'buffer-file-coding-system)
5875 :
5876 : ;; Note that this preserves point in an intelligent way.
5877 0 : (if revert-buffer-preserve-modes
5878 0 : (let ((buffer-file-format buffer-file-format))
5879 0 : (insert-file-contents file-name (not auto-save-p)
5880 0 : nil nil t))
5881 0 : (insert-file-contents file-name (not auto-save-p)
5882 0 : nil nil t))))))
5883 :
5884 : (defun recover-this-file ()
5885 : "Recover the visited file--get contents from its last auto-save file."
5886 : (interactive)
5887 0 : (or buffer-file-name
5888 0 : (user-error "This buffer is not visiting a file"))
5889 0 : (recover-file buffer-file-name))
5890 :
5891 : (defun recover-file (file)
5892 : "Visit file FILE, but get contents from its last auto-save file."
5893 : ;; Actually putting the file name in the minibuffer should be used
5894 : ;; only rarely.
5895 : ;; Not just because users often use the default.
5896 : (interactive "FRecover file: ")
5897 0 : (setq file (expand-file-name file))
5898 0 : (if (auto-save-file-name-p (file-name-nondirectory file))
5899 0 : (error "%s is an auto-save file" (abbreviate-file-name file)))
5900 0 : (let ((file-name (let ((buffer-file-name file))
5901 0 : (make-auto-save-file-name))))
5902 0 : (cond ((if (file-exists-p file)
5903 0 : (not (file-newer-than-file-p file-name file))
5904 0 : (not (file-exists-p file-name)))
5905 0 : (error "Auto-save file %s not current"
5906 0 : (abbreviate-file-name file-name)))
5907 0 : ((with-temp-buffer-window
5908 : "*Directory*" nil
5909 0 : #'(lambda (window _value)
5910 0 : (with-selected-window window
5911 0 : (unwind-protect
5912 0 : (yes-or-no-p (format "Recover auto save file %s? " file-name))
5913 0 : (when (window-live-p window)
5914 0 : (quit-restore-window window 'kill)))))
5915 0 : (with-current-buffer standard-output
5916 0 : (let ((switches dired-listing-switches))
5917 0 : (if (file-symlink-p file)
5918 0 : (setq switches (concat switches " -L")))
5919 : ;; Use insert-directory-safely, not insert-directory,
5920 : ;; because these files might not exist. In particular,
5921 : ;; FILE might not exist if the auto-save file was for
5922 : ;; a buffer that didn't visit a file, such as "*mail*".
5923 : ;; The code in v20.x called `ls' directly, so we need
5924 : ;; to emulate what `ls' did in that case.
5925 0 : (insert-directory-safely file switches)
5926 0 : (insert-directory-safely file-name switches))))
5927 0 : (switch-to-buffer (find-file-noselect file t))
5928 0 : (let ((inhibit-read-only t)
5929 : ;; Keep the current buffer-file-coding-system.
5930 0 : (coding-system buffer-file-coding-system)
5931 : ;; Auto-saved file should be read with special coding.
5932 : (coding-system-for-read 'auto-save-coding))
5933 0 : (erase-buffer)
5934 0 : (insert-file-contents file-name nil)
5935 0 : (set-buffer-file-coding-system coding-system))
5936 0 : (after-find-file nil nil t))
5937 0 : (t (user-error "Recover-file canceled")))))
5938 :
5939 : (defun recover-session ()
5940 : "Recover auto save files from a previous Emacs session.
5941 : This command first displays a Dired buffer showing you the
5942 : previous sessions that you could recover from.
5943 : To choose one, move point to the proper line and then type C-c C-c.
5944 : Then you'll be asked about a number of files to recover."
5945 : (interactive)
5946 0 : (if (null auto-save-list-file-prefix)
5947 0 : (error "You set `auto-save-list-file-prefix' to disable making session files"))
5948 0 : (let ((dir (file-name-directory auto-save-list-file-prefix))
5949 0 : (nd (file-name-nondirectory auto-save-list-file-prefix)))
5950 0 : (unless (file-directory-p dir)
5951 0 : (make-directory dir t))
5952 0 : (unless (directory-files dir nil
5953 0 : (if (string= "" nd)
5954 0 : directory-files-no-dot-files-regexp
5955 0 : (concat "\\`" (regexp-quote nd)))
5956 0 : t)
5957 0 : (error "No previous sessions to recover")))
5958 0 : (let ((ls-lisp-support-shell-wildcards t))
5959 0 : (dired (concat auto-save-list-file-prefix "*")
5960 0 : (concat dired-listing-switches " -t")))
5961 0 : (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
5962 0 : (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)
5963 0 : (save-excursion
5964 0 : (goto-char (point-min))
5965 0 : (or (looking-at " Move to the session you want to recover,")
5966 0 : (let ((inhibit-read-only t))
5967 : ;; Each line starts with a space
5968 : ;; so that Font Lock mode won't highlight the first character.
5969 0 : (insert " To recover a session, move to it and type C-c C-c.\n"
5970 0 : (substitute-command-keys
5971 : " To delete a session file, type \
5972 : \\[dired-flag-file-deletion] on its line to flag
5973 : the file for deletion, then \\[dired-do-flagged-delete] to \
5974 0 : delete flagged files.\n\n"))))))
5975 :
5976 : (defun recover-session-finish ()
5977 : "Choose one saved session to recover auto-save files from.
5978 : This command is used in the special Dired buffer created by
5979 : \\[recover-session]."
5980 : (interactive)
5981 : ;; Get the name of the session file to recover from.
5982 0 : (let ((file (dired-get-filename))
5983 : files
5984 0 : (buffer (get-buffer-create " *recover*")))
5985 0 : (dired-unmark 1)
5986 0 : (dired-do-flagged-delete t)
5987 0 : (unwind-protect
5988 0 : (with-current-buffer buffer
5989 : ;; Read in the auto-save-list file.
5990 0 : (erase-buffer)
5991 0 : (insert-file-contents file)
5992 : ;; Loop thru the text of that file
5993 : ;; and get out the names of the files to recover.
5994 0 : (while (not (eobp))
5995 0 : (let (thisfile autofile)
5996 0 : (if (eolp)
5997 : ;; This is a pair of lines for a non-file-visiting buffer.
5998 : ;; Get the auto-save file name and manufacture
5999 : ;; a "visited file name" from that.
6000 0 : (progn
6001 0 : (forward-line 1)
6002 : ;; If there is no auto-save file name, the
6003 : ;; auto-save-list file is probably corrupted.
6004 0 : (unless (eolp)
6005 0 : (setq autofile
6006 0 : (buffer-substring-no-properties
6007 0 : (point)
6008 0 : (line-end-position)))
6009 0 : (setq thisfile
6010 0 : (expand-file-name
6011 0 : (substring
6012 0 : (file-name-nondirectory autofile)
6013 0 : 1 -1)
6014 0 : (file-name-directory autofile))))
6015 0 : (forward-line 1))
6016 : ;; This pair of lines is a file-visiting
6017 : ;; buffer. Use the visited file name.
6018 0 : (progn
6019 0 : (setq thisfile
6020 0 : (buffer-substring-no-properties
6021 0 : (point) (progn (end-of-line) (point))))
6022 0 : (forward-line 1)
6023 0 : (setq autofile
6024 0 : (buffer-substring-no-properties
6025 0 : (point) (progn (end-of-line) (point))))
6026 0 : (forward-line 1)))
6027 : ;; Ignore a file if its auto-save file does not exist now.
6028 0 : (if (and autofile (file-exists-p autofile))
6029 0 : (setq files (cons thisfile files)))))
6030 0 : (setq files (nreverse files))
6031 : ;; The file contains a pair of line for each auto-saved buffer.
6032 : ;; The first line of the pair contains the visited file name
6033 : ;; or is empty if the buffer was not visiting a file.
6034 : ;; The second line is the auto-save file name.
6035 0 : (if files
6036 0 : (map-y-or-n-p "Recover %s? "
6037 : (lambda (file)
6038 0 : (condition-case nil
6039 0 : (save-excursion (recover-file file))
6040 : (error
6041 0 : "Failed to recover `%s'" file)))
6042 0 : files
6043 0 : '("file" "files" "recover"))
6044 0 : (message "No files can be recovered from this session now")))
6045 0 : (kill-buffer buffer))))
6046 :
6047 : (defun kill-buffer-ask (buffer)
6048 : "Kill BUFFER if confirmed."
6049 0 : (when (yes-or-no-p (format "Buffer %s %s. Kill? "
6050 0 : (buffer-name buffer)
6051 0 : (if (buffer-modified-p buffer)
6052 0 : "HAS BEEN EDITED" "is unmodified")))
6053 0 : (kill-buffer buffer)))
6054 :
6055 : (defun kill-some-buffers (&optional list)
6056 : "Kill some buffers. Asks the user whether to kill each one of them.
6057 : Non-interactively, if optional argument LIST is non-nil, it
6058 : specifies the list of buffers to kill, asking for approval for each one."
6059 : (interactive)
6060 0 : (if (null list)
6061 0 : (setq list (buffer-list)))
6062 0 : (while list
6063 0 : (let* ((buffer (car list))
6064 0 : (name (buffer-name buffer)))
6065 0 : (and name ; Can be nil for an indirect buffer
6066 : ; if we killed the base buffer.
6067 0 : (not (string-equal name ""))
6068 0 : (/= (aref name 0) ?\s)
6069 0 : (kill-buffer-ask buffer)))
6070 0 : (setq list (cdr list))))
6071 :
6072 : (defun kill-matching-buffers (regexp &optional internal-too no-ask)
6073 : "Kill buffers whose name matches the specified REGEXP.
6074 : Ignores buffers whose name starts with a space, unless optional
6075 : prefix argument INTERNAL-TOO is non-nil. Asks before killing
6076 : each buffer, unless NO-ASK is non-nil."
6077 : (interactive "sKill buffers matching this regular expression: \nP")
6078 0 : (dolist (buffer (buffer-list))
6079 0 : (let ((name (buffer-name buffer)))
6080 0 : (when (and name (not (string-equal name ""))
6081 0 : (or internal-too (/= (aref name 0) ?\s))
6082 0 : (string-match regexp name))
6083 0 : (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer)))))
6084 :
6085 :
6086 : (defun rename-auto-save-file ()
6087 : "Adjust current buffer's auto save file name for current conditions.
6088 : Also rename any existing auto save file, if it was made in this session."
6089 0 : (let ((osave buffer-auto-save-file-name))
6090 0 : (setq buffer-auto-save-file-name
6091 0 : (make-auto-save-file-name))
6092 0 : (if (and osave buffer-auto-save-file-name
6093 0 : (not (string= buffer-auto-save-file-name buffer-file-name))
6094 0 : (not (string= buffer-auto-save-file-name osave))
6095 0 : (file-exists-p osave)
6096 0 : (recent-auto-save-p))
6097 0 : (rename-file osave buffer-auto-save-file-name t))))
6098 :
6099 : (defun make-auto-save-file-name ()
6100 : "Return file name to use for auto-saves of current buffer.
6101 : Does not consider `auto-save-visited-file-name' as that variable is checked
6102 : before calling this function. You can redefine this for customization.
6103 : See also `auto-save-file-name-p'."
6104 8 : (if buffer-file-name
6105 8 : (let ((handler (find-file-name-handler buffer-file-name
6106 8 : 'make-auto-save-file-name)))
6107 8 : (if handler
6108 4 : (funcall handler 'make-auto-save-file-name)
6109 4 : (let ((list auto-save-file-name-transforms)
6110 4 : (filename buffer-file-name)
6111 : result uniq)
6112 : ;; Apply user-specified translations
6113 : ;; to the file name.
6114 6 : (while (and list (not result))
6115 2 : (if (string-match (car (car list)) filename)
6116 2 : (setq result (replace-match (cadr (car list)) t nil
6117 2 : filename)
6118 2 : uniq (car (cddr (car list)))))
6119 4 : (setq list (cdr list)))
6120 4 : (if result
6121 2 : (if uniq
6122 2 : (setq filename (concat
6123 2 : (file-name-directory result)
6124 2 : (subst-char-in-string
6125 : ?/ ?!
6126 2 : (replace-regexp-in-string "!" "!!"
6127 2 : filename))))
6128 4 : (setq filename result)))
6129 4 : (setq result
6130 4 : (if (and (eq system-type 'ms-dos)
6131 4 : (not (msdos-long-file-names)))
6132 : ;; We truncate the file name to DOS 8+3 limits
6133 : ;; before doing anything else, because the regexp
6134 : ;; passed to string-match below cannot handle
6135 : ;; extensions longer than 3 characters, multiple
6136 : ;; dots, and other atrocities.
6137 0 : (let ((fn (dos-8+3-filename
6138 0 : (file-name-nondirectory buffer-file-name))))
6139 0 : (string-match
6140 : "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
6141 0 : fn)
6142 0 : (concat (file-name-directory buffer-file-name)
6143 0 : "#" (match-string 1 fn)
6144 0 : "." (match-string 3 fn) "#"))
6145 4 : (concat (file-name-directory filename)
6146 : "#"
6147 4 : (file-name-nondirectory filename)
6148 4 : "#")))
6149 : ;; Make sure auto-save file names don't contain characters
6150 : ;; invalid for the underlying filesystem.
6151 4 : (if (and (memq system-type '(ms-dos windows-nt cygwin))
6152 : ;; Don't modify remote filenames
6153 4 : (not (file-remote-p result)))
6154 0 : (convert-standard-filename result)
6155 8 : result))))
6156 :
6157 : ;; Deal with buffers that don't have any associated files. (Mail
6158 : ;; mode tends to create a good number of these.)
6159 :
6160 0 : (let ((buffer-name (buffer-name))
6161 : (limit 0)
6162 : file-name)
6163 : ;; Restrict the characters used in the file name to those which
6164 : ;; are known to be safe on all filesystems, url-encoding the
6165 : ;; rest.
6166 : ;; We do this on all platforms, because even if we are not
6167 : ;; running on DOS/Windows, the current directory may be on a
6168 : ;; mounted VFAT filesystem, such as a USB memory stick.
6169 0 : (while (string-match "[^A-Za-z0-9-_.~#+]" buffer-name limit)
6170 0 : (let* ((character (aref buffer-name (match-beginning 0)))
6171 : (replacement
6172 : ;; For multibyte characters, this will produce more than
6173 : ;; 2 hex digits, so is not true URL encoding.
6174 0 : (format "%%%02X" character)))
6175 0 : (setq buffer-name (replace-match replacement t t buffer-name))
6176 0 : (setq limit (1+ (match-end 0)))))
6177 : ;; Generate the file name.
6178 0 : (setq file-name
6179 0 : (make-temp-file
6180 0 : (let ((fname
6181 0 : (expand-file-name
6182 0 : (format "#%s#" buffer-name)
6183 : ;; Try a few alternative directories, to get one we can
6184 : ;; write it.
6185 0 : (cond
6186 0 : ((file-writable-p default-directory) default-directory)
6187 0 : ((file-writable-p "/var/tmp/") "/var/tmp/")
6188 0 : ("~/")))))
6189 0 : (if (and (memq system-type '(ms-dos windows-nt cygwin))
6190 : ;; Don't modify remote filenames
6191 0 : (not (file-remote-p fname)))
6192 : ;; The call to convert-standard-filename is in case
6193 : ;; buffer-name includes characters not allowed by the
6194 : ;; DOS/Windows filesystems. make-temp-file writes to the
6195 : ;; file it creates, so we must fix the file name _before_
6196 : ;; make-temp-file is called.
6197 0 : (convert-standard-filename fname)
6198 0 : fname))
6199 0 : nil "#"))
6200 : ;; make-temp-file creates the file,
6201 : ;; but we don't want it to exist until we do an auto-save.
6202 0 : (condition-case ()
6203 0 : (delete-file file-name)
6204 0 : (file-error nil))
6205 8 : file-name)))
6206 :
6207 : (defun auto-save-file-name-p (filename)
6208 : "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
6209 : FILENAME should lack slashes. You can redefine this for customization."
6210 0 : (string-match "\\`#.*#\\'" filename))
6211 :
6212 : (defun wildcard-to-regexp (wildcard)
6213 : "Given a shell file name pattern WILDCARD, return an equivalent regexp.
6214 : The generated regexp will match a filename only if the filename
6215 : matches that wildcard according to shell rules. Only wildcards known
6216 : by `sh' are supported."
6217 0 : (let* ((i (string-match "[[.*+\\^$?]" wildcard))
6218 : ;; Copy the initial run of non-special characters.
6219 0 : (result (substring wildcard 0 i))
6220 0 : (len (length wildcard)))
6221 : ;; If no special characters, we're almost done.
6222 0 : (if i
6223 0 : (while (< i len)
6224 0 : (let ((ch (aref wildcard i))
6225 : j)
6226 0 : (setq
6227 : result
6228 0 : (concat result
6229 0 : (cond
6230 0 : ((and (eq ch ?\[)
6231 0 : (< (1+ i) len)
6232 0 : (eq (aref wildcard (1+ i)) ?\]))
6233 : "\\[")
6234 0 : ((eq ch ?\[) ; [...] maps to regexp char class
6235 0 : (progn
6236 0 : (setq i (1+ i))
6237 0 : (concat
6238 0 : (cond
6239 0 : ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
6240 0 : (progn
6241 0 : (setq i (1+ i))
6242 0 : (if (eq (aref wildcard i) ?\])
6243 0 : (progn
6244 0 : (setq i (1+ i))
6245 0 : "[^]")
6246 0 : "[^")))
6247 0 : ((eq (aref wildcard i) ?^)
6248 : ;; Found "[^". Insert a `\0' character
6249 : ;; (which cannot happen in a filename)
6250 : ;; into the character class, so that `^'
6251 : ;; is not the first character after `[',
6252 : ;; and thus non-special in a regexp.
6253 0 : (progn
6254 0 : (setq i (1+ i))
6255 0 : "[\000^"))
6256 0 : ((eq (aref wildcard i) ?\])
6257 : ;; I don't think `]' can appear in a
6258 : ;; character class in a wildcard, but
6259 : ;; let's be general here.
6260 0 : (progn
6261 0 : (setq i (1+ i))
6262 0 : "[]"))
6263 0 : (t "["))
6264 0 : (prog1 ; copy everything upto next `]'.
6265 0 : (substring wildcard
6266 0 : i
6267 0 : (setq j (string-match
6268 0 : "]" wildcard i)))
6269 0 : (setq i (if j (1- j) (1- len)))))))
6270 0 : ((eq ch ?.) "\\.")
6271 0 : ((eq ch ?*) "[^\000]*")
6272 0 : ((eq ch ?+) "\\+")
6273 0 : ((eq ch ?^) "\\^")
6274 0 : ((eq ch ?$) "\\$")
6275 0 : ((eq ch ?\\) "\\\\") ; probably cannot happen...
6276 0 : ((eq ch ??) "[^\000]")
6277 0 : (t (char-to-string ch)))))
6278 0 : (setq i (1+ i)))))
6279 : ;; Shell wildcards should match the entire filename,
6280 : ;; not its part. Make the regexp say so.
6281 0 : (concat "\\`" result "\\'")))
6282 :
6283 : (defcustom list-directory-brief-switches
6284 : (purecopy "-CF")
6285 : "Switches for `list-directory' to pass to `ls' for brief listing."
6286 : :type 'string
6287 : :group 'dired)
6288 :
6289 : (defcustom list-directory-verbose-switches
6290 : (purecopy "-l")
6291 : "Switches for `list-directory' to pass to `ls' for verbose listing."
6292 : :type 'string
6293 : :group 'dired)
6294 :
6295 : (defun file-expand-wildcards (pattern &optional full)
6296 : "Expand wildcard pattern PATTERN.
6297 : This returns a list of file names which match the pattern.
6298 : Files are sorted in `string<' order.
6299 :
6300 : If PATTERN is written as an absolute file name,
6301 : the values are absolute also.
6302 :
6303 : If PATTERN is written as a relative file name, it is interpreted
6304 : relative to the current default directory, `default-directory'.
6305 : The file names returned are normally also relative to the current
6306 : default directory. However, if FULL is non-nil, they are absolute."
6307 0 : (save-match-data
6308 0 : (let* ((nondir (file-name-nondirectory pattern))
6309 0 : (dirpart (file-name-directory pattern))
6310 : ;; A list of all dirs that DIRPART specifies.
6311 : ;; This can be more than one dir
6312 : ;; if DIRPART contains wildcards.
6313 0 : (dirs (if (and dirpart
6314 0 : (string-match "[[*?]" (file-local-name dirpart)))
6315 0 : (mapcar 'file-name-as-directory
6316 0 : (file-expand-wildcards (directory-file-name dirpart)))
6317 0 : (list dirpart)))
6318 : contents)
6319 0 : (dolist (dir dirs)
6320 0 : (when (or (null dir) ; Possible if DIRPART is not wild.
6321 0 : (file-accessible-directory-p dir))
6322 0 : (let ((this-dir-contents
6323 : ;; Filter out "." and ".."
6324 0 : (delq nil
6325 0 : (mapcar #'(lambda (name)
6326 0 : (unless (string-match "\\`\\.\\.?\\'"
6327 0 : (file-name-nondirectory name))
6328 0 : name))
6329 0 : (directory-files (or dir ".") full
6330 0 : (wildcard-to-regexp nondir))))))
6331 0 : (setq contents
6332 0 : (nconc
6333 0 : (if (and dir (not full))
6334 0 : (mapcar #'(lambda (name) (concat dir name))
6335 0 : this-dir-contents)
6336 0 : this-dir-contents)
6337 0 : contents)))))
6338 0 : contents)))
6339 :
6340 : ;; Let Tramp know that `file-expand-wildcards' does not need an advice.
6341 : (provide 'files '(remote-wildcards))
6342 :
6343 : (defun list-directory (dirname &optional verbose)
6344 : "Display a list of files in or matching DIRNAME, a la `ls'.
6345 : DIRNAME is globbed by the shell if necessary.
6346 : Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
6347 : Actions controlled by variables `list-directory-brief-switches'
6348 : and `list-directory-verbose-switches'."
6349 0 : (interactive (let ((pfx current-prefix-arg))
6350 0 : (list (read-directory-name (if pfx "List directory (verbose): "
6351 0 : "List directory (brief): ")
6352 0 : nil default-directory nil)
6353 0 : pfx)))
6354 0 : (let ((switches (if verbose list-directory-verbose-switches
6355 0 : list-directory-brief-switches))
6356 : buffer)
6357 0 : (or dirname (setq dirname default-directory))
6358 0 : (setq dirname (expand-file-name dirname))
6359 0 : (with-output-to-temp-buffer "*Directory*"
6360 0 : (setq buffer standard-output)
6361 0 : (buffer-disable-undo standard-output)
6362 0 : (princ "Directory ")
6363 0 : (princ dirname)
6364 0 : (terpri)
6365 0 : (with-current-buffer "*Directory*"
6366 0 : (let ((wildcard (not (file-directory-p dirname))))
6367 0 : (insert-directory dirname switches wildcard (not wildcard)))))
6368 : ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
6369 0 : (with-current-buffer buffer
6370 0 : (setq default-directory
6371 0 : (if (file-directory-p dirname)
6372 0 : (file-name-as-directory dirname)
6373 0 : (file-name-directory dirname))))))
6374 :
6375 : (defun shell-quote-wildcard-pattern (pattern)
6376 : "Quote characters special to the shell in PATTERN, leave wildcards alone.
6377 :
6378 : PATTERN is assumed to represent a file-name wildcard suitable for the
6379 : underlying filesystem. For Unix and GNU/Linux, each character from the
6380 : set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
6381 : the parts of the pattern which don't include wildcard characters are
6382 : quoted with double quotes.
6383 :
6384 : This function leaves alone existing quote characters (\\ on Unix and \"
6385 : on Windows), so PATTERN can use them to quote wildcard characters that
6386 : need to be passed verbatim to shell commands."
6387 0 : (save-match-data
6388 0 : (cond
6389 0 : ((memq system-type '(ms-dos windows-nt cygwin))
6390 : ;; DOS/Windows don't allow `"' in file names. So if the
6391 : ;; argument has quotes, we can safely assume it is already
6392 : ;; quoted by the caller.
6393 0 : (if (or (string-match "[\"]" pattern)
6394 : ;; We quote [&()#$`'] in case their shell is a port of a
6395 : ;; Unixy shell. We quote [,=+] because stock DOS and
6396 : ;; Windows shells require that in some cases, such as
6397 : ;; passing arguments to batch files that use positional
6398 : ;; arguments like %1.
6399 0 : (not (string-match "[ \t;&()#$`',=+]" pattern)))
6400 0 : pattern
6401 0 : (let ((result "\"")
6402 : (beg 0)
6403 : end)
6404 0 : (while (string-match "[*?]+" pattern beg)
6405 0 : (setq end (match-beginning 0)
6406 0 : result (concat result (substring pattern beg end)
6407 : "\""
6408 0 : (substring pattern end (match-end 0))
6409 0 : "\"")
6410 0 : beg (match-end 0)))
6411 0 : (concat result (substring pattern beg) "\""))))
6412 : (t
6413 0 : (let ((beg 0))
6414 0 : (while (string-match "[ \t\n;<>&|()`'\"#$]" pattern beg)
6415 0 : (setq pattern
6416 0 : (concat (substring pattern 0 (match-beginning 0))
6417 : "\\"
6418 0 : (substring pattern (match-beginning 0)))
6419 0 : beg (1+ (match-end 0)))))
6420 0 : pattern))))
6421 :
6422 :
6423 : (defvar insert-directory-program (purecopy "ls")
6424 : "Absolute or relative name of the `ls' program used by `insert-directory'.")
6425 :
6426 : (defcustom directory-free-space-program (purecopy "df")
6427 : "Program to get the amount of free space on a file system.
6428 : We assume the output has the format of `df'.
6429 : The value of this variable must be just a command name or file name;
6430 : if you want to specify options, use `directory-free-space-args'.
6431 :
6432 : A value of nil disables this feature.
6433 :
6434 : If the function `file-system-info' is defined, it is always used in
6435 : preference to the program given by this variable."
6436 : :type '(choice (string :tag "Program") (const :tag "None" nil))
6437 : :group 'dired)
6438 :
6439 : (defcustom directory-free-space-args
6440 : (purecopy (if (eq system-type 'darwin) "-k" "-Pk"))
6441 : "Options to use when running `directory-free-space-program'."
6442 : :type 'string
6443 : :group 'dired)
6444 :
6445 : (defun get-free-disk-space (dir)
6446 : "Return the amount of free space on directory DIR's file system.
6447 : The return value is a string describing the amount of free
6448 : space (normally, the number of free 1KB blocks).
6449 :
6450 : This function calls `file-system-info' if it is available, or
6451 : invokes the program specified by `directory-free-space-program'
6452 : and `directory-free-space-args'. If the system call or program
6453 : is unsuccessful, or if DIR is a remote directory, this function
6454 : returns nil."
6455 0 : (unless (file-remote-p (expand-file-name dir))
6456 : ;; Try to find the number of free blocks. Non-Posix systems don't
6457 : ;; always have df, but might have an equivalent system call.
6458 0 : (if (fboundp 'file-system-info)
6459 0 : (let ((fsinfo (file-system-info dir)))
6460 0 : (if fsinfo
6461 0 : (format "%.0f" (/ (nth 2 fsinfo) 1024))))
6462 0 : (setq dir (expand-file-name dir))
6463 0 : (save-match-data
6464 0 : (with-temp-buffer
6465 0 : (when (and directory-free-space-program
6466 : ;; Avoid failure if the default directory does
6467 : ;; not exist (Bug#2631, Bug#3911).
6468 0 : (let ((default-directory
6469 0 : (locate-dominating-file dir 'file-directory-p)))
6470 0 : (eq (process-file directory-free-space-program
6471 : nil t nil
6472 0 : directory-free-space-args
6473 0 : (file-relative-name dir))
6474 0 : 0)))
6475 : ;; Assume that the "available" column is before the
6476 : ;; "capacity" column. Find the "%" and scan backward.
6477 0 : (goto-char (point-min))
6478 0 : (forward-line 1)
6479 0 : (when (re-search-forward
6480 : "[[:space:]]+[^[:space:]]+%[^%]*$"
6481 0 : (line-end-position) t)
6482 0 : (goto-char (match-beginning 0))
6483 0 : (let ((endpt (point)))
6484 0 : (skip-chars-backward "^[:space:]")
6485 0 : (buffer-substring-no-properties (point) endpt)))))))))
6486 :
6487 : ;; The following expression replaces `dired-move-to-filename-regexp'.
6488 : (defvar directory-listing-before-filename-regexp
6489 : (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
6490 : (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
6491 : ;; In some locales, month abbreviations are as short as 2 letters,
6492 : ;; and they can be followed by ".".
6493 : ;; In Breton, a month name can include a quote character.
6494 : (month (concat l-or-quote l-or-quote "+\\.?"))
6495 : (s " ")
6496 : (yyyy "[0-9][0-9][0-9][0-9]")
6497 : (dd "[ 0-3][0-9]")
6498 : (HH:MM "[ 0-2][0-9][:.][0-5][0-9]")
6499 : (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
6500 : (zone "[-+][0-2][0-9][0-5][0-9]")
6501 : (iso-mm-dd "[01][0-9]-[0-3][0-9]")
6502 : (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
6503 : (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
6504 : "\\|" yyyy "-" iso-mm-dd "\\)"))
6505 : (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
6506 : s "+"
6507 : "\\(" HH:MM "\\|" yyyy "\\)"))
6508 : (western-comma (concat month s "+" dd "," s "+" yyyy))
6509 : ;; Japanese MS-Windows ls-lisp has one-digit months, and
6510 : ;; omits the Kanji characters after month and day-of-month.
6511 : ;; On Mac OS X 10.3, the date format in East Asian locales is
6512 : ;; day-of-month digits followed by month digits.
6513 : (mm "[ 0-1]?[0-9]")
6514 : (east-asian
6515 : (concat "\\(" mm l "?" s dd l "?" s "+"
6516 : "\\|" dd s mm s "+" "\\)"
6517 : "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
6518 : ;; The "[0-9]" below requires the previous column to end in a digit.
6519 : ;; This avoids recognizing `1 may 1997' as a date in the line:
6520 : ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
6521 :
6522 : ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output.
6523 :
6524 : ;; For non-iso date formats, we add the ".*" in order to find
6525 : ;; the last possible match. This avoids recognizing
6526 : ;; `jservice 10 1024' as a date in the line:
6527 : ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
6528 :
6529 : ;; vc dired listings provide the state or blanks between file
6530 : ;; permissions and date. The state is always surrounded by
6531 : ;; parentheses:
6532 : ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el
6533 : ;; This is not supported yet.
6534 : (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso
6535 : "\\|.*[0-9][BkKMGTPEZY]? "
6536 : "\\(" western "\\|" western-comma "\\|" east-asian "\\)"
6537 : "\\) +")))
6538 : "Regular expression to match up to the file name in a directory listing.
6539 : The default value is designed to recognize dates and times
6540 : regardless of the language.")
6541 :
6542 : (defvar insert-directory-ls-version 'unknown)
6543 :
6544 : (defun insert-directory-wildcard-in-dir-p (dir)
6545 : "Return non-nil if DIR contents a shell wildcard in the directory part.
6546 : The return value is a cons (DIR . WILDCARDS); DIR is the
6547 : `default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
6548 :
6549 : Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
6550 30 : (let ((wildcards "[?*"))
6551 30 : (when (and (or (not (featurep 'ls-lisp))
6552 30 : ls-lisp-support-shell-wildcards)
6553 30 : (string-match (concat "[" wildcards "]") (file-name-directory dir))
6554 30 : (not (file-exists-p dir))) ; Prefer an existing file to wildcards.
6555 20 : (let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)"
6556 20 : wildcards wildcards wildcards)))
6557 20 : (string-match regexp dir)
6558 30 : (cons (match-string 1 dir) (match-string 2 dir))))))
6559 :
6560 : (defun insert-directory-clean (beg switches)
6561 4 : (when (if (stringp switches)
6562 4 : (string-match "--dired\\>" switches)
6563 4 : (member "--dired" switches))
6564 : ;; The following overshoots by one line for an empty
6565 : ;; directory listed with "--dired", but without "-a"
6566 : ;; switch, where the ls output contains a
6567 : ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
6568 : ;; We take care of that case later.
6569 0 : (forward-line -2)
6570 0 : (when (looking-at "//SUBDIRED//")
6571 0 : (delete-region (point) (progn (forward-line 1) (point)))
6572 0 : (forward-line -1))
6573 0 : (if (looking-at "//DIRED//")
6574 0 : (let ((end (line-end-position))
6575 0 : (linebeg (point))
6576 : error-lines)
6577 : ;; Find all the lines that are error messages,
6578 : ;; and record the bounds of each one.
6579 0 : (goto-char beg)
6580 0 : (while (< (point) linebeg)
6581 0 : (or (eql (following-char) ?\s)
6582 0 : (push (list (point) (line-end-position)) error-lines))
6583 0 : (forward-line 1))
6584 0 : (setq error-lines (nreverse error-lines))
6585 : ;; Now read the numeric positions of file names.
6586 0 : (goto-char linebeg)
6587 0 : (forward-word-strictly 1)
6588 0 : (forward-char 3)
6589 0 : (while (< (point) end)
6590 0 : (let ((start (insert-directory-adj-pos
6591 0 : (+ beg (read (current-buffer)))
6592 0 : error-lines))
6593 0 : (end (insert-directory-adj-pos
6594 0 : (+ beg (read (current-buffer)))
6595 0 : error-lines)))
6596 0 : (if (memq (char-after end) '(?\n ?\s))
6597 : ;; End is followed by \n or by " -> ".
6598 0 : (put-text-property start end 'dired-filename t)
6599 : ;; It seems that we can't trust ls's output as to
6600 : ;; byte positions of filenames.
6601 0 : (put-text-property beg (point) 'dired-filename nil)
6602 0 : (end-of-line))))
6603 0 : (goto-char end)
6604 0 : (beginning-of-line)
6605 0 : (delete-region (point) (progn (forward-line 1) (point))))
6606 : ;; Take care of the case where the ls output contains a
6607 : ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
6608 : ;; and we went one line too far back (see above).
6609 0 : (forward-line 1))
6610 0 : (if (looking-at "//DIRED-OPTIONS//")
6611 4 : (delete-region (point) (progn (forward-line 1) (point))))))
6612 :
6613 : ;; insert-directory
6614 : ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
6615 : ;; FULL-DIRECTORY-P is nil.
6616 : ;; The single line of output must display FILE's name as it was
6617 : ;; given, namely, an absolute path name.
6618 : ;; - must insert exactly one line for each file if WILDCARD or
6619 : ;; FULL-DIRECTORY-P is t, plus one optional "total" line
6620 : ;; before the file lines, plus optional text after the file lines.
6621 : ;; Lines are delimited by "\n", so filenames containing "\n" are not
6622 : ;; allowed.
6623 : ;; File lines should display the basename.
6624 : ;; - must be consistent with
6625 : ;; - functions dired-move-to-filename, (these two define what a file line is)
6626 : ;; dired-move-to-end-of-filename,
6627 : ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
6628 : ;; dired-insert-headerline
6629 : ;; dired-after-subdir-garbage (defines what a "total" line is)
6630 : ;; - variable dired-subdir-regexp
6631 : ;; - may be passed "--dired" as the first argument in SWITCHES.
6632 : ;; Filename handlers might have to remove this switch if their
6633 : ;; "ls" command does not support it.
6634 : (defun insert-directory (file switches &optional wildcard full-directory-p)
6635 : "Insert directory listing for FILE, formatted according to SWITCHES.
6636 : Leaves point after the inserted text.
6637 : SWITCHES may be a string of options, or a list of strings
6638 : representing individual options.
6639 : Optional third arg WILDCARD means treat FILE as shell wildcard.
6640 : Optional fourth arg FULL-DIRECTORY-P means file is a directory and
6641 : switches do not contain `d', so that a full listing is expected.
6642 :
6643 : This works by running a directory listing program
6644 : whose name is in the variable `insert-directory-program'.
6645 : If WILDCARD, it also runs the shell specified by `shell-file-name'.
6646 :
6647 : When SWITCHES contains the long `--dired' option, this function
6648 : treats it specially, for the sake of dired. However, the
6649 : normally equivalent short `-D' option is just passed on to
6650 : `insert-directory-program', as any other option."
6651 : ;; We need the directory in order to find the right handler.
6652 10 : (let ((handler (find-file-name-handler (expand-file-name file)
6653 10 : 'insert-directory)))
6654 10 : (if handler
6655 10 : (funcall handler 'insert-directory file switches
6656 10 : wildcard full-directory-p)
6657 0 : (let (result (beg (point)))
6658 :
6659 : ;; Read the actual directory using `insert-directory-program'.
6660 : ;; RESULT gets the status code.
6661 0 : (let* (;; We at first read by no-conversion, then after
6662 : ;; putting text property `dired-filename, decode one
6663 : ;; bunch by one to preserve that property.
6664 : (coding-system-for-read 'no-conversion)
6665 : ;; This is to control encoding the arguments in call-process.
6666 : (coding-system-for-write
6667 0 : (and enable-multibyte-characters
6668 0 : (or file-name-coding-system
6669 0 : default-file-name-coding-system))))
6670 0 : (setq result
6671 0 : (if wildcard
6672 : ;; If the wildcard is just in the file part, then run ls in
6673 : ;; the directory part of the file pattern using the last
6674 : ;; component as argument. Otherwise, run ls in the longest
6675 : ;; subdirectory of the directory part free of wildcards; use
6676 : ;; the remaining of the file pattern as argument.
6677 0 : (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
6678 : (default-directory
6679 0 : (cond (dir-wildcard (car dir-wildcard))
6680 : (t
6681 0 : (if (file-name-absolute-p file)
6682 0 : (file-name-directory file)
6683 0 : (file-name-directory (expand-file-name file))))))
6684 0 : (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
6685 : ;; NB since switches is passed to the shell, be
6686 : ;; careful of malicious values, eg "-l;reboot".
6687 : ;; See eg dired-safe-switches-p.
6688 0 : (call-process
6689 0 : shell-file-name nil t nil
6690 0 : shell-command-switch
6691 0 : (concat (if (memq system-type '(ms-dos windows-nt))
6692 : ""
6693 0 : "\\") ; Disregard Unix shell aliases!
6694 0 : insert-directory-program
6695 : " -d "
6696 0 : (if (stringp switches)
6697 0 : switches
6698 0 : (mapconcat 'identity switches " "))
6699 : " -- "
6700 : ;; Quote some characters that have
6701 : ;; special meanings in shells; but
6702 : ;; don't quote the wildcards--we want
6703 : ;; them to be special. We also
6704 : ;; currently don't quote the quoting
6705 : ;; characters in case people want to
6706 : ;; use them explicitly to quote
6707 : ;; wildcard characters.
6708 0 : (shell-quote-wildcard-pattern pattern))))
6709 : ;; SunOS 4.1.3, SVr4 and others need the "." to list the
6710 : ;; directory if FILE is a symbolic link.
6711 0 : (unless full-directory-p
6712 0 : (setq switches
6713 0 : (cond
6714 0 : ((stringp switches) (concat switches " -d"))
6715 0 : ((member "-d" switches) switches)
6716 0 : (t (append switches '("-d"))))))
6717 0 : (apply 'call-process
6718 0 : insert-directory-program nil t nil
6719 0 : (append
6720 0 : (if (listp switches) switches
6721 0 : (unless (equal switches "")
6722 : ;; Split the switches at any spaces so we can
6723 : ;; pass separate options as separate args.
6724 0 : (split-string-and-unquote switches)))
6725 : ;; Avoid lossage if FILE starts with `-'.
6726 : '("--")
6727 0 : (progn
6728 0 : (if (string-match "\\`~" file)
6729 0 : (setq file (expand-file-name file)))
6730 0 : (list
6731 0 : (if full-directory-p
6732 : ;; (concat (file-name-as-directory file) ".")
6733 0 : file
6734 0 : file))))))))
6735 :
6736 : ;; If we got "//DIRED//" in the output, it means we got a real
6737 : ;; directory listing, even if `ls' returned nonzero.
6738 : ;; So ignore any errors.
6739 0 : (when (if (stringp switches)
6740 0 : (string-match "--dired\\>" switches)
6741 0 : (member "--dired" switches))
6742 0 : (save-excursion
6743 0 : (forward-line -2)
6744 0 : (when (looking-at "//SUBDIRED//")
6745 0 : (forward-line -1))
6746 0 : (if (looking-at "//DIRED//")
6747 0 : (setq result 0))))
6748 :
6749 0 : (when (and (not (eq 0 result))
6750 0 : (eq insert-directory-ls-version 'unknown))
6751 : ;; The first time ls returns an error,
6752 : ;; find the version numbers of ls,
6753 : ;; and set insert-directory-ls-version
6754 : ;; to > if it is more than 5.2.1, < if it is less, nil if it
6755 : ;; is equal or if the info cannot be obtained.
6756 : ;; (That can mean it isn't GNU ls.)
6757 0 : (let ((version-out
6758 0 : (with-temp-buffer
6759 0 : (call-process "ls" nil t nil "--version")
6760 0 : (buffer-string))))
6761 0 : (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
6762 0 : (let* ((version (match-string 1 version-out))
6763 0 : (split (split-string version "[.]"))
6764 0 : (numbers (mapcar 'string-to-number split))
6765 : (min '(5 2 1))
6766 : comparison)
6767 0 : (while (and (not comparison) (or numbers min))
6768 0 : (cond ((null min)
6769 0 : (setq comparison '>))
6770 0 : ((null numbers)
6771 0 : (setq comparison '<))
6772 0 : ((> (car numbers) (car min))
6773 0 : (setq comparison '>))
6774 0 : ((< (car numbers) (car min))
6775 0 : (setq comparison '<))
6776 : (t
6777 0 : (setq numbers (cdr numbers)
6778 0 : min (cdr min)))))
6779 0 : (setq insert-directory-ls-version (or comparison '=)))
6780 0 : (setq insert-directory-ls-version nil))))
6781 :
6782 : ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
6783 0 : (when (and (eq 1 result) (eq insert-directory-ls-version '>))
6784 0 : (setq result 0))
6785 :
6786 : ;; If `insert-directory-program' failed, signal an error.
6787 0 : (unless (eq 0 result)
6788 : ;; Delete the error message it may have output.
6789 0 : (delete-region beg (point))
6790 : ;; On non-Posix systems, we cannot open a directory, so
6791 : ;; don't even try, because that will always result in
6792 : ;; the ubiquitous "Access denied". Instead, show the
6793 : ;; command line so the user can try to guess what went wrong.
6794 0 : (if (and (file-directory-p file)
6795 0 : (memq system-type '(ms-dos windows-nt)))
6796 0 : (error
6797 : "Reading directory: \"%s %s -- %s\" exited with status %s"
6798 0 : insert-directory-program
6799 0 : (if (listp switches) (concat switches) switches)
6800 0 : file result)
6801 : ;; Unix. Access the file to get a suitable error.
6802 0 : (access-file file "Reading directory")
6803 0 : (error "Listing directory failed but `access-file' worked")))
6804 0 : (insert-directory-clean beg switches)
6805 : ;; Now decode what read if necessary.
6806 0 : (let ((coding (or coding-system-for-read
6807 0 : file-name-coding-system
6808 0 : default-file-name-coding-system
6809 0 : 'undecided))
6810 : coding-no-eol
6811 : val pos)
6812 0 : (when (and enable-multibyte-characters
6813 0 : (not (memq (coding-system-base coding)
6814 0 : '(raw-text no-conversion))))
6815 : ;; If no coding system is specified or detection is
6816 : ;; requested, detect the coding.
6817 0 : (if (eq (coding-system-base coding) 'undecided)
6818 0 : (setq coding (detect-coding-region beg (point) t)))
6819 0 : (if (not (eq (coding-system-base coding) 'undecided))
6820 0 : (save-restriction
6821 0 : (setq coding-no-eol
6822 0 : (coding-system-change-eol-conversion coding 'unix))
6823 0 : (narrow-to-region beg (point))
6824 0 : (goto-char (point-min))
6825 0 : (while (not (eobp))
6826 0 : (setq pos (point)
6827 0 : val (get-text-property (point) 'dired-filename))
6828 0 : (goto-char (next-single-property-change
6829 0 : (point) 'dired-filename nil (point-max)))
6830 : ;; Force no eol conversion on a file name, so
6831 : ;; that CR is preserved.
6832 0 : (decode-coding-region pos (point)
6833 0 : (if val coding-no-eol coding))
6834 0 : (if val
6835 0 : (put-text-property pos (point)
6836 0 : 'dired-filename t)))))))
6837 :
6838 0 : (if full-directory-p
6839 : ;; Try to insert the amount of free space.
6840 0 : (save-excursion
6841 0 : (goto-char beg)
6842 : ;; First find the line to put it on.
6843 0 : (when (re-search-forward "^ *\\(total\\)" nil t)
6844 0 : (let ((available (get-free-disk-space ".")))
6845 0 : (when available
6846 : ;; Replace "total" with "used", to avoid confusion.
6847 0 : (replace-match "total used in directory" nil nil nil 1)
6848 0 : (end-of-line)
6849 10 : (insert " available " available))))))))))
6850 :
6851 : (defun insert-directory-adj-pos (pos error-lines)
6852 : "Convert `ls --dired' file name position value POS to a buffer position.
6853 : File name position values returned in ls --dired output
6854 : count only stdout; they don't count the error messages sent to stderr.
6855 : So this function converts to them to real buffer positions.
6856 : ERROR-LINES is a list of buffer positions of error message lines,
6857 : of the form (START END)."
6858 0 : (while (and error-lines (< (caar error-lines) pos))
6859 0 : (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
6860 0 : (pop error-lines))
6861 0 : pos)
6862 :
6863 : (defun insert-directory-safely (file switches
6864 : &optional wildcard full-directory-p)
6865 : "Insert directory listing for FILE, formatted according to SWITCHES.
6866 :
6867 : Like `insert-directory', but if FILE does not exist, it inserts a
6868 : message to that effect instead of signaling an error."
6869 0 : (if (file-exists-p file)
6870 0 : (insert-directory file switches wildcard full-directory-p)
6871 : ;; Simulate the message printed by `ls'.
6872 0 : (insert (format "%s: No such file or directory\n" file))))
6873 :
6874 : (defcustom kill-emacs-query-functions nil
6875 : "Functions to call with no arguments to query about killing Emacs.
6876 : If any of these functions returns nil, killing Emacs is canceled.
6877 : `save-buffers-kill-emacs' calls these functions, but `kill-emacs',
6878 : the low level primitive, does not. See also `kill-emacs-hook'."
6879 : :type 'hook
6880 : :version "26.1"
6881 : :group 'convenience)
6882 :
6883 : (defcustom confirm-kill-emacs nil
6884 : "How to ask for confirmation when leaving Emacs.
6885 : If nil, the default, don't ask at all. If the value is non-nil, it should
6886 : be a predicate function; for example `yes-or-no-p'."
6887 : :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
6888 : (const :tag "Ask with y-or-n-p" y-or-n-p)
6889 : (const :tag "Don't confirm" nil)
6890 : (function :tag "Predicate function"))
6891 : :group 'convenience
6892 : :version "21.1")
6893 :
6894 : (defcustom confirm-kill-processes t
6895 : "Non-nil if Emacs should confirm killing processes on exit.
6896 : If this variable is nil, the value of
6897 : `process-query-on-exit-flag' is ignored. Otherwise, if there are
6898 : processes with a non-nil `process-query-on-exit-flag', Emacs will
6899 : prompt the user before killing them."
6900 : :type 'boolean
6901 : :group 'convenience
6902 : :version "26.1")
6903 :
6904 : (defun save-buffers-kill-emacs (&optional arg)
6905 : "Offer to save each buffer, then kill this Emacs process.
6906 : With prefix ARG, silently save all file-visiting buffers without asking.
6907 : If there are active processes where `process-query-on-exit-flag'
6908 : returns non-nil and `confirm-kill-processes' is non-nil,
6909 : asks whether processes should be killed.
6910 : Runs the members of `kill-emacs-query-functions' in turn and stops
6911 : if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
6912 : (interactive "P")
6913 : ;; Don't use save-some-buffers-default-predicate, because we want
6914 : ;; to ask about all the buffers before killing Emacs.
6915 0 : (save-some-buffers arg t)
6916 0 : (let ((confirm confirm-kill-emacs))
6917 0 : (and
6918 0 : (or (not (memq t (mapcar (function
6919 0 : (lambda (buf) (and (buffer-file-name buf)
6920 0 : (buffer-modified-p buf))))
6921 0 : (buffer-list))))
6922 0 : (progn (setq confirm nil)
6923 0 : (yes-or-no-p "Modified buffers exist; exit anyway? ")))
6924 0 : (or (not (fboundp 'process-list))
6925 : ;; process-list is not defined on MSDOS.
6926 0 : (not confirm-kill-processes)
6927 0 : (let ((processes (process-list))
6928 : active)
6929 0 : (while processes
6930 0 : (and (memq (process-status (car processes)) '(run stop open listen))
6931 0 : (process-query-on-exit-flag (car processes))
6932 0 : (setq active t))
6933 0 : (setq processes (cdr processes)))
6934 0 : (or (not active)
6935 0 : (with-current-buffer-window
6936 0 : (get-buffer-create "*Process List*") nil
6937 0 : #'(lambda (window _value)
6938 0 : (with-selected-window window
6939 0 : (unwind-protect
6940 0 : (progn
6941 0 : (setq confirm nil)
6942 0 : (yes-or-no-p "Active processes exist; kill them and exit anyway? "))
6943 0 : (when (window-live-p window)
6944 0 : (quit-restore-window window 'kill)))))
6945 0 : (list-processes t)))))
6946 : ;; Query the user for other things, perhaps.
6947 0 : (run-hook-with-args-until-failure 'kill-emacs-query-functions)
6948 0 : (or (null confirm)
6949 0 : (funcall confirm "Really exit Emacs? "))
6950 0 : (kill-emacs))))
6951 :
6952 : (defun save-buffers-kill-terminal (&optional arg)
6953 : "Offer to save each buffer, then kill the current connection.
6954 : If the current frame has no client, kill Emacs itself using
6955 : `save-buffers-kill-emacs'.
6956 :
6957 : With prefix ARG, silently save all file-visiting buffers, then kill.
6958 :
6959 : If emacsclient was started with a list of filenames to edit, then
6960 : only these files will be asked to be saved."
6961 : (interactive "P")
6962 0 : (if (frame-parameter nil 'client)
6963 0 : (server-save-buffers-kill-terminal arg)
6964 0 : (save-buffers-kill-emacs arg)))
6965 :
6966 : ;; We use /: as a prefix to "quote" a file name
6967 : ;; so that magic file name handlers will not apply to it.
6968 :
6969 : (setq file-name-handler-alist
6970 : (cons (cons (purecopy "\\`/:") 'file-name-non-special)
6971 : file-name-handler-alist))
6972 :
6973 : ;; We depend on being the last handler on the list,
6974 : ;; so that anything else which does need handling
6975 : ;; has been handled already.
6976 : ;; So it is safe for us to inhibit *all* magic file name handlers.
6977 :
6978 : (defun file-name-non-special (operation &rest arguments)
6979 17111 : (let ((file-name-handler-alist nil)
6980 : (default-directory
6981 : ;; Some operations respect file name handlers in
6982 : ;; `default-directory'. Because core function like
6983 : ;; `call-process' don't care about file name handlers in
6984 : ;; `default-directory', we here have to resolve the
6985 : ;; directory into a local one. For `process-file',
6986 : ;; `start-file-process', and `shell-command', this fixes
6987 : ;; Bug#25949.
6988 17111 : (if (memq operation '(insert-directory process-file start-file-process
6989 17111 : shell-command))
6990 0 : (directory-file-name
6991 0 : (expand-file-name
6992 0 : (unhandled-file-name-directory default-directory)))
6993 17111 : default-directory))
6994 : ;; Get a list of the indices of the args which are file names.
6995 : (file-arg-indices
6996 17111 : (cdr (or (assq operation
6997 : ;; The first six are special because they
6998 : ;; return a file name. We want to include the /:
6999 : ;; in the return value.
7000 : ;; So just avoid stripping it in the first place.
7001 : '((expand-file-name . nil)
7002 : (file-name-directory . nil)
7003 : (file-name-as-directory . nil)
7004 : (directory-file-name . nil)
7005 : (file-name-sans-versions . nil)
7006 : (find-backup-file-name . nil)
7007 : ;; `identity' means just return the first arg
7008 : ;; not stripped of its quoting.
7009 : (substitute-in-file-name identity)
7010 : ;; `add' means add "/:" to the result.
7011 : (file-truename add 0)
7012 : (insert-file-contents insert-file-contents 0)
7013 : ;; `unquote-then-quote' means set buffer-file-name
7014 : ;; temporarily to unquoted filename.
7015 : (verify-visited-file-modtime unquote-then-quote)
7016 : ;; List the arguments which are filenames.
7017 : (file-name-completion 1)
7018 : (file-name-all-completions 1)
7019 : (write-region 2 5)
7020 : (rename-file 0 1)
7021 : (copy-file 0 1)
7022 : (make-symbolic-link 0 1)
7023 17111 : (add-name-to-file 0 1)))
7024 : ;; For all other operations, treat the first argument only
7025 : ;; as the file name.
7026 17111 : '(nil 0))))
7027 : method
7028 : ;; Copy ARGUMENTS so we can replace elements in it.
7029 17111 : (arguments (copy-sequence arguments)))
7030 17111 : (if (symbolp (car file-arg-indices))
7031 17111 : (setq method (pop file-arg-indices)))
7032 : ;; Strip off the /: from the file names that have it.
7033 17111 : (save-match-data
7034 31971 : (while (consp file-arg-indices)
7035 14860 : (let ((pair (nthcdr (car file-arg-indices) arguments)))
7036 14860 : (and (car pair)
7037 14860 : (string-match "\\`/:" (car pair))
7038 14860 : (setcar pair
7039 14860 : (if (= (length (car pair)) 2)
7040 : "/"
7041 14860 : (substring (car pair) 2)))))
7042 17111 : (setq file-arg-indices (cdr file-arg-indices))))
7043 17111 : (pcase method
7044 0 : (`identity (car arguments))
7045 0 : (`add (concat "/:" (apply operation arguments)))
7046 : (`insert-file-contents
7047 0 : (let ((visit (nth 1 arguments)))
7048 0 : (unwind-protect
7049 0 : (apply operation arguments)
7050 0 : (when (and visit buffer-file-name)
7051 0 : (setq buffer-file-name (concat "/:" buffer-file-name))))))
7052 : (`unquote-then-quote
7053 : ;; We can't use `cl-letf' with `(buffer-local-value)' here
7054 : ;; because it wouldn't work during bootstrapping.
7055 0 : (let ((buffer (current-buffer)))
7056 : ;; `unquote-then-quote' is only used for the
7057 : ;; `verify-visited-file-modtime' action, which takes a buffer
7058 : ;; as only optional argument.
7059 0 : (with-current-buffer (or (car arguments) buffer)
7060 0 : (let ((buffer-file-name (substring buffer-file-name 2)))
7061 : ;; Make sure to hide the temporary buffer change from the
7062 : ;; underlying operation.
7063 0 : (with-current-buffer buffer
7064 0 : (apply operation arguments))))))
7065 : (_
7066 17111 : (apply operation arguments)))))
7067 :
7068 : (defsubst file-name-quoted-p (name)
7069 : "Whether NAME is quoted with prefix \"/:\".
7070 : If NAME is a remote file name, check the local part of NAME."
7071 92484 : (string-prefix-p "/:" (file-local-name name)))
7072 :
7073 : (defsubst file-name-quote (name)
7074 : "Add the quotation prefix \"/:\" to file NAME.
7075 : If NAME is a remote file name, the local part of NAME is quoted.
7076 : If NAME is already a quoted file name, NAME is returned unchanged."
7077 1742 : (if (file-name-quoted-p name)
7078 0 : name
7079 1742 : (concat (file-remote-p name) "/:" (file-local-name name))))
7080 :
7081 : (defsubst file-name-unquote (name)
7082 : "Remove quotation prefix \"/:\" from file NAME, if any.
7083 : If NAME is a remote file name, the local part of NAME is unquoted."
7084 65715 : (let ((localname (file-local-name name)))
7085 65715 : (when (file-name-quoted-p localname)
7086 4328 : (setq
7087 65715 : localname (if (= (length localname) 2) "/" (substring localname 2))))
7088 65715 : (concat (file-remote-p name) localname)))
7089 :
7090 : ;; Symbolic modes and read-file-modes.
7091 :
7092 : (defun file-modes-char-to-who (char)
7093 : "Convert CHAR to a numeric bit-mask for extracting mode bits.
7094 : CHAR is in [ugoa] and represents the category of users (Owner, Group,
7095 : Others, or All) for whom to produce the mask.
7096 : The bit-mask that is returned extracts from mode bits the access rights
7097 : for the specified category of users."
7098 0 : (cond ((= char ?u) #o4700)
7099 0 : ((= char ?g) #o2070)
7100 0 : ((= char ?o) #o1007)
7101 0 : ((= char ?a) #o7777)
7102 0 : (t (error "%c: bad `who' character" char))))
7103 :
7104 : (defun file-modes-char-to-right (char &optional from)
7105 : "Convert CHAR to a numeric value of mode bits.
7106 : CHAR is in [rwxXstugo] and represents symbolic access permissions.
7107 : If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
7108 0 : (or from (setq from 0))
7109 0 : (cond ((= char ?r) #o0444)
7110 0 : ((= char ?w) #o0222)
7111 0 : ((= char ?x) #o0111)
7112 0 : ((= char ?s) #o6000)
7113 0 : ((= char ?t) #o1000)
7114 : ;; Rights relative to the previous file modes.
7115 0 : ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
7116 0 : ((= char ?u) (let ((uright (logand #o4700 from)))
7117 0 : (+ uright (/ uright #o10) (/ uright #o100))))
7118 0 : ((= char ?g) (let ((gright (logand #o2070 from)))
7119 0 : (+ gright (/ gright #o10) (* gright #o10))))
7120 0 : ((= char ?o) (let ((oright (logand #o1007 from)))
7121 0 : (+ oright (* oright #o10) (* oright #o100))))
7122 0 : (t (error "%c: bad right character" char))))
7123 :
7124 : (defun file-modes-rights-to-number (rights who-mask &optional from)
7125 : "Convert a symbolic mode string specification to an equivalent number.
7126 : RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]*)+\".
7127 : WHO-MASK is the bit-mask specifying the category of users to which to
7128 : apply the access permissions. See `file-modes-char-to-who'.
7129 : FROM (or 0 if nil) gives the mode bits on which to base permissions if
7130 : RIGHTS request to add, remove, or set permissions based on existing ones,
7131 : as in \"og+rX-w\"."
7132 0 : (let* ((num-rights (or from 0))
7133 0 : (list-rights (string-to-list rights))
7134 0 : (op (pop list-rights)))
7135 0 : (while (memq op '(?+ ?- ?=))
7136 0 : (let ((num-right 0)
7137 : char-right)
7138 0 : (while (memq (setq char-right (pop list-rights))
7139 0 : '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
7140 0 : (setq num-right
7141 0 : (logior num-right
7142 0 : (file-modes-char-to-right char-right num-rights))))
7143 0 : (setq num-right (logand who-mask num-right)
7144 : num-rights
7145 0 : (cond ((= op ?+) (logior num-rights num-right))
7146 0 : ((= op ?-) (logand num-rights (lognot num-right)))
7147 0 : (t (logior (logand num-rights (lognot who-mask)) num-right)))
7148 0 : op char-right)))
7149 0 : num-rights))
7150 :
7151 : (defun file-modes-symbolic-to-number (modes &optional from)
7152 : "Convert symbolic file modes to numeric file modes.
7153 : MODES is the string to convert, it should match
7154 : \"[ugoa]*([+-=][rwxXstugo]*)+,...\".
7155 : See Info node `(coreutils)File permissions' for more information on this
7156 : notation.
7157 : FROM (or 0 if nil) gives the mode bits on which to base permissions if
7158 : MODES request to add, remove, or set permissions based on existing ones,
7159 : as in \"og+rX-w\"."
7160 0 : (save-match-data
7161 0 : (let ((case-fold-search nil)
7162 0 : (num-modes (or from 0)))
7163 0 : (while (/= (string-to-char modes) 0)
7164 0 : (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]*\\)+\\(,\\|\\)" modes)
7165 0 : (let ((num-who (apply 'logior 0
7166 0 : (mapcar 'file-modes-char-to-who
7167 0 : (match-string 1 modes)))))
7168 0 : (when (= num-who 0)
7169 0 : (setq num-who (logior #o7000 (default-file-modes))))
7170 0 : (setq num-modes
7171 0 : (file-modes-rights-to-number (substring modes (match-end 1))
7172 0 : num-who num-modes)
7173 0 : modes (substring modes (match-end 3))))
7174 0 : (error "Parse error in modes near `%s'" (substring modes 0))))
7175 0 : num-modes)))
7176 :
7177 : (defun read-file-modes (&optional prompt orig-file)
7178 : "Read file modes in octal or symbolic notation and return its numeric value.
7179 : PROMPT is used as the prompt, default to \"File modes (octal or symbolic): \".
7180 : ORIG-FILE is the name of a file on whose mode bits to base returned
7181 : permissions if what user types requests to add, remove, or set permissions
7182 : based on existing mode bits, as in \"og+rX-w\"."
7183 0 : (let* ((modes (or (if orig-file (file-modes orig-file) 0)
7184 0 : (error "File not found")))
7185 0 : (modestr (and (stringp orig-file)
7186 0 : (nth 8 (file-attributes orig-file))))
7187 : (default
7188 0 : (and (stringp modestr)
7189 0 : (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
7190 0 : (replace-regexp-in-string
7191 : "-" ""
7192 0 : (format "u=%s,g=%s,o=%s"
7193 0 : (match-string 1 modestr)
7194 0 : (match-string 2 modestr)
7195 0 : (match-string 3 modestr)))))
7196 0 : (value (read-string (or prompt "File modes (octal or symbolic): ")
7197 0 : nil nil default)))
7198 0 : (save-match-data
7199 0 : (if (string-match "^[0-7]+" value)
7200 0 : (string-to-number value 8)
7201 0 : (file-modes-symbolic-to-number value modes)))))
7202 :
7203 : (define-obsolete-variable-alias 'cache-long-line-scans
7204 : 'cache-long-scans "24.4")
7205 :
7206 : ;; Trashcan handling.
7207 : (defcustom trash-directory nil
7208 : "Directory for `move-file-to-trash' to move files and directories to.
7209 : This directory is only used when the function `system-move-file-to-trash'
7210 : is not defined.
7211 : Relative paths are interpreted relative to `default-directory'.
7212 : If the value is nil, Emacs uses a freedesktop.org-style trashcan."
7213 : :type '(choice (const nil) directory)
7214 : :group 'auto-save
7215 : :version "23.2")
7216 :
7217 : (defvar trash--hexify-table)
7218 :
7219 : (declare-function system-move-file-to-trash "w32fns.c" (filename))
7220 :
7221 : (defun move-file-to-trash (filename)
7222 : "Move the file (or directory) named FILENAME to the trash.
7223 : When `delete-by-moving-to-trash' is non-nil, this function is
7224 : called by `delete-file' and `delete-directory' instead of
7225 : deleting files outright.
7226 :
7227 : If the function `system-move-file-to-trash' is defined, call it
7228 : with FILENAME as an argument.
7229 : Otherwise, if `trash-directory' is non-nil, move FILENAME to that
7230 : directory.
7231 : Otherwise, trash FILENAME using the freedesktop.org conventions,
7232 : like the GNOME, KDE and XFCE desktop environments. Emacs only
7233 : moves files to \"home trash\", ignoring per-volume trashcans."
7234 : (interactive "fMove file to trash: ")
7235 0 : (cond (trash-directory
7236 : ;; If `trash-directory' is non-nil, move the file there.
7237 0 : (let* ((trash-dir (expand-file-name trash-directory))
7238 0 : (fn (directory-file-name (expand-file-name filename)))
7239 0 : (new-fn (expand-file-name (file-name-nondirectory fn)
7240 0 : trash-dir)))
7241 : ;; We can't trash a parent directory of trash-directory.
7242 0 : (if (string-prefix-p fn trash-dir)
7243 0 : (error "Trash directory `%s' is a subdirectory of `%s'"
7244 0 : trash-dir filename))
7245 0 : (unless (file-directory-p trash-dir)
7246 0 : (make-directory trash-dir t))
7247 : ;; Ensure that the trashed file-name is unique.
7248 0 : (if (file-exists-p new-fn)
7249 0 : (let ((version-control t)
7250 : (backup-directory-alist nil))
7251 0 : (setq new-fn (car (find-backup-file-name new-fn)))))
7252 0 : (let (delete-by-moving-to-trash)
7253 0 : (rename-file fn new-fn))))
7254 : ;; If `system-move-file-to-trash' is defined, use it.
7255 0 : ((fboundp 'system-move-file-to-trash)
7256 0 : (system-move-file-to-trash filename))
7257 : ;; Otherwise, use the freedesktop.org method, as specified at
7258 : ;; http://freedesktop.org/wiki/Specifications/trash-spec
7259 : (t
7260 0 : (let* ((xdg-data-dir
7261 0 : (directory-file-name
7262 0 : (expand-file-name "Trash"
7263 0 : (or (getenv "XDG_DATA_HOME")
7264 0 : "~/.local/share"))))
7265 0 : (trash-files-dir (expand-file-name "files" xdg-data-dir))
7266 0 : (trash-info-dir (expand-file-name "info" xdg-data-dir))
7267 0 : (fn (directory-file-name (expand-file-name filename))))
7268 :
7269 : ;; Check if we have permissions to delete.
7270 0 : (unless (file-writable-p (directory-file-name
7271 0 : (file-name-directory fn)))
7272 0 : (error "Cannot move %s to trash: Permission denied" filename))
7273 : ;; The trashed file cannot be the trash dir or its parent.
7274 0 : (if (string-prefix-p fn trash-files-dir)
7275 0 : (error "The trash directory %s is a subdirectory of %s"
7276 0 : trash-files-dir filename))
7277 0 : (if (string-prefix-p fn trash-info-dir)
7278 0 : (error "The trash directory %s is a subdirectory of %s"
7279 0 : trash-info-dir filename))
7280 :
7281 : ;; Ensure that the trash directory exists; otherwise, create it.
7282 0 : (with-file-modes #o700
7283 0 : (unless (file-exists-p trash-files-dir)
7284 0 : (make-directory trash-files-dir t))
7285 0 : (unless (file-exists-p trash-info-dir)
7286 0 : (make-directory trash-info-dir t)))
7287 :
7288 : ;; Try to move to trash with .trashinfo undo information
7289 0 : (save-excursion
7290 0 : (with-temp-buffer
7291 0 : (set-buffer-file-coding-system 'utf-8-unix)
7292 0 : (insert "[Trash Info]\nPath=")
7293 : ;; Perform url-encoding on FN. For compatibility with
7294 : ;; other programs (e.g. XFCE Thunar), allow literal "/"
7295 : ;; for path separators.
7296 0 : (unless (boundp 'trash--hexify-table)
7297 0 : (setq trash--hexify-table (make-vector 256 nil))
7298 0 : (let ((unreserved-chars
7299 0 : (list ?/ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
7300 : ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A
7301 : ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O
7302 : ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2
7303 : ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?_ ?. ?! ?~ ?* ?'
7304 0 : ?\( ?\))))
7305 0 : (dotimes (byte 256)
7306 0 : (aset trash--hexify-table byte
7307 0 : (if (memq byte unreserved-chars)
7308 0 : (char-to-string byte)
7309 0 : (format "%%%02x" byte))))))
7310 0 : (mapc (lambda (byte)
7311 0 : (insert (aref trash--hexify-table byte)))
7312 0 : (if (multibyte-string-p fn)
7313 0 : (encode-coding-string fn 'utf-8)
7314 0 : fn))
7315 0 : (insert "\nDeletionDate="
7316 0 : (format-time-string "%Y-%m-%dT%T")
7317 0 : "\n")
7318 :
7319 : ;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0.
7320 0 : (let* ((files-base (file-name-nondirectory fn))
7321 0 : (info-fn (expand-file-name
7322 0 : (concat files-base ".trashinfo")
7323 0 : trash-info-dir)))
7324 0 : (condition-case nil
7325 0 : (write-region nil nil info-fn nil 'quiet info-fn 'excl)
7326 : (file-already-exists
7327 : ;; Uniquify new-fn. Some file managers do not
7328 : ;; like Emacs-style backup file names. E.g.:
7329 : ;; https://bugs.kde.org/170956
7330 0 : (setq info-fn (make-temp-file
7331 0 : (expand-file-name files-base trash-info-dir)
7332 0 : nil ".trashinfo"))
7333 0 : (setq files-base (file-name-nondirectory info-fn))
7334 0 : (write-region nil nil info-fn nil 'quiet info-fn)))
7335 : ;; Finally, try to move the file to the trashcan.
7336 0 : (let ((delete-by-moving-to-trash nil)
7337 0 : (new-fn (expand-file-name files-base trash-files-dir)))
7338 0 : (rename-file fn new-fn)))))))))
7339 :
7340 : (defsubst file-attribute-type (attributes)
7341 : "The type field in ATTRIBUTES returned by `file-attributes'.
7342 : The value is either t for directory, string (name linked to) for
7343 : symbolic link, or nil."
7344 1402 : (nth 0 attributes))
7345 :
7346 : (defsubst file-attribute-link-number (attributes)
7347 : "Return the number of links in ATTRIBUTES returned by `file-attributes'."
7348 0 : (nth 1 attributes))
7349 :
7350 : (defsubst file-attribute-user-id (attributes)
7351 : "The UID field in ATTRIBUTES returned by `file-attributes'.
7352 : This is either a string or a number. If a string value cannot be
7353 : looked up, a numeric value, either an integer or a float, is
7354 : returned."
7355 786 : (nth 2 attributes))
7356 :
7357 : (defsubst file-attribute-group-id (attributes)
7358 : "The GID field in ATTRIBUTES returned by `file-attributes'.
7359 : This is either a string or a number. If a string value cannot be
7360 : looked up, a numeric value, either an integer or a float, is
7361 : returned."
7362 411 : (nth 3 attributes))
7363 :
7364 : (defsubst file-attribute-access-time (attributes)
7365 : "The last access time in ATTRIBUTES returned by `file-attributes'.
7366 : This a list of integers (HIGH LOW USEC PSEC) in the same style
7367 : as (current-time)."
7368 0 : (nth 4 attributes))
7369 :
7370 : (defsubst file-attribute-modification-time (attributes)
7371 : "The modification time in ATTRIBUTES returned by `file-attributes'.
7372 : This is the time of the last change to the file's contents, and
7373 : is a list of integers (HIGH LOW USEC PSEC) in the same style
7374 : as (current-time)."
7375 28 : (nth 5 attributes))
7376 :
7377 : (defsubst file-attribute-status-change-time (attributes)
7378 : "The status modification time in ATTRIBUTES returned by `file-attributes'.
7379 : This is the time of last change to the file's attributes: owner
7380 : and group, access mode bits, etc, and is a list of integers (HIGH
7381 : LOW USEC PSEC) in the same style as (current-time)."
7382 0 : (nth 6 attributes))
7383 :
7384 : (defsubst file-attribute-size (attributes)
7385 : "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
7386 : This is a floating point number if the size is too large for an integer."
7387 1031 : (nth 7 attributes))
7388 :
7389 : (defsubst file-attribute-modes (attributes)
7390 : "The file modes in ATTRIBUTES returned by `file-attributes'.
7391 : This is a string of ten letters or dashes as in ls -l."
7392 1137 : (nth 8 attributes))
7393 :
7394 : (defsubst file-attribute-inode-number (attributes)
7395 : "The inode number in ATTRIBUTES returned by `file-attributes'.
7396 : If it is larger than what an Emacs integer can hold, this is of
7397 : the form (HIGH . LOW): first the high bits, then the low 16 bits.
7398 : If even HIGH is too large for an Emacs integer, this is instead
7399 : of the form (HIGH MIDDLE . LOW): first the high bits, then the
7400 : middle 24 bits, and finally the low 16 bits."
7401 0 : (nth 10 attributes))
7402 :
7403 : (defsubst file-attribute-device-number (attributes)
7404 : "The file system device number in ATTRIBUTES returned by `file-attributes'.
7405 : If it is larger than what an Emacs integer can hold, this is of
7406 : the form (HIGH . LOW): first the high bits, then the low 16 bits.
7407 : If even HIGH is too large for an Emacs integer, this is instead
7408 : of the form (HIGH MIDDLE . LOW): first the high bits, then the
7409 : middle 24 bits, and finally the low 16 bits."
7410 0 : (nth 11 attributes))
7411 :
7412 : (defun file-attribute-collect (attributes &rest attr-names)
7413 : "Return a sublist of ATTRIBUTES returned by `file-attributes'.
7414 : ATTR-NAMES are symbols with the selected attribute names.
7415 :
7416 : Valid attribute names are: type, link-number, user-id, group-id,
7417 : access-time, modification-time, status-change-time, size, modes,
7418 : inode-number and device-number."
7419 0 : (let ((all '(type link-number user-id group-id access-time
7420 : modification-time status-change-time
7421 : size modes inode-number device-number))
7422 : result)
7423 0 : (while attr-names
7424 0 : (let ((attr (pop attr-names)))
7425 0 : (if (memq attr all)
7426 0 : (push (funcall
7427 0 : (intern (format "file-attribute-%s" (symbol-name attr)))
7428 0 : attributes)
7429 0 : result)
7430 0 : (error "Wrong attribute name '%S'" attr))))
7431 0 : (nreverse result)))
7432 :
7433 : (define-key ctl-x-map "\C-f" 'find-file)
7434 : (define-key ctl-x-map "\C-r" 'find-file-read-only)
7435 : (define-key ctl-x-map "\C-v" 'find-alternate-file)
7436 : (define-key ctl-x-map "\C-s" 'save-buffer)
7437 : (define-key ctl-x-map "s" 'save-some-buffers)
7438 : (define-key ctl-x-map "\C-w" 'write-file)
7439 : (define-key ctl-x-map "i" 'insert-file)
7440 : (define-key esc-map "~" 'not-modified)
7441 : (define-key ctl-x-map "\C-d" 'list-directory)
7442 : (define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
7443 : (define-key ctl-x-map "\C-q" 'read-only-mode)
7444 :
7445 : (define-key ctl-x-4-map "f" 'find-file-other-window)
7446 : (define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
7447 : (define-key ctl-x-4-map "\C-f" 'find-file-other-window)
7448 : (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
7449 : (define-key ctl-x-4-map "\C-o" 'display-buffer)
7450 :
7451 : (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
7452 : (define-key ctl-x-5-map "f" 'find-file-other-frame)
7453 : (define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
7454 : (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
7455 : (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame)
7456 :
7457 : ;;; files.el ends here
|