comparison lisp/files.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 54768b86165d
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; files.el --- file input and output commands for Emacs 1 ;;; files.el --- file input and output commands for Emacs
2 2
3 ;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
4 ;;; Free Software Foundation, Inc. 4 ;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
9 9
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 18 ;; GNU General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02110-1301, USA.
24 24
25 ;;; Commentary: 25 ;;; Commentary:
26 26
27 ;; Defines most of Emacs's file- and directory-handling functions, 27 ;; Defines most of Emacs's file- and directory-handling functions,
28 ;; including basic file visiting, backup generation, link handling, 28 ;; including basic file visiting, backup generation, link handling,
29 ;; ITS-id version control, load- and write-hook handling, and the like. 29 ;; ITS-id version control, load- and write-hook handling, and the like.
30 30
31 ;;; Code: 31 ;;; Code:
32 32
33 (defvar font-lock-keywords)
34
35
33 (defgroup backup nil 36 (defgroup backup nil
34 "Backups of edited data files." 37 "Backups of edited data files."
35 :group 'files) 38 :group 'files)
36 39
37 (defgroup find-file nil 40 (defgroup find-file nil
40 43
41 44
42 (defcustom delete-auto-save-files t 45 (defcustom delete-auto-save-files t
43 "*Non-nil means delete auto-save file when a buffer is saved or killed. 46 "*Non-nil means delete auto-save file when a buffer is saved or killed.
44 47
45 Note that auto-save file will not be deleted if the buffer is killed 48 Note that the auto-save file will not be deleted if the buffer is killed
46 when it has unsaved changes." 49 when it has unsaved changes."
47 :type 'boolean 50 :type 'boolean
48 :group 'auto-save) 51 :group 'auto-save)
49 52
50 (defcustom directory-abbrev-alist 53 (defcustom directory-abbrev-alist
157 The truename of a file is found by chasing all links 160 The truename of a file is found by chasing all links
158 both at the file level and at the levels of the containing directories." 161 both at the file level and at the levels of the containing directories."
159 :type 'boolean 162 :type 'boolean
160 :group 'find-file) 163 :group 'find-file)
161 164
162 (defcustom revert-without-query 165 (defcustom revert-without-query nil
163 nil
164 "*Specify which files should be reverted without query. 166 "*Specify which files should be reverted without query.
165 The value is a list of regular expressions. 167 The value is a list of regular expressions.
166 If the file name matches one of these regular expressions, 168 If the file name matches one of these regular expressions,
167 then `revert-buffer' reverts the file without querying 169 then `revert-buffer' reverts the file without querying
168 if the file has changed on disk and you have not edited the buffer." 170 if the file has changed on disk and you have not edited the buffer."
176 If the buffer is visiting a new file, the value is nil.") 178 If the buffer is visiting a new file, the value is nil.")
177 (make-variable-buffer-local 'buffer-file-number) 179 (make-variable-buffer-local 'buffer-file-number)
178 (put 'buffer-file-number 'permanent-local t) 180 (put 'buffer-file-number 'permanent-local t)
179 181
180 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) 182 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
181 "Non-nil means that buffer-file-number uniquely identifies files.") 183 "Non-nil means that `buffer-file-number' uniquely identifies files.")
182 184
183 (defvar buffer-file-read-only nil 185 (defvar buffer-file-read-only nil
184 "Non-nil if visited file was read-only when visited.") 186 "Non-nil if visited file was read-only when visited.")
185 (make-variable-buffer-local 'buffer-file-read-only) 187 (make-variable-buffer-local 'buffer-file-read-only)
186 188
271 Includes the new backup. Must be > 0" 273 Includes the new backup. Must be > 0"
272 :type 'integer 274 :type 'integer
273 :group 'backup) 275 :group 'backup)
274 276
275 (defcustom require-final-newline nil 277 (defcustom require-final-newline nil
276 "*Value of t says silently ensure a file ends in a newline when it is saved. 278 "*Whether to add a newline automatically at the end of the file.
277 Non-nil but not t says ask user whether to add a newline when there isn't one. 279
278 nil means don't add newlines." 280 A value of t means do this only when the file is about to be saved.
279 :type '(choice (const :tag "Off" nil) 281 A value of `visit' means do this right after the file is visited.
280 (const :tag "Add" t) 282 A value of `visit-save' means do it at both of those times.
281 (other :tag "Ask" ask)) 283 Any other non-nil value means ask user whether to add a newline, when saving.
284 nil means don't add newlines.
285
286 Certain major modes set this locally to the value obtained
287 from `mode-require-final-newline'."
288 :type '(choice (const :tag "When visiting" visit)
289 (const :tag "When saving" t)
290 (const :tag "When visiting or saving" visit-save)
291 (const :tag "Don't add newlines" nil)
292 (other :tag "Ask each time" ask))
282 :group 'editing-basics) 293 :group 'editing-basics)
294
295 (defcustom mode-require-final-newline t
296 "*Whether to add a newline at end of file, in certain major modes.
297 Those modes set `require-final-newline' to this value when you enable them.
298 They do so because they are often used for files that are supposed
299 to end in newlines, and the question is how to arrange that.
300
301 A value of t means do this only when the file is about to be saved.
302 A value of `visit' means do this right after the file is visited.
303 A value of `visit-save' means do it at both of those times.
304 Any other non-nil value means ask user whether to add a newline, when saving.
305
306 nil means do not add newlines. That is a risky choice in this variable
307 since this value is used for modes for files that ought to have final newlines.
308 So if you set this to nil, you must explicitly check and add
309 a final newline, whenever you save a file that really needs one."
310 :type '(choice (const :tag "When visiting" visit)
311 (const :tag "When saving" t)
312 (const :tag "When visiting or saving" visit-save)
313 (const :tag "Don't add newlines" nil)
314 (other :tag "Ask each time" ask))
315 :group 'editing-basics
316 :version "22.1")
283 317
284 (defcustom auto-save-default t 318 (defcustom auto-save-default t
285 "*Non-nil says by default do auto-saving of every file-visiting buffer." 319 "*Non-nil says by default do auto-saving of every file-visiting buffer."
286 :type 'boolean 320 :type 'boolean
287 :group 'auto-save) 321 :group 'auto-save)
291 Normally auto-save files are written under other names." 325 Normally auto-save files are written under other names."
292 :type 'boolean 326 :type 'boolean
293 :group 'auto-save) 327 :group 'auto-save)
294 328
295 (defcustom auto-save-file-name-transforms 329 (defcustom auto-save-file-name-transforms
296 `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" 330 `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
297 ;; Don't put "\\2" inside expand-file-name, since it will be 331 ;; Don't put "\\2" inside expand-file-name, since it will be
298 ;; transformed to "/2" on DOS/Windows. 332 ;; transformed to "/2" on DOS/Windows.
299 ,(concat temporary-file-directory "\\2") t)) 333 ,(concat temporary-file-directory "\\2") t))
300 "*Transforms to apply to buffer file name before making auto-save file name. 334 "*Transforms to apply to buffer file name before making auto-save file name.
301 Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): 335 Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
347 (defvar find-file-not-found-functions nil 381 (defvar find-file-not-found-functions nil
348 "List of functions to be called for `find-file' on nonexistent file. 382 "List of functions to be called for `find-file' on nonexistent file.
349 These functions are called as soon as the error is detected. 383 These functions are called as soon as the error is detected.
350 Variable `buffer-file-name' is already set up. 384 Variable `buffer-file-name' is already set up.
351 The functions are called in the order given until one of them returns non-nil.") 385 The functions are called in the order given until one of them returns non-nil.")
352 (defvaralias 'find-file-not-found-hooks 'find-file-not-found-functions) 386 (define-obsolete-variable-alias 'find-file-not-found-hooks
353 (make-obsolete-variable 387 'find-file-not-found-functions "22.1")
354 'find-file-not-found-hooks 'find-file-not-found-functions "21.4")
355 388
356 ;;;It is not useful to make this a local variable. 389 ;;;It is not useful to make this a local variable.
357 ;;;(put 'find-file-hooks 'permanent-local t) 390 ;;;(put 'find-file-hooks 'permanent-local t)
358 (defvar find-file-hook nil 391 (defcustom find-file-hook nil
359 "List of functions to be called after a buffer is loaded from a file. 392 "List of functions to be called after a buffer is loaded from a file.
360 The buffer's local variables (if any) will have been processed before the 393 The buffer's local variables (if any) will have been processed before the
361 functions are called.") 394 functions are called."
362 (defvaralias 'find-file-hooks 'find-file-hook) 395 :group 'find-file
363 (make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4") 396 :type 'hook
397 :options '(auto-insert)
398 :version "22.1")
399 (define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
364 400
365 (defvar write-file-functions nil 401 (defvar write-file-functions nil
366 "List of functions to be called before writing out a buffer to a file. 402 "List of functions to be called before writing out a buffer to a file.
367 If one of them returns non-nil, the file is considered already written 403 If one of them returns non-nil, the file is considered already written
368 and the rest are not called. 404 and the rest are not called.
369 These hooks are considered to pertain to the visited file. 405 These hooks are considered to pertain to the visited file.
370 So any buffer-local binding of this variable is discarded if you change 406 So any buffer-local binding of this variable is discarded if you change
371 the visited file name with \\[set-visited-file-name], but not when you 407 the visited file name with \\[set-visited-file-name], but not when you
372 change the major mode. 408 change the major mode.
373 409
374 See also `write-contents-functions'.") 410 This hook is not run if any of the functions in
411 `write-contents-functions' returns non-nil. Both hooks pertain
412 to how to save a buffer to file, for instance, choosing a suitable
413 coding system and setting mode bits. (See Info
414 node `(elisp)Saving Buffers'.) To perform various checks or
415 updates before the buffer is saved, use `before-save-hook'.")
375 (put 'write-file-functions 'permanent-local t) 416 (put 'write-file-functions 'permanent-local t)
376 (defvaralias 'write-file-hooks 'write-file-functions) 417 (define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
377 (make-obsolete-variable 'write-file-hooks 'write-file-functions "21.4")
378 418
379 (defvar local-write-file-hooks nil) 419 (defvar local-write-file-hooks nil)
380 (make-variable-buffer-local 'local-write-file-hooks) 420 (make-variable-buffer-local 'local-write-file-hooks)
381 (put 'local-write-file-hooks 'permanent-local t) 421 (put 'local-write-file-hooks 'permanent-local t)
382 (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "21.4") 422 (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
383 423
384 (defvar write-contents-functions nil 424 (defvar write-contents-functions nil
385 "List of functions to be called before writing out a buffer to a file. 425 "List of functions to be called before writing out a buffer to a file.
386 If one of them returns non-nil, the file is considered already written 426 If one of them returns non-nil, the file is considered already written
387 and the rest are not called. 427 and the rest are not called and neither are the functions in
428 `write-file-functions'.
388 429
389 This variable is meant to be used for hooks that pertain to the 430 This variable is meant to be used for hooks that pertain to the
390 buffer's contents, not to the particular visited file; thus, 431 buffer's contents, not to the particular visited file; thus,
391 `set-visited-file-name' does not clear this variable; but changing the 432 `set-visited-file-name' does not clear this variable; but changing the
392 major mode does clear it. 433 major mode does clear it.
393 434
394 See also `write-file-functions'.") 435 For hooks that _do_ pertain to the particular visited file, use
436 `write-file-functions'. Both this variable and
437 `write-file-functions' relate to how a buffer is saved to file.
438 To perform various checks or updates before the buffer is saved,
439 use `before-save-hook'.")
395 (make-variable-buffer-local 'write-contents-functions) 440 (make-variable-buffer-local 'write-contents-functions)
396 (defvaralias 'write-contents-hooks 'write-contents-functions) 441 (define-obsolete-variable-alias 'write-contents-hooks
397 (make-obsolete-variable 'write-contents-hooks 'write-contents-functions "21.4") 442 'write-contents-functions "22.1")
398 443
399 (defcustom enable-local-variables t 444 (defcustom enable-local-variables t
400 "*Control use of local variables in files you visit. 445 "*Control use of local variables in files you visit.
401 The value can be t, nil or something else. 446 The value can be t, nil or something else.
402 A value of t means file local variables specifications are obeyed; 447 A value of t means file local variables specifications are obeyed;
423 468
424 (defcustom enable-local-eval 'maybe 469 (defcustom enable-local-eval 'maybe
425 "*Control processing of the \"variable\" `eval' in a file's local variables. 470 "*Control processing of the \"variable\" `eval' in a file's local variables.
426 The value can be t, nil or something else. 471 The value can be t, nil or something else.
427 A value of t means obey `eval' variables; 472 A value of t means obey `eval' variables;
428 nil means ignore them; anything else means query. 473 nil means ignore them; anything else means query."
429
430 The command \\[normal-mode] always obeys local-variables lists
431 and ignores this variable."
432 :type '(choice (const :tag "Obey" t) 474 :type '(choice (const :tag "Obey" t)
433 (const :tag "Ignore" nil) 475 (const :tag "Ignore" nil)
434 (other :tag "Query" other)) 476 (other :tag "Query" other))
435 :group 'find-file) 477 :group 'find-file)
436 478
440 (or (fboundp 'unlock-buffer) 482 (or (fboundp 'unlock-buffer)
441 (defalias 'unlock-buffer 'ignore)) 483 (defalias 'unlock-buffer 'ignore))
442 (or (fboundp 'file-locked-p) 484 (or (fboundp 'file-locked-p)
443 (defalias 'file-locked-p 'ignore)) 485 (defalias 'file-locked-p 'ignore))
444 486
445 (defvar view-read-only nil 487 (defcustom view-read-only nil
446 "*Non-nil means buffers visiting files read-only, do it in view mode.") 488 "*Non-nil means buffers visiting files read-only do so in view mode.
489 In fact, this means that all read-only buffers normally have
490 View mode enabled, including buffers that are read-only because
491 you visit a file you cannot alter, and buffers you make read-only
492 using \\[toggle-read-only]."
493 :type 'boolean
494 :group 'view)
447 495
448 (put 'ange-ftp-completion-hook-function 'safe-magic t) 496 (put 'ange-ftp-completion-hook-function 'safe-magic t)
449 (defun ange-ftp-completion-hook-function (op &rest args) 497 (defun ange-ftp-completion-hook-function (op &rest args)
450 "Provides support for ange-ftp host name completion. 498 "Provides support for ange-ftp host name completion.
451 Runs the usual ange-ftp hook, but only for completion operations." 499 Runs the usual ange-ftp hook, but only for completion operations."
459 inhibit-file-name-handlers))) 507 inhibit-file-name-handlers)))
460 (inhibit-file-name-operation op)) 508 (inhibit-file-name-operation op))
461 (apply op args)))) 509 (apply op args))))
462 510
463 (defun convert-standard-filename (filename) 511 (defun convert-standard-filename (filename)
464 "Convert a standard file's name to something suitable for the current OS. 512 "Convert a standard file's name to something suitable for the OS.
465 This function's standard definition is trivial; it just returns the argument. 513 This means to guarantee valid names and perhaps to canonicalize
466 However, on some systems, the function is redefined with a definition 514 certain patterns.
467 that really does change some file names to canonicalize certain 515
468 patterns and to guarantee valid names." 516 FILENAME should be an absolute file name since the conversion rules
517 sometimes vary depending on the position in the file name. E.g. c:/foo
518 is a valid DOS file name, but c:/bar/c:/foo is not.
519
520 This function's standard definition is trivial; it just returns
521 the argument. However, on Windows and DOS, replace invalid
522 characters. On DOS, make sure to obey the 8.3 limitations. On
523 Windows, turn Cygwin names into native names, and also turn
524 slashes into backslashes if the shell requires it (see
525 `w32-shell-dos-semantics').
526
527 See Info node `(elisp)Standard File Names' for more details."
469 filename) 528 filename)
470 529
471 (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) 530 (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
472 "Read directory name, prompting with PROMPT and completing in directory DIR. 531 "Read directory name, prompting with PROMPT and completing in directory DIR.
473 Value is not expanded---you must call `expand-file-name' yourself. 532 Value is not expanded---you must call `expand-file-name' yourself.
474 Default name to DEFAULT-DIRNAME if user enters a null string. 533 Default name to DEFAULT-DIRNAME if user exits with the same
475 (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used, 534 non-empty string that was inserted by this function.
476 except that if INITIAL is specified, that combined with DIR is used.) 535 (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
536 or just DIR if INITIAL is nil.)
537 If the user exits with an empty minibuffer, this function returns
538 an empty string. (This can only happen if the user erased the
539 pre-inserted contents or if `insert-default-directory' is nil.)
477 Fourth arg MUSTMATCH non-nil means require existing directory's name. 540 Fourth arg MUSTMATCH non-nil means require existing directory's name.
478 Non-nil and non-t means also require confirmation after completion. 541 Non-nil and non-t means also require confirmation after completion.
479 Fifth arg INITIAL specifies text to start with. 542 Fifth arg INITIAL specifies text to start with.
480 DIR defaults to current buffer's directory default." 543 DIR should be an absolute directory name. It defaults to
544 the value of `default-directory'."
481 (unless dir 545 (unless dir
482 (setq dir default-directory)) 546 (setq dir default-directory))
483 (unless default-dirname 547 (read-file-name prompt dir (or default-dirname
484 (setq default-dirname 548 (if initial (expand-file-name initial dir)
485 (if initial (concat dir initial) default-directory))) 549 dir))
486 (read-file-name prompt dir default-dirname mustmatch initial 550 mustmatch initial
487 'file-directory-p)) 551 'file-directory-p))
488 552
489 553
490 (defun pwd () 554 (defun pwd ()
491 "Show the current default directory." 555 "Show the current default directory."
495 (defvar cd-path nil 559 (defvar cd-path nil
496 "Value of the CDPATH environment variable, as a list. 560 "Value of the CDPATH environment variable, as a list.
497 Not actually set up until the first time you use it.") 561 Not actually set up until the first time you use it.")
498 562
499 (defun parse-colon-path (cd-path) 563 (defun parse-colon-path (cd-path)
500 "Explode a colon-separated search path into a list of directory names. 564 "Explode a search path into a list of directory names.
501 \(For values of `colon' equal to `path-separator'.)" 565 Directories are separated by occurrences of `path-separator'
566 \(which is colon in GNU and GNU-like systems)."
502 ;; We could use split-string here. 567 ;; We could use split-string here.
503 (and cd-path 568 (and cd-path
504 (let (cd-prefix cd-list (cd-start 0) cd-colon) 569 (let (cd-list (cd-start 0) cd-colon)
505 (setq cd-path (concat cd-path path-separator)) 570 (setq cd-path (concat cd-path path-separator))
506 (while (setq cd-colon (string-match path-separator cd-path cd-start)) 571 (while (setq cd-colon (string-match path-separator cd-path cd-start))
507 (setq cd-list 572 (setq cd-list
508 (nconc cd-list 573 (nconc cd-list
509 (list (if (= cd-start cd-colon) 574 (list (if (= cd-start cd-colon)
529 (setq default-directory dir) 594 (setq default-directory dir)
530 (error "Cannot cd to %s: Permission denied" dir)))) 595 (error "Cannot cd to %s: Permission denied" dir))))
531 596
532 (defun cd (dir) 597 (defun cd (dir)
533 "Make DIR become the current buffer's default directory. 598 "Make DIR become the current buffer's default directory.
534 If your environment includes a `CDPATH' variable, try each one of that 599 If your environment includes a `CDPATH' variable, try each one of
535 colon-separated list of directories when resolving a relative directory name." 600 that list of directories (separated by occurrences of
601 `path-separator') when resolving a relative directory name.
602 The path separator is colon in GNU and GNU-like systems."
536 (interactive 603 (interactive
537 (list (read-directory-name "Change default directory: " 604 (list (read-directory-name "Change default directory: "
538 default-directory default-directory 605 default-directory default-directory
539 (and (member cd-path '(nil ("./"))) 606 (and (member cd-path '(nil ("./")))
540 (null (getenv "CDPATH")))))) 607 (null (getenv "CDPATH"))))))
563 (read-file-name "Load file: ")))) 630 (read-file-name "Load file: "))))
564 (load (expand-file-name file) nil nil t)) 631 (load (expand-file-name file) nil nil t))
565 632
566 (defun locate-file (filename path &optional suffixes predicate) 633 (defun locate-file (filename path &optional suffixes predicate)
567 "Search for FILENAME through PATH. 634 "Search for FILENAME through PATH.
635 If found, return the absolute file name of FILENAME, with its suffixes;
636 otherwise return nil.
637 PATH should be a list of directories to look in, like the lists in
638 `exec-path' or `load-path'.
568 If SUFFIXES is non-nil, it should be a list of suffixes to append to 639 If SUFFIXES is non-nil, it should be a list of suffixes to append to
569 file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\"). 640 file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
641 Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
570 If non-nil, PREDICATE is used instead of `file-readable-p'. 642 If non-nil, PREDICATE is used instead of `file-readable-p'.
571 PREDICATE can also be an integer to pass to the `access' system call, 643 PREDICATE can also be an integer to pass to the `access' system call,
572 in which case file-name handlers are ignored. This usage is deprecated. 644 in which case file-name handlers are ignored. This usage is deprecated.
573 645
574 For compatibility, PREDICATE can also be one of the symbols 646 For compatibility, PREDICATE can also be one of the symbols
583 (if (memq 'readable predicate) 4 0)))) 655 (if (memq 'readable predicate) 4 0))))
584 (locate-file-internal filename path suffixes predicate)) 656 (locate-file-internal filename path suffixes predicate))
585 657
586 (defun locate-file-completion (string path-and-suffixes action) 658 (defun locate-file-completion (string path-and-suffixes action)
587 "Do completion for file names passed to `locate-file'. 659 "Do completion for file names passed to `locate-file'.
588 PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)." 660 PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
589 (if (file-name-absolute-p string) 661 (if (file-name-absolute-p string)
590 (read-file-name-internal string nil action) 662 (read-file-name-internal string nil action)
591 (let ((names nil) 663 (let ((names nil)
592 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) 664 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
593 (string-dir (file-name-directory string))) 665 (string-dir (file-name-directory string)))
594 (dolist (dir (car path-and-suffixes)) 666 (dolist (dir (car path-and-suffixes))
667 (unless dir
668 (setq dir default-directory))
595 (if string-dir (setq dir (expand-file-name string-dir dir))) 669 (if string-dir (setq dir (expand-file-name string-dir dir)))
596 (when (file-directory-p dir) 670 (when (file-directory-p dir)
597 (dolist (file (file-name-all-completions 671 (dolist (file (file-name-all-completions
598 (file-name-nondirectory string) dir)) 672 (file-name-nondirectory string) dir))
599 (push (if string-dir (concat string-dir file) file) names) 673 (push (if string-dir (concat string-dir file) file) names)
603 (cond 677 (cond
604 ((eq action t) (all-completions string names)) 678 ((eq action t) (all-completions string names))
605 ((null action) (try-completion string names)) 679 ((null action) (try-completion string names))
606 (t (test-completion string names)))))) 680 (t (test-completion string names))))))
607 681
682 (defun executable-find (command)
683 "Search for COMMAND in `exec-path' and return the absolute file name.
684 Return nil if COMMAND is not found anywhere in `exec-path'."
685 ;; Use 1 rather than file-executable-p to better match the behavior of
686 ;; call-process.
687 (locate-file command exec-path exec-suffixes 1))
688
608 (defun load-library (library) 689 (defun load-library (library)
609 "Load the library named LIBRARY. 690 "Load the library named LIBRARY.
610 This is an interface to the function `load'." 691 This is an interface to the function `load'."
611 (interactive 692 (interactive
612 (list (completing-read "Load library: " 693 (list (completing-read "Load library: "
613 'locate-file-completion 694 'locate-file-completion
614 (cons load-path load-suffixes)))) 695 (cons load-path load-suffixes))))
615 (load library)) 696 (load library))
616 697
617 (defun file-remote-p (file) 698 (defun file-remote-p (file)
618 "Test whether FILE specifies a location on a remote system." 699 "Test whether FILE specifies a location on a remote system.
619 (let ((handler (find-file-name-handler file 'file-local-copy))) 700 Return an identification of the system if the location is indeed
701 remote. The identification of the system may comprise a method
702 to access the system and its hostname, amongst other things.
703
704 For example, the filename \"/user@host:/foo\" specifies a location
705 on the system \"/user@host:\"."
706 (let ((handler (find-file-name-handler file 'file-remote-p)))
620 (if handler 707 (if handler
621 (get handler 'file-remote-p)))) 708 (funcall handler 'file-remote-p file)
709 nil)))
622 710
623 (defun file-local-copy (file) 711 (defun file-local-copy (file)
624 "Copy the file FILE into a temporary file on this machine. 712 "Copy the file FILE into a temporary file on this machine.
625 Returns the name of the local copy, or nil, if FILE is directly 713 Returns the name of the local copy, or nil, if FILE is directly
626 accessible." 714 accessible."
635 "Return the truename of FILENAME, which should be absolute. 723 "Return the truename of FILENAME, which should be absolute.
636 The truename of a file name is found by chasing symbolic links 724 The truename of a file name is found by chasing symbolic links
637 both at the level of the file and at the level of the directories 725 both at the level of the file and at the level of the directories
638 containing it, until no links are left at any level. 726 containing it, until no links are left at any level.
639 727
640 The arguments COUNTER and PREV-DIRS are used only in recursive calls. 728 \(fn FILENAME)" ;; Don't document the optional arguments.
641 Do not specify them in other calls." 729 ;; COUNTER and PREV-DIRS are only used in recursive calls.
642 ;; COUNTER can be a cons cell whose car is the count of how many more links 730 ;; COUNTER can be a cons cell whose car is the count of how many
643 ;; to chase before getting an error. 731 ;; more links to chase before getting an error.
644 ;; PREV-DIRS can be a cons cell whose car is an alist 732 ;; PREV-DIRS can be a cons cell whose car is an alist
645 ;; of truenames we've just recently computed. 733 ;; of truenames we've just recently computed.
646 734 (cond ((or (string= filename "") (string= filename "~"))
647 ;; The last test looks dubious, maybe `+' is meant here? --simon. 735 (setq filename (expand-file-name filename))
648 (if (or (string= filename "") (string= filename "~") 736 (if (string= filename "")
649 (and (string= (substring filename 0 1) "~") 737 (setq filename "/")))
650 (string-match "~[^/]*" filename))) 738 ((and (string= (substring filename 0 1) "~")
651 (progn 739 (string-match "~[^/]*/?" filename))
652 (setq filename (expand-file-name filename)) 740 (let ((first-part
653 (if (string= filename "") 741 (substring filename 0 (match-end 0)))
654 (setq filename "/")))) 742 (rest (substring filename (match-end 0))))
743 (setq filename (concat (expand-file-name first-part) rest)))))
744
655 (or counter (setq counter (list 100))) 745 (or counter (setq counter (list 100)))
656 (let (done 746 (let (done
657 ;; For speed, remove the ange-ftp completion handler from the list. 747 ;; For speed, remove the ange-ftp completion handler from the list.
658 ;; We know it's not needed here. 748 ;; We know it's not needed here.
659 ;; For even more speed, do this only on the outermost call. 749 ;; For even more speed, do this only on the outermost call.
736 done nil) 826 done nil)
737 ;; No, we are done! 827 ;; No, we are done!
738 (setq done t)))))))) 828 (setq done t))))))))
739 filename)) 829 filename))
740 830
741 (defun file-chase-links (filename) 831 (defun file-chase-links (filename &optional limit)
742 "Chase links in FILENAME until a name that is not a link. 832 "Chase links in FILENAME until a name that is not a link.
743 Does not examine containing directories for links, 833 Unlike `file-truename', this does not check whether a parent
744 unlike `file-truename'." 834 directory name is a symbolic link.
745 (let (tem (count 100) (newname filename)) 835 If the optional argument LIMIT is a number,
746 (while (setq tem (file-symlink-p newname)) 836 it means chase no more than that many links and then stop."
837 (let (tem (newname filename)
838 (count 0))
839 (while (and (or (null limit) (< count limit))
840 (setq tem (file-symlink-p newname)))
747 (save-match-data 841 (save-match-data
748 (if (= count 0) 842 (if (and (null limit) (= count 100))
749 (error "Apparent cycle of symbolic links for %s" filename)) 843 (error "Apparent cycle of symbolic links for %s" filename))
750 ;; In the context of a link, `//' doesn't mean what Emacs thinks. 844 ;; In the context of a link, `//' doesn't mean what Emacs thinks.
751 (while (string-match "//+" tem) 845 (while (string-match "//+" tem)
752 (setq tem (replace-match "/" nil nil tem))) 846 (setq tem (replace-match "/" nil nil tem)))
753 ;; Handle `..' by hand, since it needs to work in the 847 ;; Handle `..' by hand, since it needs to work in the
762 (file-chase-links 856 (file-chase-links
763 (directory-file-name (file-name-directory newname)))) 857 (directory-file-name (file-name-directory newname))))
764 ;; Now find the parent of that dir. 858 ;; Now find the parent of that dir.
765 (setq newname (file-name-directory newname))) 859 (setq newname (file-name-directory newname)))
766 (setq newname (expand-file-name tem (file-name-directory newname))) 860 (setq newname (expand-file-name tem (file-name-directory newname)))
767 (setq count (1- count)))) 861 (setq count (1+ count))))
862 newname))
863
864 (defun make-temp-file (prefix &optional dir-flag suffix)
865 "Create a temporary file.
866 The returned file name (created by appending some random characters at the end
867 of PREFIX, and expanding against `temporary-file-directory' if necessary),
868 is guaranteed to point to a newly created empty file.
869 You can then use `write-region' to write new data into the file.
870
871 If DIR-FLAG is non-nil, create a new empty directory instead of a file.
872
873 If SUFFIX is non-nil, add that at the end of the file name."
874 (let ((umask (default-file-modes))
875 file)
876 (unwind-protect
877 (progn
878 ;; Create temp files with strict access rights. It's easy to
879 ;; loosen them later, whereas it's impossible to close the
880 ;; time-window of loose permissions otherwise.
881 (set-default-file-modes ?\700)
882 (while (condition-case ()
883 (progn
884 (setq file
885 (make-temp-name
886 (expand-file-name prefix temporary-file-directory)))
887 (if suffix
888 (setq file (concat file suffix)))
889 (if dir-flag
890 (make-directory file)
891 (write-region "" nil file nil 'silent nil 'excl))
892 nil)
893 (file-already-exists t))
894 ;; the file was somehow created by someone else between
895 ;; `make-temp-name' and `write-region', let's try again.
896 nil)
897 file)
898 ;; Reset the umask.
899 (set-default-file-modes umask))))
900
901 (defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
902 "Change the encoding of FILE's name from CODING to NEW-CODING.
903 The value is a new name of FILE.
904 Signals a `file-already-exists' error if a file of the new name
905 already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
906 is non-nil. A number as fourth arg means request confirmation if
907 the new name already exists. This is what happens in interactive
908 use with M-x."
909 (interactive
910 (let ((default-coding (or file-name-coding-system
911 default-file-name-coding-system))
912 (filename (read-file-name "Recode filename: " nil nil t))
913 from-coding to-coding)
914 (if (and default-coding
915 ;; We provide the default coding only when it seems that
916 ;; the filename is correctly decoded by the default
917 ;; coding.
918 (let ((charsets (find-charset-string filename)))
919 (and (not (memq 'eight-bit-control charsets))
920 (not (memq 'eight-bit-graphic charsets)))))
921 (setq from-coding (read-coding-system
922 (format "Recode filename %s from (default %s): "
923 filename default-coding)
924 default-coding))
925 (setq from-coding (read-coding-system
926 (format "Recode filename %s from: " filename))))
927
928 ;; We provide the default coding only when a user is going to
929 ;; change the encoding not from the default coding.
930 (if (eq from-coding default-coding)
931 (setq to-coding (read-coding-system
932 (format "Recode filename %s from %s to: "
933 filename from-coding)))
934 (setq to-coding (read-coding-system
935 (format "Recode filename %s from %s to (default %s): "
936 filename from-coding default-coding)
937 default-coding)))
938 (list filename from-coding to-coding)))
939
940 (let* ((default-coding (or file-name-coding-system
941 default-file-name-coding-system))
942 ;; FILE should have been decoded by DEFAULT-CODING.
943 (encoded (encode-coding-string file default-coding))
944 (newname (decode-coding-string encoded coding))
945 (new-encoded (encode-coding-string newname new-coding))
946 ;; Suppress further encoding.
947 (file-name-coding-system nil)
948 (default-file-name-coding-system nil)
949 (locale-coding-system nil))
950 (rename-file encoded new-encoded ok-if-already-exists)
768 newname)) 951 newname))
769 952
770 (defun switch-to-buffer-other-window (buffer &optional norecord) 953 (defun switch-to-buffer-other-window (buffer &optional norecord)
771 "Select buffer BUFFER in another window. 954 "Select buffer BUFFER in another window.
955 If BUFFER does not identify an existing buffer, then this function
956 creates a buffer with that name.
957
958 When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
959 or nil. If BUFFER is nil, then this function chooses a buffer
960 using `other-buffer'.
772 Optional second arg NORECORD non-nil means 961 Optional second arg NORECORD non-nil means
773 do not put this buffer at the front of the list of recently selected ones. 962 do not put this buffer at the front of the list of recently selected ones.
963 This function returns the buffer it switched to.
774 964
775 This uses the function `display-buffer' as a subroutine; see its 965 This uses the function `display-buffer' as a subroutine; see its
776 documentation for additional customization information." 966 documentation for additional customization information."
777 (interactive "BSwitch to buffer in other window: ") 967 (interactive "BSwitch to buffer in other window: ")
778 (let ((pop-up-windows t)) 968 (let ((pop-up-windows t)
969 ;; Don't let these interfere.
970 same-window-buffer-names same-window-regexps)
779 (pop-to-buffer buffer t norecord))) 971 (pop-to-buffer buffer t norecord)))
780 972
781 (defun switch-to-buffer-other-frame (buffer &optional norecord) 973 (defun switch-to-buffer-other-frame (buffer &optional norecord)
782 "Switch to buffer BUFFER in another frame. 974 "Switch to buffer BUFFER in another frame.
783 Optional second arg NORECORD non-nil means 975 Optional second arg NORECORD non-nil means
784 do not put this buffer at the front of the list of recently selected ones. 976 do not put this buffer at the front of the list of recently selected ones.
785 977
786 This uses the function `display-buffer' as a subroutine; see its 978 This uses the function `display-buffer' as a subroutine; see its
787 documentation for additional customization information." 979 documentation for additional customization information."
788 (interactive "BSwitch to buffer in other frame: ") 980 (interactive "BSwitch to buffer in other frame: ")
789 (let ((pop-up-frames t)) 981 (let ((pop-up-frames t)
982 same-window-buffer-names same-window-regexps)
790 (pop-to-buffer buffer t norecord) 983 (pop-to-buffer buffer t norecord)
791 (raise-frame (window-frame (selected-window))))) 984 (raise-frame (window-frame (selected-window)))))
792 985
793 (defvar find-file-default nil 986 (defvar find-file-default nil
794 "Used within `find-file-read-args'.") 987 "Used within `find-file-read-args'.")
988
989 (defmacro minibuffer-with-setup-hook (fun &rest body)
990 "Add FUN to `minibuffer-setup-hook' while executing BODY.
991 BODY should use the minibuffer at most once.
992 Recursive uses of the minibuffer will not be affected."
993 (declare (indent 1) (debug t))
994 (let ((hook (make-symbol "setup-hook")))
995 `(let (,hook)
996 (setq ,hook
997 (lambda ()
998 ;; Clear out this hook so it does not interfere
999 ;; with any recursive minibuffer usage.
1000 (remove-hook 'minibuffer-setup-hook ,hook)
1001 (,fun)))
1002 (unwind-protect
1003 (progn
1004 (add-hook 'minibuffer-setup-hook ,hook)
1005 ,@body)
1006 (remove-hook 'minibuffer-setup-hook ,hook)))))
795 1007
796 (defun find-file-read-args (prompt mustmatch) 1008 (defun find-file-read-args (prompt mustmatch)
797 (list (let ((find-file-default 1009 (list (let ((find-file-default
798 (and buffer-file-name 1010 (and buffer-file-name
799 (abbreviate-file-name buffer-file-name))) 1011 (abbreviate-file-name buffer-file-name))))
800 (munge-default-fun 1012 (minibuffer-with-setup-hook
801 (lambda () 1013 (lambda () (setq minibuffer-default find-file-default))
802 (setq minibuffer-default find-file-default) 1014 (read-file-name prompt nil default-directory mustmatch)))
803 ;; Clear out this hook so it does not interfere
804 ;; with any recursive minibuffer usage.
805 (pop minibuffer-setup-hook)))
806 (minibuffer-setup-hook
807 minibuffer-setup-hook))
808 (add-hook 'minibuffer-setup-hook munge-default-fun)
809 (read-file-name prompt nil default-directory mustmatch))
810 t)) 1015 t))
811 1016
812 (defun find-file (filename &optional wildcards) 1017 (defun find-file (filename &optional wildcards)
813 "Edit file FILENAME. 1018 "Edit file FILENAME.
814 Switch to a buffer visiting file FILENAME, 1019 Switch to a buffer visiting file FILENAME,
816 Interactively, the default if you just type RET is the current directory, 1021 Interactively, the default if you just type RET is the current directory,
817 but the visited file name is available through the minibuffer history: 1022 but the visited file name is available through the minibuffer history:
818 type M-n to pull it into the minibuffer. 1023 type M-n to pull it into the minibuffer.
819 1024
820 Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1025 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
821 expand wildcards (if any) and visit multiple files. Wildcard expansion 1026 expand wildcards (if any) and visit multiple files. You can
822 can be suppressed by setting `find-file-wildcards'." 1027 suppress wildcard expansion by setting `find-file-wildcards'.
823 (interactive 1028
824 (find-file-read-args "Find file: " nil)) 1029 To visit a file without any kind of conversion and without
1030 automatically choosing a major mode, use \\[find-file-literally]."
1031 (interactive (find-file-read-args "Find file: " nil))
825 (let ((value (find-file-noselect filename nil nil wildcards))) 1032 (let ((value (find-file-noselect filename nil nil wildcards)))
826 (if (listp value) 1033 (if (listp value)
827 (mapcar 'switch-to-buffer (nreverse value)) 1034 (mapcar 'switch-to-buffer (nreverse value))
828 (switch-to-buffer value)))) 1035 (switch-to-buffer value))))
829 1036
841 (interactive (find-file-read-args "Find file in other window: " nil)) 1048 (interactive (find-file-read-args "Find file in other window: " nil))
842 (let ((value (find-file-noselect filename nil nil wildcards))) 1049 (let ((value (find-file-noselect filename nil nil wildcards)))
843 (if (listp value) 1050 (if (listp value)
844 (progn 1051 (progn
845 (setq value (nreverse value)) 1052 (setq value (nreverse value))
846 (switch-to-buffer-other-window (car value)) 1053 (cons (switch-to-buffer-other-window (car value))
847 (mapcar 'switch-to-buffer (cdr value))) 1054 (mapcar 'switch-to-buffer (cdr value))))
848 (switch-to-buffer-other-window value)))) 1055 (switch-to-buffer-other-window value))))
849 1056
850 (defun find-file-other-frame (filename &optional wildcards) 1057 (defun find-file-other-frame (filename &optional wildcards)
851 "Edit file FILENAME, in another frame. 1058 "Edit file FILENAME, in another frame.
852 May create a new frame, or reuse an existing one. 1059 May create a new frame, or reuse an existing one.
861 (interactive (find-file-read-args "Find file in other frame: " nil)) 1068 (interactive (find-file-read-args "Find file in other frame: " nil))
862 (let ((value (find-file-noselect filename nil nil wildcards))) 1069 (let ((value (find-file-noselect filename nil nil wildcards)))
863 (if (listp value) 1070 (if (listp value)
864 (progn 1071 (progn
865 (setq value (nreverse value)) 1072 (setq value (nreverse value))
866 (switch-to-buffer-other-frame (car value)) 1073 (cons (switch-to-buffer-other-frame (car value))
867 (mapcar 'switch-to-buffer (cdr value))) 1074 (mapcar 'switch-to-buffer (cdr value))))
868 (switch-to-buffer-other-frame value)))) 1075 (switch-to-buffer-other-frame value))))
1076
1077 (defun find-file-existing (filename &optional wildcards)
1078 "Edit the existing file FILENAME.
1079 Like \\[find-file] but only allow files that exists."
1080 (interactive (find-file-read-args "Find existing file: " t))
1081 (unless (file-exists-p filename) (error "%s does not exist" filename))
1082 (find-file filename wildcards)
1083 (current-buffer))
869 1084
870 (defun find-file-read-only (filename &optional wildcards) 1085 (defun find-file-read-only (filename &optional wildcards)
871 "Edit file FILENAME but don't allow changes. 1086 "Edit file FILENAME but don't allow changes.
872 Like \\[find-file] but marks buffer as read-only. 1087 Like \\[find-file] but marks buffer as read-only.
873 Use \\[toggle-read-only] to permit editing." 1088 Use \\[toggle-read-only] to permit editing."
874 (interactive (find-file-read-args "Find file read-only: " t)) 1089 (interactive (find-file-read-args "Find file read-only: " nil))
875 (find-file filename wildcards) 1090 (unless (or (and wildcards find-file-wildcards
876 (toggle-read-only 1) 1091 (not (string-match "\\`/:" filename))
877 (current-buffer)) 1092 (string-match "[[*?]" filename))
1093 (file-exists-p filename))
1094 (error "%s does not exist" filename))
1095 (let ((value (find-file filename wildcards)))
1096 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1097 (if (listp value) value (list value)))
1098 value))
878 1099
879 (defun find-file-read-only-other-window (filename &optional wildcards) 1100 (defun find-file-read-only-other-window (filename &optional wildcards)
880 "Edit file FILENAME in another window but don't allow changes. 1101 "Edit file FILENAME in another window but don't allow changes.
881 Like \\[find-file-other-window] but marks buffer as read-only. 1102 Like \\[find-file-other-window] but marks buffer as read-only.
882 Use \\[toggle-read-only] to permit editing." 1103 Use \\[toggle-read-only] to permit editing."
883 (interactive (find-file-read-args "Find file read-only other window: " t)) 1104 (interactive (find-file-read-args "Find file read-only other window: " nil))
884 (find-file-other-window filename wildcards) 1105 (unless (or (and wildcards find-file-wildcards
885 (toggle-read-only 1) 1106 (not (string-match "\\`/:" filename))
886 (current-buffer)) 1107 (string-match "[[*?]" filename))
1108 (file-exists-p filename))
1109 (error "%s does not exist" filename))
1110 (let ((value (find-file-other-window filename wildcards)))
1111 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1112 (if (listp value) value (list value)))
1113 value))
887 1114
888 (defun find-file-read-only-other-frame (filename &optional wildcards) 1115 (defun find-file-read-only-other-frame (filename &optional wildcards)
889 "Edit file FILENAME in another frame but don't allow changes. 1116 "Edit file FILENAME in another frame but don't allow changes.
890 Like \\[find-file-other-frame] but marks buffer as read-only. 1117 Like \\[find-file-other-frame] but marks buffer as read-only.
891 Use \\[toggle-read-only] to permit editing." 1118 Use \\[toggle-read-only] to permit editing."
892 (interactive (find-file-read-args "Find file read-only other frame: " t)) 1119 (interactive (find-file-read-args "Find file read-only other frame: " nil))
893 (find-file-other-frame filename wildcards) 1120 (unless (or (and wildcards find-file-wildcards
894 (toggle-read-only 1) 1121 (not (string-match "\\`/:" filename))
895 (current-buffer)) 1122 (string-match "[[*?]" filename))
896 1123 (file-exists-p filename))
897 (defun find-alternate-file-other-window (filename) 1124 (error "%s does not exist" filename))
1125 (let ((value (find-file-other-frame filename wildcards)))
1126 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1127 (if (listp value) value (list value)))
1128 value))
1129
1130 (defun find-alternate-file-other-window (filename &optional wildcards)
898 "Find file FILENAME as a replacement for the file in the next window. 1131 "Find file FILENAME as a replacement for the file in the next window.
899 This command does not select that window." 1132 This command does not select that window.
1133
1134 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1135 expand wildcards (if any) and replace the file with multiple files."
900 (interactive 1136 (interactive
901 (save-selected-window 1137 (save-selected-window
902 (other-window 1) 1138 (other-window 1)
903 (let ((file buffer-file-name) 1139 (let ((file buffer-file-name)
904 (file-name nil) 1140 (file-name nil)
905 (file-dir nil)) 1141 (file-dir nil))
906 (and file 1142 (and file
907 (setq file-name (file-name-nondirectory file) 1143 (setq file-name (file-name-nondirectory file)
908 file-dir (file-name-directory file))) 1144 file-dir (file-name-directory file)))
909 (list (read-file-name 1145 (list (read-file-name
910 "Find alternate file: " file-dir nil nil file-name))))) 1146 "Find alternate file: " file-dir nil nil file-name)
1147 t))))
911 (if (one-window-p) 1148 (if (one-window-p)
912 (find-file-other-window filename) 1149 (find-file-other-window filename wildcards)
913 (save-selected-window 1150 (save-selected-window
914 (other-window 1) 1151 (other-window 1)
915 (find-alternate-file filename)))) 1152 (find-alternate-file filename wildcards))))
916 1153
917 (defun find-alternate-file (filename) 1154 (defun find-alternate-file (filename &optional wildcards)
918 "Find file FILENAME, select its buffer, kill previous buffer. 1155 "Find file FILENAME, select its buffer, kill previous buffer.
919 If the current buffer now contains an empty file that you just visited 1156 If the current buffer now contains an empty file that you just visited
920 \(presumably by mistake), use this command to visit the file you really want." 1157 \(presumably by mistake), use this command to visit the file you really want.
1158
1159 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1160 expand wildcards (if any) and replace the file with multiple files."
921 (interactive 1161 (interactive
922 (let ((file buffer-file-name) 1162 (let ((file buffer-file-name)
923 (file-name nil) 1163 (file-name nil)
924 (file-dir nil)) 1164 (file-dir nil))
925 (and file 1165 (and file
926 (setq file-name (file-name-nondirectory file) 1166 (setq file-name (file-name-nondirectory file)
927 file-dir (file-name-directory file))) 1167 file-dir (file-name-directory file)))
928 (list (read-file-name 1168 (list (read-file-name
929 "Find alternate file: " file-dir nil nil file-name)))) 1169 "Find alternate file: " file-dir nil nil file-name)
1170 t)))
930 (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) 1171 (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
931 (error "Aborted")) 1172 (error "Aborted"))
932 (when (and (buffer-modified-p) (buffer-file-name)) 1173 (when (and (buffer-modified-p) (buffer-file-name))
933 (if (yes-or-no-p (format "Buffer %s is modified; save it first? " 1174 (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
934 (buffer-name))) 1175 (buffer-name)))
952 (setq buffer-file-name nil) 1193 (setq buffer-file-name nil)
953 (setq buffer-file-number nil) 1194 (setq buffer-file-number nil)
954 (setq buffer-file-truename nil) 1195 (setq buffer-file-truename nil)
955 ;; Likewise for dired buffers. 1196 ;; Likewise for dired buffers.
956 (setq dired-directory nil) 1197 (setq dired-directory nil)
957 (find-file filename)) 1198 (find-file filename wildcards))
958 (when (eq obuf (current-buffer)) 1199 (when (eq obuf (current-buffer))
959 ;; This executes if find-file gets an error 1200 ;; This executes if find-file gets an error
960 ;; and does not really find anything. 1201 ;; and does not really find anything.
961 ;; We put things back as they were. 1202 ;; We put things back as they were.
962 ;; If find-file actually finds something, we kill obuf below. 1203 ;; If find-file actually finds something, we kill obuf below.
994 (defvar abbreviated-home-dir nil 1235 (defvar abbreviated-home-dir nil
995 "The user's homedir abbreviated according to `directory-abbrev-alist'.") 1236 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
996 1237
997 (defun abbreviate-file-name (filename) 1238 (defun abbreviate-file-name (filename)
998 "Return a version of FILENAME shortened using `directory-abbrev-alist'. 1239 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
999 This also substitutes \"~\" for the user's home directory. 1240 This also substitutes \"~\" for the user's home directory and
1000 Type \\[describe-variable] directory-abbrev-alist RET for more information." 1241 removes automounter prefixes (see the variable `automount-dir-prefix')."
1001 ;; Get rid of the prefixes added by the automounter. 1242 ;; Get rid of the prefixes added by the automounter.
1002 (if (and automount-dir-prefix 1243 (if (and automount-dir-prefix
1003 (string-match automount-dir-prefix filename) 1244 (string-match automount-dir-prefix filename)
1004 (file-exists-p (file-name-directory 1245 (file-exists-p (file-name-directory
1005 (substring filename (1- (match-end 0)))))) 1246 (substring filename (1- (match-end 0))))))
1053 1294
1054 (defun find-buffer-visiting (filename &optional predicate) 1295 (defun find-buffer-visiting (filename &optional predicate)
1055 "Return the buffer visiting file FILENAME (a string). 1296 "Return the buffer visiting file FILENAME (a string).
1056 This is like `get-file-buffer', except that it checks for any buffer 1297 This is like `get-file-buffer', except that it checks for any buffer
1057 visiting the same file, possibly under a different name. 1298 visiting the same file, possibly under a different name.
1058 If PREDICATE is non-nil, only a buffer satisfying it can be returned. 1299 If PREDICATE is non-nil, only buffers satisfying it are eligible,
1300 and others are ignored.
1059 If there is no such live buffer, return nil." 1301 If there is no such live buffer, return nil."
1060 (let ((predicate (or predicate #'identity)) 1302 (let ((predicate (or predicate #'identity))
1061 (truename (abbreviate-file-name (file-truename filename)))) 1303 (truename (abbreviate-file-name (file-truename filename))))
1062 (or (let ((buf (get-file-buffer filename))) 1304 (or (let ((buf (get-file-buffer filename)))
1063 (when (and buf (funcall predicate buf)) buf)) 1305 (when (and buf (funcall predicate buf)) buf))
1105 suppresses this warning." 1347 suppresses this warning."
1106 :group 'files 1348 :group 'files
1107 :version "21.1" 1349 :version "21.1"
1108 :type 'boolean) 1350 :type 'boolean)
1109 1351
1352 (defcustom large-file-warning-threshold 10000000
1353 "Maximum size of file above which a confirmation is requested.
1354 When nil, never request confirmation."
1355 :group 'files
1356 :group 'find-file
1357 :version "22.1"
1358 :type '(choice integer (const :tag "Never request confirmation" nil)))
1359
1110 (defun find-file-noselect (filename &optional nowarn rawfile wildcards) 1360 (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
1111 "Read file FILENAME into a buffer and return the buffer. 1361 "Read file FILENAME into a buffer and return the buffer.
1112 If a buffer exists visiting FILENAME, return that one, but 1362 If a buffer exists visiting FILENAME, return that one, but
1113 verify that the file has not changed since visited or saved. 1363 verify that the file has not changed since visited or saved.
1114 The buffer is not selected, just returned to the caller. 1364 The buffer is not selected, just returned to the caller.
1115 Optional first arg NOWARN non-nil means suppress any warning messages. 1365 Optional second arg NOWARN non-nil means suppress any warning messages.
1116 Optional second arg RAWFILE non-nil means the file is read literally. 1366 Optional third arg RAWFILE non-nil means the file is read literally.
1117 Optional third arg WILDCARDS non-nil means do wildcard processing 1367 Optional fourth arg WILDCARDS non-nil means do wildcard processing
1118 and visit all the matching files. When wildcards are actually 1368 and visit all the matching files. When wildcards are actually
1119 used and expanded, the value is a list of buffers 1369 used and expanded, return a list of buffers that are visiting
1120 that are visiting the various files." 1370 the various files."
1121 (setq filename 1371 (setq filename
1122 (abbreviate-file-name 1372 (abbreviate-file-name
1123 (expand-file-name filename))) 1373 (expand-file-name filename)))
1124 (if (file-directory-p filename) 1374 (if (file-directory-p filename)
1125 (or (and find-file-run-dired 1375 (or (and find-file-run-dired
1140 (if (null files) 1390 (if (null files)
1141 (find-file-noselect filename) 1391 (find-file-noselect filename)
1142 (mapcar #'find-file-noselect files))) 1392 (mapcar #'find-file-noselect files)))
1143 (let* ((buf (get-file-buffer filename)) 1393 (let* ((buf (get-file-buffer filename))
1144 (truename (abbreviate-file-name (file-truename filename))) 1394 (truename (abbreviate-file-name (file-truename filename)))
1145 (number (nthcdr 10 (file-attributes truename))) 1395 (attributes (file-attributes truename))
1396 (number (nthcdr 10 attributes))
1146 ;; Find any buffer for a file which has same truename. 1397 ;; Find any buffer for a file which has same truename.
1147 (other (and (not buf) (find-buffer-visiting filename)))) 1398 (other (and (not buf) (find-buffer-visiting filename))))
1148 ;; Let user know if there is a buffer with the same truename. 1399 ;; Let user know if there is a buffer with the same truename.
1149 (if other 1400 (if other
1150 (progn 1401 (progn
1154 (message "%s and %s are the same file" 1405 (message "%s and %s are the same file"
1155 filename (buffer-file-name other))) 1406 filename (buffer-file-name other)))
1156 ;; Optionally also find that buffer. 1407 ;; Optionally also find that buffer.
1157 (if (or find-file-existing-other-name find-file-visit-truename) 1408 (if (or find-file-existing-other-name find-file-visit-truename)
1158 (setq buf other)))) 1409 (setq buf other))))
1410 ;; Check to see if the file looks uncommonly large.
1411 (when (and large-file-warning-threshold (nth 7 attributes)
1412 ;; Don't ask again if we already have the file or
1413 ;; if we're asked to be quiet.
1414 (not (or buf nowarn))
1415 (> (nth 7 attributes) large-file-warning-threshold)
1416 (not (y-or-n-p
1417 (format "File %s is large (%dMB), really open? "
1418 (file-name-nondirectory filename)
1419 (/ (nth 7 attributes) 1048576)))))
1420 (error "Aborted"))
1159 (if buf 1421 (if buf
1160 ;; We are using an existing buffer. 1422 ;; We are using an existing buffer.
1161 (progn 1423 (progn
1162 (or nowarn 1424 (or nowarn
1163 (verify-visited-file-modtime buf) 1425 (verify-visited-file-modtime buf)
1240 "File already visited literally")))))) 1502 "File already visited literally"))))))
1241 ;; Return the buffer we are using. 1503 ;; Return the buffer we are using.
1242 buf) 1504 buf)
1243 ;; Create a new buffer. 1505 ;; Create a new buffer.
1244 (setq buf (create-file-buffer filename)) 1506 (setq buf (create-file-buffer filename))
1245 (set-buffer-major-mode buf)
1246 ;; find-file-noselect-1 may use a different buffer. 1507 ;; find-file-noselect-1 may use a different buffer.
1247 (find-file-noselect-1 buf filename nowarn 1508 (find-file-noselect-1 buf filename nowarn
1248 rawfile truename number)))))) 1509 rawfile truename number))))))
1249 1510
1250 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number) 1511 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
1251 (let ((inhibit-read-only t) 1512 (let (error)
1252 error)
1253 (with-current-buffer buf 1513 (with-current-buffer buf
1254 (kill-local-variable 'find-file-literally) 1514 (kill-local-variable 'find-file-literally)
1255 ;; Needed in case we are re-visiting the file with a different 1515 ;; Needed in case we are re-visiting the file with a different
1256 ;; text representation. 1516 ;; text representation.
1257 (kill-local-variable 'buffer-file-coding-system) 1517 (kill-local-variable 'buffer-file-coding-system)
1258 (kill-local-variable 'cursor-type) 1518 (kill-local-variable 'cursor-type)
1259 (erase-buffer) 1519 (let ((inhibit-read-only t))
1520 (erase-buffer))
1260 (and (default-value 'enable-multibyte-characters) 1521 (and (default-value 'enable-multibyte-characters)
1261 (not rawfile) 1522 (not rawfile)
1262 (set-buffer-multibyte t)) 1523 (set-buffer-multibyte t))
1263 (if rawfile 1524 (if rawfile
1264 (condition-case () 1525 (condition-case ()
1265 (insert-file-contents-literally filename t) 1526 (let ((inhibit-read-only t))
1527 (insert-file-contents-literally filename t))
1266 (file-error 1528 (file-error
1267 (when (and (file-exists-p filename) 1529 (when (and (file-exists-p filename)
1268 (not (file-readable-p filename))) 1530 (not (file-readable-p filename)))
1269 (kill-buffer buf) 1531 (kill-buffer buf)
1270 (signal 'file-error (list "File is not readable" 1532 (signal 'file-error (list "File is not readable"
1271 filename))) 1533 filename)))
1272 ;; Unconditionally set error 1534 ;; Unconditionally set error
1273 (setq error t))) 1535 (setq error t)))
1274 (condition-case () 1536 (condition-case ()
1275 (insert-file-contents filename t) 1537 (let ((inhibit-read-only t))
1538 (insert-file-contents filename t))
1276 (file-error 1539 (file-error
1277 (when (and (file-exists-p filename) 1540 (when (and (file-exists-p filename)
1278 (not (file-readable-p filename))) 1541 (not (file-readable-p filename)))
1279 (kill-buffer buf) 1542 (kill-buffer buf)
1280 (signal 'file-error (list "File is not readable" 1543 (signal 'file-error (list "File is not readable"
1312 (setq backup-inhibited t))) 1575 (setq backup-inhibited t)))
1313 (if rawfile 1576 (if rawfile
1314 (progn 1577 (progn
1315 (set-buffer-multibyte nil) 1578 (set-buffer-multibyte nil)
1316 (setq buffer-file-coding-system 'no-conversion) 1579 (setq buffer-file-coding-system 'no-conversion)
1580 (set-buffer-major-mode buf)
1317 (make-local-variable 'find-file-literally) 1581 (make-local-variable 'find-file-literally)
1318 (setq find-file-literally t)) 1582 (setq find-file-literally t))
1319 (after-find-file error (not nowarn))) 1583 (after-find-file error (not nowarn)))
1320 (current-buffer)))) 1584 (current-buffer))))
1321 1585
1329 (let ((format-alist nil) 1593 (let ((format-alist nil)
1330 (after-insert-file-functions nil) 1594 (after-insert-file-functions nil)
1331 (coding-system-for-read 'no-conversion) 1595 (coding-system-for-read 'no-conversion)
1332 (coding-system-for-write 'no-conversion) 1596 (coding-system-for-write 'no-conversion)
1333 (find-buffer-file-type-function 1597 (find-buffer-file-type-function
1334 (if (fboundp 'find-buffer-file-type) 1598 (if (fboundp 'find-buffer-file-type)
1335 (symbol-function 'find-buffer-file-type) 1599 (symbol-function 'find-buffer-file-type)
1336 nil)) 1600 nil))
1337 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler)) 1601 (inhibit-file-name-handlers
1338 (inhibit-file-name-operation 'insert-file-contents)) 1602 (append '(jka-compr-handler image-file-handler)
1603 inhibit-file-name-handlers))
1604 (inhibit-file-name-operation 'insert-file-contents))
1339 (unwind-protect 1605 (unwind-protect
1340 (progn 1606 (progn
1341 (fset 'find-buffer-file-type (lambda (filename) t)) 1607 (fset 'find-buffer-file-type (lambda (filename) t))
1342 (insert-file-contents filename visit beg end replace)) 1608 (insert-file-contents filename visit beg end replace))
1343 (if find-buffer-file-type-function 1609 (if find-buffer-file-type-function
1344 (fset 'find-buffer-file-type find-buffer-file-type-function) 1610 (fset 'find-buffer-file-type find-buffer-file-type-function)
1345 (fmakunbound 'find-buffer-file-type))))) 1611 (fmakunbound 'find-buffer-file-type)))))
1346 1612
1347 (defun insert-file-1 (filename insert-func) 1613 (defun insert-file-1 (filename insert-func)
1436 "File not found and directory write-protected") 1702 "File not found and directory write-protected")
1437 ((file-exists-p (file-name-directory buffer-file-name)) 1703 ((file-exists-p (file-name-directory buffer-file-name))
1438 (setq buffer-read-only nil)) 1704 (setq buffer-read-only nil))
1439 (t 1705 (t
1440 (setq buffer-read-only nil) 1706 (setq buffer-read-only nil)
1441 (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name)))) 1707 "Use M-x make-directory RET RET to create the directory and its parents"))))
1442 "Use M-x make-directory RET RET to create the directory"
1443 "Use C-u M-x make-directory RET RET to create directory and its parents")))))
1444 (when msg 1708 (when msg
1445 (message "%s" msg) 1709 (message "%s" msg)
1446 (or not-serious (sit-for 1 nil t)))) 1710 (or not-serious (sit-for 1 t))))
1447 (when (and auto-save-default (not noauto)) 1711 (when (and auto-save-default (not noauto))
1448 (auto-save-mode t))) 1712 (auto-save-mode t)))
1449 ;; Make people do a little extra work (C-x C-q) 1713 ;; Make people do a little extra work (C-x C-q)
1450 ;; before altering a backup file. 1714 ;; before altering a backup file.
1451 (when (backup-file-name-p buffer-file-name) 1715 (when (backup-file-name-p buffer-file-name)
1457 (setq buffer-read-only t)) 1721 (setq buffer-read-only t))
1458 (unless nomodes 1722 (unless nomodes
1459 (when (and view-read-only view-mode) 1723 (when (and view-read-only view-mode)
1460 (view-mode-disable)) 1724 (view-mode-disable))
1461 (normal-mode t) 1725 (normal-mode t)
1726 ;; If requested, add a newline at the end of the file.
1727 (and (memq require-final-newline '(visit visit-save))
1728 (> (point-max) (point-min))
1729 (/= (char-after (1- (point-max))) ?\n)
1730 (not (and (eq selective-display t)
1731 (= (char-after (1- (point-max))) ?\r)))
1732 (save-excursion
1733 (goto-char (point-max))
1734 (insert "\n")))
1462 (when (and buffer-read-only 1735 (when (and buffer-read-only
1463 view-read-only 1736 view-read-only
1464 (not (eq (get major-mode 'mode-class) 'special))) 1737 (not (eq (get major-mode 'mode-class) 'special)))
1465 (view-mode-enter)) 1738 (view-mode-enter))
1466 (run-hooks 'find-file-hook))) 1739 (run-hooks 'find-file-hook)))
1740
1741 (defmacro report-errors (format &rest body)
1742 "Eval BODY and turn any error into a FORMAT message.
1743 FORMAT can have a %s escape which will be replaced with the actual error.
1744 If `debug-on-error' is set, errors are not caught, so that you can
1745 debug them.
1746 Avoid using a large BODY since it is duplicated."
1747 (declare (debug t) (indent 1))
1748 `(if debug-on-error
1749 (progn . ,body)
1750 (condition-case err
1751 (progn . ,body)
1752 (error (message ,format (prin1-to-string err))))))
1467 1753
1468 (defun normal-mode (&optional find-file) 1754 (defun normal-mode (&optional find-file)
1469 "Choose the major mode for this buffer automatically. 1755 "Choose the major mode for this buffer automatically.
1470 Also sets up any specified local variables of the file. 1756 Also sets up any specified local variables of the file.
1471 Uses the visited file name, the -*- line, and the local variables spec. 1757 Uses the visited file name, the -*- line, and the local variables spec.
1479 1765
1480 `enable-local-variables' is ignored if you run `normal-mode' interactively, 1766 `enable-local-variables' is ignored if you run `normal-mode' interactively,
1481 or from Lisp without specifying the optional argument FIND-FILE; 1767 or from Lisp without specifying the optional argument FIND-FILE;
1482 in that case, this function acts as if `enable-local-variables' were t." 1768 in that case, this function acts as if `enable-local-variables' were t."
1483 (interactive) 1769 (interactive)
1484 (or find-file (funcall (or default-major-mode 'fundamental-mode))) 1770 (funcall (or default-major-mode 'fundamental-mode))
1485 (condition-case err 1771 (let ((enable-local-variables (or (not find-file) enable-local-variables)))
1486 (set-auto-mode) 1772 (report-errors "File mode specification error: %s"
1487 (error (message "File mode specification error: %s" 1773 (set-auto-mode))
1488 (prin1-to-string err)))) 1774 (report-errors "File local-variables error: %s"
1489 (condition-case err 1775 (hack-local-variables)))
1490 (let ((enable-local-variables (or (not find-file) 1776 ;; Turn font lock off and on, to make sure it takes account of
1491 enable-local-variables))) 1777 ;; whatever file local variables are relevant to it.
1492 (hack-local-variables)) 1778 (when (and font-lock-mode
1493 (error (message "File local-variables error: %s" 1779 ;; Font-lock-mode (now in font-core.el) can be ON when
1494 (prin1-to-string err)))) 1780 ;; font-lock.el still hasn't been loaded.
1781 (boundp 'font-lock-keywords)
1782 (eq (car font-lock-keywords) t))
1783 (setq font-lock-keywords (cadr font-lock-keywords))
1784 (font-lock-mode 1))
1785
1495 (if (fboundp 'ucs-set-table-for-input) ; don't lose when building 1786 (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
1496 (ucs-set-table-for-input))) 1787 (ucs-set-table-for-input)))
1497 1788
1498 (defvar auto-mode-alist 1789 (defvar auto-mode-alist
1790 ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
1791 ;; c++-mode, java-mode and more) are added through autoload
1792 ;; directives in that file. That way is discouraged since it
1793 ;; spreads out the definition of the initial value.
1499 (mapc 1794 (mapc
1500 (lambda (elt) 1795 (lambda (elt)
1501 (cons (purecopy (car elt)) (cdr elt))) 1796 (cons (purecopy (car elt)) (cdr elt)))
1502 '(("\\.te?xt\\'" . text-mode) 1797 `(;; do this first, so that .html.pl is Polish html, not Perl
1503 ("\\.c\\'" . c-mode) 1798 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
1504 ("\\.h\\'" . c-mode) 1799 ("\\.te?xt\\'" . text-mode)
1505 ("\\.tex\\'" . tex-mode) 1800 ("\\.[tT]e[xX]\\'" . tex-mode)
1801 ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
1506 ("\\.ltx\\'" . latex-mode) 1802 ("\\.ltx\\'" . latex-mode)
1803 ("\\.dtx\\'" . doctex-mode)
1507 ("\\.el\\'" . emacs-lisp-mode) 1804 ("\\.el\\'" . emacs-lisp-mode)
1508 ("\\.scm\\'" . scheme-mode) 1805 ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
1509 ("\\.l\\'" . lisp-mode) 1806 ("\\.l\\'" . lisp-mode)
1510 ("\\.lisp\\'" . lisp-mode) 1807 ("\\.li?sp\\'" . lisp-mode)
1511 ("\\.f\\'" . fortran-mode) 1808 ("\\.[fF]\\'" . fortran-mode)
1512 ("\\.F\\'" . fortran-mode)
1513 ("\\.for\\'" . fortran-mode) 1809 ("\\.for\\'" . fortran-mode)
1514 ("\\.p\\'" . pascal-mode) 1810 ("\\.p\\'" . pascal-mode)
1515 ("\\.pas\\'" . pascal-mode) 1811 ("\\.pas\\'" . pascal-mode)
1516 ("\\.ad[abs]\\'" . ada-mode) 1812 ("\\.ad[abs]\\'" . ada-mode)
1517 ("\\.ad[bs].dg\\'" . ada-mode) 1813 ("\\.ad[bs].dg\\'" . ada-mode)
1518 ("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode) 1814 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
1519 ("\\.s?html?\\'" . html-mode) 1815 ,@(if (memq system-type '(berkeley-unix next-mach darwin))
1520 ("\\.cc\\'" . c++-mode) 1816 '(("\\.mk\\'" . makefile-bsdmake-mode)
1521 ("\\.hh\\'" . c++-mode) 1817 ("GNUmakefile\\'" . makefile-gmake-mode)
1522 ("\\.hpp\\'" . c++-mode) 1818 ("[Mm]akefile\\'" . makefile-bsdmake-mode))
1523 ("\\.C\\'" . c++-mode) 1819 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
1524 ("\\.H\\'" . c++-mode) 1820 ("[Mm]akefile\\'" . makefile-gmake-mode)))
1525 ("\\.cpp\\'" . c++-mode) 1821 ("Makeppfile\\'" . makefile-makepp-mode)
1526 ("\\.cxx\\'" . c++-mode) 1822 ("\\.am\\'" . makefile-automake-mode)
1527 ("\\.hxx\\'" . c++-mode)
1528 ("\\.c\\+\\+\\'" . c++-mode)
1529 ("\\.h\\+\\+\\'" . c++-mode)
1530 ("\\.m\\'" . objc-mode)
1531 ("\\.java\\'" . java-mode)
1532 ("\\.mk\\'" . makefile-mode)
1533 ("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
1534 ("\\.am\\'" . makefile-mode) ;For Automake.
1535 ;; Less common extensions come here 1823 ;; Less common extensions come here
1536 ;; so more common ones above are found faster. 1824 ;; so more common ones above are found faster.
1537 ("\\.texinfo\\'" . texinfo-mode) 1825 ("\\.texinfo\\'" . texinfo-mode)
1538 ("\\.te?xi\\'" . texinfo-mode) 1826 ("\\.te?xi\\'" . texinfo-mode)
1539 ("\\.s\\'" . asm-mode) 1827 ("\\.[sS]\\'" . asm-mode)
1540 ("\\.S\\'" . asm-mode)
1541 ("\\.asm\\'" . asm-mode) 1828 ("\\.asm\\'" . asm-mode)
1542 ("ChangeLog\\'" . change-log-mode) 1829 ("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
1543 ("change\\.log\\'" . change-log-mode) 1830 ("[cC]hange[lL]og\\.[0-9]+\\'" . change-log-mode)
1544 ("changelo\\'" . change-log-mode)
1545 ("ChangeLog\\.[0-9]+\\'" . change-log-mode)
1546 ;; for MSDOS and MS-Windows (which are case-insensitive)
1547 ("changelog\\'" . change-log-mode)
1548 ("changelog\\.[0-9]+\\'" . change-log-mode)
1549 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) 1831 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
1550 ("\\.scm\\.[0-9]*\\'" . scheme-mode) 1832 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
1551 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) 1833 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
1552 ("\\.bash\\'" . sh-mode) 1834 ("\\.bash\\'" . sh-mode)
1553 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) 1835 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
1554 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) 1836 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
1555 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) 1837 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
1556 ("\\.m?spec\\'" . sh-mode) 1838 ("\\.m?spec\\'" . sh-mode)
1557 ("\\.mm\\'" . nroff-mode) 1839 ("\\.m[mes]\\'" . nroff-mode)
1558 ("\\.me\\'" . nroff-mode)
1559 ("\\.ms\\'" . nroff-mode)
1560 ("\\.man\\'" . nroff-mode) 1840 ("\\.man\\'" . nroff-mode)
1561 ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
1562 ("\\.TeX\\'" . tex-mode)
1563 ("\\.sty\\'" . latex-mode) 1841 ("\\.sty\\'" . latex-mode)
1564 ("\\.cls\\'" . latex-mode) ;LaTeX 2e class 1842 ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option
1565 ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option
1566 ("\\.bbl\\'" . latex-mode) 1843 ("\\.bbl\\'" . latex-mode)
1567 ("\\.bib\\'" . bibtex-mode) 1844 ("\\.bib\\'" . bibtex-mode)
1568 ("\\.sql\\'" . sql-mode) 1845 ("\\.sql\\'" . sql-mode)
1569 ("\\.m4\\'" . m4-mode) 1846 ("\\.m[4c]\\'" . m4-mode)
1570 ("\\.mc\\'" . m4-mode)
1571 ("\\.mf\\'" . metafont-mode) 1847 ("\\.mf\\'" . metafont-mode)
1572 ("\\.mp\\'" . metapost-mode) 1848 ("\\.mp\\'" . metapost-mode)
1573 ("\\.vhdl?\\'" . vhdl-mode) 1849 ("\\.vhdl?\\'" . vhdl-mode)
1574 ("\\.article\\'" . text-mode) 1850 ("\\.article\\'" . text-mode)
1575 ("\\.letter\\'" . text-mode) 1851 ("\\.letter\\'" . text-mode)
1576 ("\\.tcl\\'" . tcl-mode) 1852 ("\\.i?tcl\\'" . tcl-mode)
1577 ("\\.exp\\'" . tcl-mode) 1853 ("\\.exp\\'" . tcl-mode)
1578 ("\\.itcl\\'" . tcl-mode)
1579 ("\\.itk\\'" . tcl-mode) 1854 ("\\.itk\\'" . tcl-mode)
1580 ("\\.icn\\'" . icon-mode) 1855 ("\\.icn\\'" . icon-mode)
1581 ("\\.sim\\'" . simula-mode) 1856 ("\\.sim\\'" . simula-mode)
1582 ("\\.mss\\'" . scribe-mode) 1857 ("\\.mss\\'" . scribe-mode)
1583 ("\\.f90\\'" . f90-mode) 1858 ("\\.f9[05]\\'" . f90-mode)
1584 ("\\.f95\\'" . f90-mode)
1585 ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode 1859 ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
1586 ("\\.pro\\'" . idlwave-mode) 1860 ("\\.pro\\'" . idlwave-mode)
1587 ("\\.lsp\\'" . lisp-mode)
1588 ("\\.awk\\'" . awk-mode)
1589 ("\\.prolog\\'" . prolog-mode) 1861 ("\\.prolog\\'" . prolog-mode)
1590 ("\\.tar\\'" . tar-mode) 1862 ("\\.tar\\'" . tar-mode)
1591 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode) 1863 ;; The list of archive file extensions should be in sync with
1592 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode) 1864 ;; `auto-coding-alist' with `no-conversion' coding system.
1865 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
1866 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
1593 ("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org 1867 ("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
1594 ;; Mailer puts message to be edited in 1868 ;; Mailer puts message to be edited in
1595 ;; /tmp/Re.... or Message 1869 ;; /tmp/Re.... or Message
1596 ("\\`/tmp/Re" . text-mode) 1870 ("\\`/tmp/Re" . text-mode)
1597 ("/Message[0-9]*\\'" . text-mode) 1871 ("/Message[0-9]*\\'" . text-mode)
1598 ("/drafts/[0-9]+\\'" . mh-letter-mode)
1599 ("\\.zone\\'" . zone-mode) 1872 ("\\.zone\\'" . zone-mode)
1600 ;; some news reader is reported to use this 1873 ;; some news reader is reported to use this
1601 ("\\`/tmp/fol/" . text-mode) 1874 ("\\`/tmp/fol/" . text-mode)
1602 ("\\.y\\'" . c-mode)
1603 ("\\.lex\\'" . c-mode)
1604 ("\\.oak\\'" . scheme-mode) 1875 ("\\.oak\\'" . scheme-mode)
1605 ("\\.sgml?\\'" . sgml-mode) 1876 ("\\.sgml?\\'" . sgml-mode)
1606 ("\\.xml\\'" . sgml-mode) 1877 ("\\.x[ms]l\\'" . xml-mode)
1607 ("\\.dtd\\'" . sgml-mode) 1878 ("\\.dtd\\'" . sgml-mode)
1608 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) 1879 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
1609 ("\\.idl\\'" . idl-mode) 1880 ("\\.js\\'" . java-mode) ; javascript-mode would be better
1881 ("\\.x[bp]m\\'" . c-mode)
1610 ;; .emacs or .gnus or .viper following a directory delimiter in 1882 ;; .emacs or .gnus or .viper following a directory delimiter in
1611 ;; Unix, MSDOG or VMS syntax. 1883 ;; Unix, MSDOG or VMS syntax.
1612 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) 1884 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
1613 ("\\`\\..*emacs\\'" . emacs-lisp-mode) 1885 ("\\`\\..*emacs\\'" . emacs-lisp-mode)
1614 ;; _emacs following a directory delimiter 1886 ;; _emacs following a directory delimiter
1623 ("\\.[eE]?[pP][sS]\\'" . ps-mode) 1895 ("\\.[eE]?[pP][sS]\\'" . ps-mode)
1624 ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) 1896 ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
1625 ("BROWSE\\'" . ebrowse-tree-mode) 1897 ("BROWSE\\'" . ebrowse-tree-mode)
1626 ("\\.ebrowse\\'" . ebrowse-tree-mode) 1898 ("\\.ebrowse\\'" . ebrowse-tree-mode)
1627 ("#\\*mail\\*" . mail-mode) 1899 ("#\\*mail\\*" . mail-mode)
1900 ("\\.g\\'" . antlr-mode)
1901 ("\\.ses\\'" . ses-mode)
1902 ("\\.\\(soa\\|zone\\)\\'" . dns-mode)
1903 ("\\.docbook\\'" . sgml-mode)
1904 ("\\.com\\'" . dcl-mode)
1905 ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
1906 ;; Windows candidates may be opened case sensitively on Unix
1907 ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
1908 ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode)
1909 ("\\.ppd\\'" . conf-ppd-mode)
1910 ("java.+\\.conf\\'" . conf-javaprop-mode)
1911 ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
1912 ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
1913 ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
1914 ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
1915 ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
1916 ;; either user's dot-files or under /etc or some such
1917 ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
1918 ;; alas not all ~/.*rc files are like this
1919 ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
1920 ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
1921 ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
1922 ("/X11.+app-defaults/" . conf-xdefaults-mode)
1923 ("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
1924 ;; this contains everything twice, with space and with colon :-(
1925 ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
1628 ;; Get rid of any trailing .n.m and try again. 1926 ;; Get rid of any trailing .n.m and try again.
1629 ;; This is for files saved by cvs-merge that look like .#<file>.<rev> 1927 ;; This is for files saved by cvs-merge that look like .#<file>.<rev>
1630 ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~. 1928 ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
1631 ;; Using mode nil rather than `ignore' would let the search continue 1929 ;; Using mode nil rather than `ignore' would let the search continue
1632 ;; through this list (with the shortened name) rather than start over. 1930 ;; through this list (with the shortened name) rather than start over.
1633 ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" ignore t) 1931 ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
1634 ;; The following should come after the ChangeLog pattern 1932 ;; The following should come after the ChangeLog pattern
1635 ;; for the sake of ChangeLog.1, etc. 1933 ;; for the sake of ChangeLog.1, etc.
1636 ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too. 1934 ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
1637 ("\\.[1-9]\\'" . nroff-mode) 1935 ("\\.[1-9]\\'" . nroff-mode)
1638 ("\\.g\\'" . antlr-mode) 1936 ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)))
1639 ("\\.ses\\'" . ses-mode)
1640 ("\\.in\\'" nil t)))
1641 "Alist of filename patterns vs corresponding major mode functions. 1937 "Alist of filename patterns vs corresponding major mode functions.
1642 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). 1938 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
1643 \(NON-NIL stands for anything that is not nil; the value does not matter.) 1939 \(NON-NIL stands for anything that is not nil; the value does not matter.)
1644 Visiting a file whose name matches REGEXP specifies FUNCTION as the 1940 Visiting a file whose name matches REGEXP specifies FUNCTION as the
1645 mode function to use. FUNCTION will be called, unless it is nil. 1941 mode function to use. FUNCTION will be called, unless it is nil.
1646 1942
1647 If the element has the form (REGEXP FUNCTION NON-NIL), then after 1943 If the element has the form (REGEXP FUNCTION NON-NIL), then after
1648 calling FUNCTION (if it's not nil), we delete the suffix that matched 1944 calling FUNCTION (if it's not nil), we delete the suffix that matched
1649 REGEXP and search the list again for another match.") 1945 REGEXP and search the list again for another match.
1650 1946
1947 If the file name matches `inhibit-first-line-modes-regexps',
1948 then `auto-mode-alist' is not processed.
1949
1950 See also `interpreter-mode-alist', which detects executable script modes
1951 based on the interpreters they specify to run,
1952 and `magic-mode-alist', which determines modes based on file contents.")
1651 1953
1652 (defvar interpreter-mode-alist 1954 (defvar interpreter-mode-alist
1955 ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
1956 ;; and pike-mode) are added through autoload directives in that
1957 ;; file. That way is discouraged since it spreads out the
1958 ;; definition of the initial value.
1653 (mapc 1959 (mapc
1654 (lambda (l) 1960 (lambda (l)
1655 (cons (purecopy (car l)) (cdr l))) 1961 (cons (purecopy (car l)) (cdr l)))
1656 '(("perl" . perl-mode) 1962 '(("perl" . perl-mode)
1657 ("perl5" . perl-mode) 1963 ("perl5" . perl-mode)
1658 ("miniperl" . perl-mode) 1964 ("miniperl" . perl-mode)
1659 ("wish" . tcl-mode) 1965 ("wish" . tcl-mode)
1660 ("wishx" . tcl-mode) 1966 ("wishx" . tcl-mode)
1661 ("tcl" . tcl-mode) 1967 ("tcl" . tcl-mode)
1662 ("tclsh" . tcl-mode) 1968 ("tclsh" . tcl-mode)
1663 ("awk" . awk-mode)
1664 ("mawk" . awk-mode)
1665 ("nawk" . awk-mode)
1666 ("gawk" . awk-mode)
1667 ("scm" . scheme-mode) 1969 ("scm" . scheme-mode)
1668 ("ash" . sh-mode) 1970 ("ash" . sh-mode)
1669 ("bash" . sh-mode) 1971 ("bash" . sh-mode)
1670 ("bash2" . sh-mode) 1972 ("bash2" . sh-mode)
1671 ("csh" . sh-mode) 1973 ("csh" . sh-mode)
1686 ("zsh" . sh-mode) 1988 ("zsh" . sh-mode)
1687 ("tail" . text-mode) 1989 ("tail" . text-mode)
1688 ("more" . text-mode) 1990 ("more" . text-mode)
1689 ("less" . text-mode) 1991 ("less" . text-mode)
1690 ("pg" . text-mode) 1992 ("pg" . text-mode)
1691 ("make" . makefile-mode) ; Debian uses this 1993 ("make" . makefile-gmake-mode) ; Debian uses this
1692 ("guile" . scheme-mode) 1994 ("guile" . scheme-mode)
1693 ("clisp" . lisp-mode))) 1995 ("clisp" . lisp-mode)))
1694 "Alist mapping interpreter names to major modes. 1996 "Alist mapping interpreter names to major modes.
1695 This alist applies to files whose first line starts with `#!'. 1997 This is used for files whose first lines match `auto-mode-interpreter-regexp'.
1696 Each element looks like (INTERPRETER . MODE). 1998 Each element looks like (INTERPRETER . MODE).
1697 The car of each element is compared with 1999 If INTERPRETER matches the name of the interpreter specified in the first line
1698 the name of the interpreter specified in the first line. 2000 of a script, mode MODE is enabled.
1699 If it matches, mode MODE is selected.") 2001
2002 See also `auto-mode-alist'.")
1700 2003
1701 (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'") 2004 (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
1702 "List of regexps; if one matches a file name, don't look for `-*-'.") 2005 "List of regexps; if one matches a file name, don't look for `-*-'.")
1703 2006
1704 (defvar inhibit-first-line-modes-suffixes nil 2007 (defvar inhibit-first-line-modes-suffixes nil
1707 from the end of the file name anything that matches one of these regexps.") 2010 from the end of the file name anything that matches one of these regexps.")
1708 2011
1709 (defvar auto-mode-interpreter-regexp 2012 (defvar auto-mode-interpreter-regexp
1710 "#![ \t]?\\([^ \t\n]*\ 2013 "#![ \t]?\\([^ \t\n]*\
1711 /bin/env[ \t]\\)?\\([^ \t\n]+\\)" 2014 /bin/env[ \t]\\)?\\([^ \t\n]+\\)"
1712 "Regular expression matching interpreters, for file mode determination. 2015 "Regexp matching interpreters, for file mode determination.
1713 This regular expression is matched against the first line of a file 2016 This regular expression is matched against the first line of a file
1714 to determine the file's mode in `set-auto-mode' when Emacs can't deduce 2017 to determine the file's mode in `set-auto-mode'. If it matches, the file
1715 a mode from the file's name. If it matches, the file is assumed to 2018 is assumed to be interpreted by the interpreter matched by the second group
1716 be interpreted by the interpreter matched by the second group of the 2019 of the regular expression. The mode is then determined as the mode
1717 regular expression. The mode is then determined as the mode associated 2020 associated with that interpreter in `interpreter-mode-alist'.")
1718 with that interpreter in `interpreter-mode-alist'.") 2021
1719 2022 (defvar magic-mode-alist
1720 (defun set-auto-mode (&optional just-from-file-name) 2023 `(;; The < comes before the groups (but the first) to reduce backtracking.
2024 ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
2025 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
2026 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)")))
2027 (concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<"
2028 comment-re "*"
2029 "\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?"
2030 "[Hh][Tt][Mm][Ll]"))
2031 . html-mode)
2032 ;; These two must come after html, because they are more general:
2033 ("<\\?xml " . xml-mode)
2034 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
2035 (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)")))
2036 (concat "\\s *<" comment-re "*!DOCTYPE "))
2037 . sgml-mode)
2038 ("%![^V]" . ps-mode)
2039 ("# xmcd " . conf-unix-mode))
2040 "Alist of buffer beginnings vs. corresponding major mode functions.
2041 Each element looks like (REGEXP . FUNCTION). After visiting a file,
2042 if REGEXP matches the text at the beginning of the buffer,
2043 `normal-mode' will call FUNCTION rather than allowing `auto-mode-alist'
2044 to decide the buffer's major mode.
2045
2046 If FUNCTION is nil, then it is not called. (That is a way of saying
2047 \"allow `auto-mode-alist' to decide for these files.\")")
2048
2049 (defun set-auto-mode (&optional keep-mode-if-same)
1721 "Select major mode appropriate for current buffer. 2050 "Select major mode appropriate for current buffer.
1722 This checks for a -*- mode tag in the buffer's text, 2051
1723 compares the filename against the entries in `auto-mode-alist', 2052 This checks for a -*- mode tag in the buffer's text, checks the
1724 or checks the interpreter that runs this file against 2053 interpreter that runs this file against `interpreter-mode-alist',
1725 `interpreter-mode-alist'. 2054 compares the buffer beginning against `magic-mode-alist', or
2055 compares the filename against the entries in `auto-mode-alist'.
1726 2056
1727 It does not check for the `mode:' local variable in the 2057 It does not check for the `mode:' local variable in the
1728 Local Variables section of the file; for that, use `hack-local-variables'. 2058 Local Variables section of the file; for that, use `hack-local-variables'.
1729 2059
1730 If `enable-local-variables' is nil, this function does not check for a 2060 If `enable-local-variables' is nil, this function does not check for a
1731 -*- mode tag. 2061 -*- mode tag.
1732 2062
1733 If the optional argument JUST-FROM-FILE-NAME is non-nil, 2063 If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
1734 then we do not set anything but the major mode, 2064 only set the major mode, if that would change it."
1735 and we don't even do that unless it would come from the file name."
1736 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- 2065 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
1737 (let (end done modes) 2066 (let (end done mode modes)
2067 ;; Find a -*- mode tag
1738 (save-excursion 2068 (save-excursion
1739 (goto-char (point-min)) 2069 (goto-char (point-min))
1740 (skip-chars-forward " \t\n") 2070 (skip-chars-forward " \t\n")
1741 (and enable-local-variables 2071 (and enable-local-variables
1742 (setq end (set-auto-mode-1)) 2072 (setq end (set-auto-mode-1))
1757 modes))) 2087 modes)))
1758 ;; Simple -*-MODE-*- case. 2088 ;; Simple -*-MODE-*- case.
1759 (push (intern (concat (downcase (buffer-substring (point) end)) 2089 (push (intern (concat (downcase (buffer-substring (point) end))
1760 "-mode")) 2090 "-mode"))
1761 modes)))) 2091 modes))))
1762 ;; If we found modes to use, invoke them now, 2092 ;; If we found modes to use, invoke them now, outside the save-excursion.
1763 ;; outside the save-excursion. 2093 (if modes
1764 (unless just-from-file-name 2094 (catch 'nop
1765 (dolist (mode (nreverse modes)) 2095 (dolist (mode (nreverse modes))
1766 (if (not (functionp mode)) 2096 (if (not (functionp mode))
1767 (message "Ignoring unknown mode `%s'" mode) 2097 (message "Ignoring unknown mode `%s'" mode)
1768 (setq done t) 2098 (setq done t)
1769 (funcall mode)))) 2099 (or (set-auto-mode-0 mode keep-mode-if-same)
1770 ;; If we didn't find a mode from a -*- line, try using the file name. 2100 ;; continuing would call minor modes again, toggling them off
1771 (if (and (not done) buffer-file-name) 2101 (throw 'nop nil))))))
1772 (let ((name buffer-file-name) 2102 (unless done
1773 (keep-going t)) 2103 ;; If we didn't, look for an interpreter specified in the first line.
1774 ;; Remove backup-suffixes from file name. 2104 ;; As a special case, allow for things like "#!/bin/env perl", which
1775 (setq name (file-name-sans-versions name)) 2105 ;; finds the interpreter anywhere in $PATH.
1776 (while keep-going 2106 (setq mode (save-excursion
1777 (setq keep-going nil) 2107 (goto-char (point-min))
1778 (let ((alist auto-mode-alist) 2108 (if (looking-at auto-mode-interpreter-regexp)
1779 (mode nil)) 2109 (match-string 2)
1780 ;; Find first matching alist entry. 2110 ""))
1781 (let ((case-fold-search 2111 ;; Map interpreter name to a mode, signalling we're done at the
1782 (memq system-type '(vax-vms windows-nt cygwin)))) 2112 ;; same time.
1783 (while (and (not mode) alist) 2113 done (assoc (file-name-nondirectory mode)
1784 (if (string-match (car (car alist)) name) 2114 interpreter-mode-alist))
1785 (if (and (consp (cdr (car alist))) 2115 ;; If we found an interpreter mode to use, invoke it now.
1786 (nth 2 (car alist))) 2116 (if done
1787 (setq mode (car (cdr (car alist))) 2117 (set-auto-mode-0 (cdr done) keep-mode-if-same)))
1788 name (substring name 0 (match-beginning 0)) 2118 ;; If we didn't, match the buffer beginning against magic-mode-alist.
1789 keep-going t) 2119 (unless done
1790 (setq mode (cdr (car alist)) 2120 (if (setq done (save-excursion
1791 keep-going nil))) 2121 (goto-char (point-min))
1792 (setq alist (cdr alist)))) 2122 (assoc-default nil magic-mode-alist
1793 (if mode 2123 (lambda (re dummy)
1794 ;; When JUST-FROM-FILE-NAME is set, 2124 (looking-at re)))))
1795 ;; we are working on behalf of set-visited-file-name. 2125 (set-auto-mode-0 done keep-mode-if-same)
1796 ;; In that case, if the major mode specified is the 2126 ;; Compare the filename against the entries in auto-mode-alist.
1797 ;; same one we already have, don't actually reset it. 2127 (if buffer-file-name
1798 ;; We don't want to lose minor modes such as Font Lock. 2128 (let ((name buffer-file-name))
1799 (unless (and just-from-file-name (eq mode major-mode)) 2129 ;; Remove backup-suffixes from file name.
1800 (funcall mode)) 2130 (setq name (file-name-sans-versions name))
1801 ;; If we can't deduce a mode from the file name, 2131 (while name
1802 ;; look for an interpreter specified in the first line. 2132 ;; Find first matching alist entry.
1803 ;; As a special case, allow for things like "#!/bin/env perl", 2133 (let ((case-fold-search
1804 ;; which finds the interpreter anywhere in $PATH. 2134 (memq system-type '(vax-vms windows-nt cygwin))))
1805 (let ((interpreter 2135 (if (and (setq mode (assoc-default name auto-mode-alist
1806 (save-excursion 2136 'string-match))
1807 (goto-char (point-min)) 2137 (consp mode)
1808 (if (looking-at auto-mode-interpreter-regexp) 2138 (cadr mode))
1809 (match-string 2) 2139 (setq mode (car mode)
1810 ""))) 2140 name (substring name 0 (match-beginning 0)))
1811 elt) 2141 (setq name)))
1812 ;; Map interpreter name to a mode. 2142 (when mode
1813 (setq elt (assoc (file-name-nondirectory interpreter) 2143 (set-auto-mode-0 mode keep-mode-if-same)))))))))
1814 interpreter-mode-alist)) 2144
1815 (unless just-from-file-name 2145 ;; When `keep-mode-if-same' is set, we are working on behalf of
1816 (if elt 2146 ;; set-visited-file-name. In that case, if the major mode specified is the
1817 (funcall (cdr elt)))))))))))) 2147 ;; same one we already have, don't actually reset it. We don't want to lose
1818 2148 ;; minor modes such as Font Lock.
2149 (defun set-auto-mode-0 (mode &optional keep-mode-if-same)
2150 "Apply MODE and return it.
2151 If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
2152 any aliases and compared to current major mode. If they are the
2153 same, do nothing and return nil."
2154 (when keep-mode-if-same
2155 (while (symbolp (symbol-function mode))
2156 (setq mode (symbol-function mode)))
2157 (if (eq mode major-mode)
2158 (setq mode nil)))
2159 (when mode
2160 (funcall mode)
2161 mode))
1819 2162
1820 (defun set-auto-mode-1 () 2163 (defun set-auto-mode-1 ()
1821 "Find the -*- spec in the buffer. 2164 "Find the -*- spec in the buffer.
1822 Call with point at the place to start searching from. 2165 Call with point at the place to start searching from.
1823 If one is found, set point to the beginning 2166 If one is found, set point to the beginning
1839 (while (and temp 2182 (while (and temp
1840 (not (string-match (car temp) name))) 2183 (not (string-match (car temp) name)))
1841 (setq temp (cdr temp))) 2184 (setq temp (cdr temp)))
1842 (not temp)) 2185 (not temp))
1843 2186
1844 (search-forward "-*-" (save-excursion 2187 (search-forward "-*-" (line-end-position
1845 ;; If the file begins with "#!" 2188 ;; If the file begins with "#!"
1846 ;; (exec interpreter magic), look 2189 ;; (exec interpreter magic), look
1847 ;; for mode frobs in the first two 2190 ;; for mode frobs in the first two
1848 ;; lines. You cannot necessarily 2191 ;; lines. You cannot necessarily
1849 ;; put them in the first line of 2192 ;; put them in the first line of
1850 ;; such a file without screwing up 2193 ;; such a file without screwing up
1851 ;; the interpreter invocation. 2194 ;; the interpreter invocation.
1852 (end-of-line (and (looking-at "^#!") 2)) 2195 (and (looking-at "^#!") 2)) t)
1853 (point)) t)
1854 (progn 2196 (progn
1855 (skip-chars-forward " \t") 2197 (skip-chars-forward " \t")
1856 (setq beg (point)) 2198 (setq beg (point))
1857 (search-forward "-*-" 2199 (search-forward "-*-" (line-end-position) t))
1858 (save-excursion (end-of-line) (point))
1859 t))
1860 (progn 2200 (progn
1861 (forward-char -3) 2201 (forward-char -3)
1862 (skip-chars-backward " \t") 2202 (skip-chars-backward " \t")
1863 (setq end (point)) 2203 (setq end (point))
1864 (goto-char beg) 2204 (goto-char beg)
1865 end)))) 2205 end))))
1866 2206
1867 (defun hack-local-variables-prop-line () 2207 (defun hack-local-variables-confirm (string flag-to-check)
2208 (or (eq flag-to-check t)
2209 (and flag-to-check
2210 (save-window-excursion
2211 (condition-case nil
2212 (switch-to-buffer (current-buffer))
2213 (error
2214 ;; If we fail to switch in the selected window,
2215 ;; it is probably a minibuffer or dedicated window.
2216 ;; So try another window.
2217 (let ((pop-up-frames nil))
2218 ;; Refrain from popping up frames since it can't
2219 ;; be undone by save-window-excursion.
2220 (pop-to-buffer (current-buffer)))))
2221 (save-excursion
2222 (beginning-of-line)
2223 (set-window-start (selected-window) (point)))
2224 (y-or-n-p (format string
2225 (if buffer-file-name
2226 (file-name-nondirectory buffer-file-name)
2227 (concat "buffer " (buffer-name)))))))))
2228
2229 (defun hack-local-variables-prop-line (&optional mode-only)
1868 "Set local variables specified in the -*- line. 2230 "Set local variables specified in the -*- line.
1869 Ignore any specification for `mode:' and `coding:'; 2231 Ignore any specification for `mode:' and `coding:';
1870 `set-auto-mode' should already have handled `mode:', 2232 `set-auto-mode' should already have handled `mode:',
1871 `set-auto-coding' should already have handled `coding:'." 2233 `set-auto-coding' should already have handled `coding:'.
2234 If MODE-ONLY is non-nil, all we do is check whether the major mode
2235 is specified, returning t if it is specified."
1872 (save-excursion 2236 (save-excursion
1873 (goto-char (point-min)) 2237 (goto-char (point-min))
1874 (let ((result nil) 2238 (let ((result nil)
1875 (end (set-auto-mode-1)) 2239 (end (set-auto-mode-1))
2240 mode-specified
1876 (enable-local-variables 2241 (enable-local-variables
1877 (and local-enable-local-variables enable-local-variables))) 2242 (and local-enable-local-variables enable-local-variables)))
1878 ;; Parse the -*- line into the `result' alist. 2243 ;; Parse the -*- line into the RESULT alist.
2244 ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
1879 (cond ((not end) 2245 (cond ((not end)
1880 nil) 2246 nil)
1881 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") 2247 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
1882 ;; Simple form: "-*- MODENAME -*-". Already handled. 2248 ;; Simple form: "-*- MODENAME -*-". Already handled.
2249 (setq mode-specified t)
1883 nil) 2250 nil)
1884 (t 2251 (t
1885 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' 2252 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
1886 ;; (last ";" is optional). 2253 ;; (last ";" is optional).
1887 (while (< (point) end) 2254 (while (< (point) end)
1903 ;; That is inconsistent, but we're stuck with it. 2270 ;; That is inconsistent, but we're stuck with it.
1904 ;; The same can be said for `coding' in set-auto-coding. 2271 ;; The same can be said for `coding' in set-auto-coding.
1905 (or (equal (downcase (symbol-name key)) "mode") 2272 (or (equal (downcase (symbol-name key)) "mode")
1906 (equal (downcase (symbol-name key)) "coding") 2273 (equal (downcase (symbol-name key)) "coding")
1907 (setq result (cons (cons key val) result))) 2274 (setq result (cons (cons key val) result)))
2275 (if (equal (downcase (symbol-name key)) "mode")
2276 (setq mode-specified t))
1908 (skip-chars-forward " \t;"))) 2277 (skip-chars-forward " \t;")))
1909 (setq result (nreverse result)))) 2278 (setq result (nreverse result))))
1910 2279
1911 (if (and result 2280 (if mode-only mode-specified
1912 (or (eq enable-local-variables t) 2281 (if (and result
1913 (and enable-local-variables 2282 (or mode-only
1914 (save-window-excursion 2283 (hack-local-variables-confirm
1915 (condition-case nil 2284 "Set local variables as specified in -*- line of %s? "
1916 (switch-to-buffer (current-buffer)) 2285 enable-local-variables)))
1917 (error 2286 (let ((enable-local-eval enable-local-eval))
1918 ;; If we fail to switch in the selected window, 2287 (while result
1919 ;; it is probably a minibuffer. 2288 (hack-one-local-variable (car (car result)) (cdr (car result)))
1920 ;; So try another window. 2289 (setq result (cdr result)))))
1921 (condition-case nil 2290 nil))))
1922 (switch-to-buffer-other-window (current-buffer))
1923 (error
1924 (switch-to-buffer-other-frame (current-buffer))))))
1925 (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
1926 (file-name-nondirectory buffer-file-name)))))))
1927 (let ((enable-local-eval enable-local-eval))
1928 (while result
1929 (hack-one-local-variable (car (car result)) (cdr (car result)))
1930 (setq result (cdr result))))))))
1931 2291
1932 (defvar hack-local-variables-hook nil 2292 (defvar hack-local-variables-hook nil
1933 "Normal hook run after processing a file's local variables specs. 2293 "Normal hook run after processing a file's local variables specs.
1934 Major modes can use this to examine user-specified local variables 2294 Major modes can use this to examine user-specified local variables
1935 in order to initialize other data structure based on them.") 2295 in order to initialize other data structure based on them.")
1936 2296
1937 (defun hack-local-variables (&optional mode-only) 2297 (defun hack-local-variables (&optional mode-only)
1938 "Parse and put into effect this buffer's local variables spec. 2298 "Parse and put into effect this buffer's local variables spec.
1939 If MODE-ONLY is non-nil, all we do is check whether the major mode 2299 If MODE-ONLY is non-nil, all we do is check whether the major mode
1940 is specified, returning t if it is specified." 2300 is specified, returning t if it is specified."
1941 (unless mode-only 2301 (let ((mode-specified
1942 (hack-local-variables-prop-line)) 2302 ;; If MODE-ONLY is t, we check here for specifying the mode
1943 ;; Look for "Local variables:" line in last page. 2303 ;; in the -*- line. If MODE-ONLY is nil, we process
1944 (let (mode-specified 2304 ;; the -*- line here.
2305 (hack-local-variables-prop-line mode-only))
1945 (enable-local-variables 2306 (enable-local-variables
1946 (and local-enable-local-variables enable-local-variables))) 2307 (and local-enable-local-variables enable-local-variables)))
2308 ;; Look for "Local variables:" line in last page.
1947 (save-excursion 2309 (save-excursion
1948 (goto-char (point-max)) 2310 (goto-char (point-max))
1949 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) 2311 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
1950 (if (let ((case-fold-search t)) 2312 (when (let ((case-fold-search t))
1951 (and (search-forward "Local Variables:" nil t) 2313 (and (search-forward "Local Variables:" nil t)
1952 (or (eq enable-local-variables t) 2314 (or mode-only
1953 mode-only 2315 (hack-local-variables-confirm
1954 (and enable-local-variables 2316 "Set local variables as specified at end of %s? "
1955 (save-window-excursion 2317 enable-local-variables))))
1956 (switch-to-buffer (current-buffer)) 2318 (skip-chars-forward " \t")
1957 (save-excursion 2319 (let ((enable-local-eval enable-local-eval)
1958 (beginning-of-line) 2320 ;; suffix is what comes after "local variables:" in its line.
1959 (set-window-start (selected-window) (point))) 2321 (suffix
1960 (y-or-n-p (format "Set local variables as specified at end of %s? " 2322 (concat
1961 (if buffer-file-name 2323 (regexp-quote (buffer-substring (point) (line-end-position)))
1962 (file-name-nondirectory 2324 "$"))
1963 buffer-file-name) 2325 ;; prefix is what comes before "local variables:" in its line.
1964 (concat "buffer " 2326 (prefix
1965 (buffer-name)))))))))) 2327 (concat "^" (regexp-quote
1966 (let ((continue t) 2328 (buffer-substring (line-beginning-position)
1967 prefix prefixlen suffix beg 2329 (match-beginning 0)))))
1968 mode-specified 2330 beg)
1969 (enable-local-eval enable-local-eval)) 2331
1970 ;; The prefix is what comes before "local variables:" in its line. 2332 (forward-line 1)
1971 ;; The suffix is what comes after "local variables:" in its line. 2333 (let ((startpos (point))
1972 (skip-chars-forward " \t") 2334 endpos
1973 (or (eolp) 2335 (thisbuf (current-buffer)))
1974 (setq suffix (buffer-substring (point) 2336 (save-excursion
1975 (progn (end-of-line) (point))))) 2337 (unless (let ((case-fold-search t))
1976 (goto-char (match-beginning 0)) 2338 (re-search-forward
1977 (or (bolp) 2339 (concat prefix "[ \t]*End:[ \t]*" suffix)
1978 (setq prefix 2340 nil t))
1979 (buffer-substring (point) 2341 (error "Local variables list is not properly terminated"))
1980 (progn (beginning-of-line) (point))))) 2342 (beginning-of-line)
1981 2343 (setq endpos (point)))
1982 (if prefix (setq prefixlen (length prefix) 2344
1983 prefix (regexp-quote prefix))) 2345 (with-temp-buffer
1984 (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) 2346 (insert-buffer-substring thisbuf startpos endpos)
1985 (while continue 2347 (goto-char (point-min))
1986 ;; Look at next local variable spec. 2348 (subst-char-in-region (point) (point-max) ?\^m ?\n)
1987 (if selective-display (re-search-forward "[\n\C-m]") 2349 (while (not (eobp))
2350 ;; Discard the prefix.
2351 (if (looking-at prefix)
2352 (delete-region (point) (match-end 0))
2353 (error "Local variables entry is missing the prefix"))
2354 (end-of-line)
2355 ;; Discard the suffix.
2356 (if (looking-back suffix)
2357 (delete-region (match-beginning 0) (point))
2358 (error "Local variables entry is missing the suffix"))
1988 (forward-line 1)) 2359 (forward-line 1))
1989 ;; Skip the prefix, if any. 2360 (goto-char (point-min))
1990 (if prefix 2361
1991 (if (looking-at prefix) 2362 (while (not (eobp))
1992 (forward-char prefixlen) 2363 ;; Find the variable name; strip whitespace.
1993 (error "Local variables entry is missing the prefix"))) 2364 (skip-chars-forward " \t")
1994 ;; Find the variable name; strip whitespace. 2365 (setq beg (point))
1995 (skip-chars-forward " \t") 2366 (skip-chars-forward "^:\n")
1996 (setq beg (point)) 2367 (if (eolp) (error "Missing colon in local variables entry"))
1997 (skip-chars-forward "^:\n") 2368 (skip-chars-backward " \t")
1998 (if (eolp) (error "Missing colon in local variables entry")) 2369 (let* ((str (buffer-substring beg (point)))
1999 (skip-chars-backward " \t") 2370 (var (read str))
2000 (let* ((str (buffer-substring beg (point))) 2371 val)
2001 (var (read str)) 2372 ;; Read the variable value.
2002 val)
2003 ;; Setting variable named "end" means end of list.
2004 (if (string-equal (downcase str) "end")
2005 (setq continue nil)
2006 ;; Otherwise read the variable value.
2007 (skip-chars-forward "^:") 2373 (skip-chars-forward "^:")
2008 (forward-char 1) 2374 (forward-char 1)
2009 (setq val (read (current-buffer))) 2375 (setq val (read (current-buffer)))
2010 (skip-chars-backward "\n")
2011 (skip-chars-forward " \t")
2012 (or (if suffix (looking-at suffix) (eolp))
2013 (error "Local variables entry is terminated incorrectly"))
2014 (if mode-only 2376 (if mode-only
2015 (if (eq var 'mode) 2377 (if (eq var 'mode)
2016 (setq mode-specified t)) 2378 (setq mode-specified t))
2017 ;; Set the variable. "Variables" mode and eval are funny. 2379 ;; Set the variable. "Variables" mode and eval are funny.
2018 (hack-one-local-variable var val)))))))) 2380 (with-current-buffer thisbuf
2381 (hack-one-local-variable var val))))
2382 (forward-line 1)))))))
2019 (unless mode-only 2383 (unless mode-only
2020 (run-hooks 'hack-local-variables-hook)) 2384 (run-hooks 'hack-local-variables-hook))
2021 mode-specified)) 2385 mode-specified))
2022 2386
2023 (defvar ignored-local-variables 2387 (defvar ignored-local-variables ()
2024 '(enable-local-eval)
2025 "Variables to be ignored in a file's local variable spec.") 2388 "Variables to be ignored in a file's local variable spec.")
2026 2389
2027 ;; Get confirmation before setting these variables as locals in a file. 2390 ;; Get confirmation before setting these variables as locals in a file.
2028 (put 'debugger 'risky-local-variable t) 2391 (put 'debugger 'risky-local-variable t)
2029 (put 'enable-local-eval 'risky-local-variable t) 2392 (put 'enable-local-eval 'risky-local-variable t)
2060 (put 'icon-title-format 'risky-local-variable t) 2423 (put 'icon-title-format 'risky-local-variable t)
2061 (put 'input-method-alist 'risky-local-variable t) 2424 (put 'input-method-alist 'risky-local-variable t)
2062 (put 'format-alist 'risky-local-variable t) 2425 (put 'format-alist 'risky-local-variable t)
2063 (put 'vc-mode 'risky-local-variable t) 2426 (put 'vc-mode 'risky-local-variable t)
2064 (put 'imenu-generic-expression 'risky-local-variable t) 2427 (put 'imenu-generic-expression 'risky-local-variable t)
2065 (put 'imenu-index-alist 'risky-local-variable t) 2428 (put 'imenu--index-alist 'risky-local-variable t)
2066 (put 'standard-input 'risky-local-variable t) 2429 (put 'standard-input 'risky-local-variable t)
2067 (put 'standard-output 'risky-local-variable t) 2430 (put 'standard-output 'risky-local-variable t)
2068 (put 'unread-command-events 'risky-local-variable t) 2431 (put 'unread-command-events 'risky-local-variable t)
2069 (put 'max-lisp-eval-depth 'risky-local-variable t) 2432 (put 'max-lisp-eval-depth 'risky-local-variable t)
2070 (put 'max-specpdl-size 'risky-local-variable t) 2433 (put 'max-specpdl-size 'risky-local-variable t)
2080 (put 'parse-time-rules 'risky-local-variable t) 2443 (put 'parse-time-rules 'risky-local-variable t)
2081 2444
2082 ;; This case is safe because the user gets to check it before it is used. 2445 ;; This case is safe because the user gets to check it before it is used.
2083 (put 'compile-command 'safe-local-variable 'stringp) 2446 (put 'compile-command 'safe-local-variable 'stringp)
2084 2447
2085 (defun risky-local-variable-p (sym val) 2448 (defun risky-local-variable-p (sym &optional val)
2086 "Non-nil if SYM could be dangerous as a file-local variable with value VAL. 2449 "Non-nil if SYM could be dangerous as a file-local variable with value VAL.
2087 If VAL is nil, the question is whether any value might be dangerous." 2450 If VAL is nil or omitted, the question is whether any value might be
2451 dangerous."
2088 (let ((safep (get sym 'safe-local-variable))) 2452 (let ((safep (get sym 'safe-local-variable)))
2089 (or (memq sym ignored-local-variables) 2453 (or (get sym 'risky-local-variable)
2090 (get sym 'risky-local-variable) 2454 (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
2091 (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
2092 (symbol-name sym)) 2455 (symbol-name sym))
2093 (not safep)) 2456 (not safep))
2094 ;; If the safe-local-variable property isn't t or nil, 2457 ;; If the safe-local-variable property isn't t or nil,
2095 ;; then it must return non-nil on the proposed value to be safe. 2458 ;; then it must return non-nil on the proposed value to be safe.
2096 (and (not (memq safep '(t nil))) 2459 (and (not (memq safep '(t nil)))
2101 "*Expressions that are considered \"safe\" in an `eval:' local variable. 2464 "*Expressions that are considered \"safe\" in an `eval:' local variable.
2102 Add expressions to this list if you want Emacs to evaluate them, when 2465 Add expressions to this list if you want Emacs to evaluate them, when
2103 they appear in an `eval' local variable specification, without first 2466 they appear in an `eval' local variable specification, without first
2104 asking you for confirmation." 2467 asking you for confirmation."
2105 :group 'find-file 2468 :group 'find-file
2106 :version "21.4" 2469 :version "22.1"
2107 :type '(repeat sexp)) 2470 :type '(repeat sexp))
2108 2471
2109 (put 'c-set-style 'safe-local-eval-function t) 2472 (put 'c-set-style 'safe-local-eval-function t)
2110 2473
2111 (defun hack-one-local-variable-quotep (exp) 2474 (defun hack-one-local-variable-quotep (exp)
2159 (funcall (intern (concat (downcase (symbol-name val)) 2522 (funcall (intern (concat (downcase (symbol-name val))
2160 "-mode")))) 2523 "-mode"))))
2161 ((eq var 'coding) 2524 ((eq var 'coding)
2162 ;; We have already handled coding: tag in set-auto-coding. 2525 ;; We have already handled coding: tag in set-auto-coding.
2163 nil) 2526 nil)
2527 ((memq var ignored-local-variables)
2528 nil)
2164 ;; "Setting" eval means either eval it or do nothing. 2529 ;; "Setting" eval means either eval it or do nothing.
2165 ;; Likewise for setting hook variables. 2530 ;; Likewise for setting hook variables.
2166 ((risky-local-variable-p var val) 2531 ((risky-local-variable-p var val)
2167 ;; Permit evalling a put of a harmless property. 2532 ;; Permit evalling a put of a harmless property.
2168 ;; if the args do nothing tricky. 2533 ;; if the args do nothing tricky.
2169 (if (or (and (eq var 'eval) 2534 (if (or (and (eq var 'eval)
2170 (hack-one-local-variable-eval-safep val)) 2535 (hack-one-local-variable-eval-safep val))
2171 ;; Permit eval if not root and user says ok. 2536 ;; Permit eval if not root and user says ok.
2172 (and (not (zerop (user-uid))) 2537 (and (not (zerop (user-uid)))
2173 (or (eq enable-local-eval t) 2538 (hack-local-variables-confirm
2174 (and enable-local-eval 2539 "Process `eval' or hook local variables in %s? "
2175 (save-window-excursion 2540 enable-local-eval)))
2176 (switch-to-buffer (current-buffer))
2177 (save-excursion
2178 (beginning-of-line)
2179 (set-window-start (selected-window) (point)))
2180 (setq enable-local-eval
2181 (y-or-n-p (format "Process `eval' or hook local variables in %s? "
2182 (if buffer-file-name
2183 (concat "file " (file-name-nondirectory buffer-file-name))
2184 (concat "buffer " (buffer-name)))))))))))
2185 (if (eq var 'eval) 2541 (if (eq var 'eval)
2186 (save-excursion (eval val)) 2542 (save-excursion (eval val))
2187 (make-local-variable var) 2543 (make-local-variable var)
2188 (set var val)) 2544 (set var val))
2189 (message "Ignoring risky spec in the local variables list"))) 2545 (message "Ignoring risky spec in the local variables list")))
2207 :type 'boolean 2563 :type 'boolean
2208 :group 'editing-basics) 2564 :group 'editing-basics)
2209 2565
2210 (defun set-visited-file-name (filename &optional no-query along-with-file) 2566 (defun set-visited-file-name (filename &optional no-query along-with-file)
2211 "Change name of file visited in current buffer to FILENAME. 2567 "Change name of file visited in current buffer to FILENAME.
2568 This also renames the buffer to correspond to the new file.
2212 The next time the buffer is saved it will go in the newly specified file. 2569 The next time the buffer is saved it will go in the newly specified file.
2213 nil or empty string as argument means make buffer not be visiting any file. 2570 FILENAME nil or an empty string means mark buffer as not visiting any file.
2214 Remember to delete the initial contents of the minibuffer 2571 Remember to delete the initial contents of the minibuffer
2215 if you wish to pass an empty string as the argument. 2572 if you wish to pass an empty string as the argument.
2216 2573
2217 The optional second argument NO-QUERY, if non-nil, inhibits asking for 2574 The optional second argument NO-QUERY, if non-nil, inhibits asking for
2218 confirmation in the case where another buffer is already visiting FILENAME. 2575 confirmation in the case where another buffer is already visiting FILENAME.
2231 (if filename 2588 (if filename
2232 (progn 2589 (progn
2233 (setq truename (file-truename filename)) 2590 (setq truename (file-truename filename))
2234 (if find-file-visit-truename 2591 (if find-file-visit-truename
2235 (setq filename truename)))) 2592 (setq filename truename))))
2593 (if filename
2594 (let ((new-name (file-name-nondirectory filename)))
2595 (if (string= new-name "")
2596 (error "Empty file name"))))
2236 (let ((buffer (and filename (find-buffer-visiting filename)))) 2597 (let ((buffer (and filename (find-buffer-visiting filename))))
2237 (and buffer (not (eq buffer (current-buffer))) 2598 (and buffer (not (eq buffer (current-buffer)))
2238 (not no-query) 2599 (not no-query)
2239 (not (y-or-n-p (message "A buffer is visiting %s; proceed? " 2600 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
2240 filename))) 2601 filename)))
2244 (and filename (lock-buffer filename)) 2605 (and filename (lock-buffer filename))
2245 (unlock-buffer))) 2606 (unlock-buffer)))
2246 (setq buffer-file-name filename) 2607 (setq buffer-file-name filename)
2247 (if filename ; make buffer name reflect filename. 2608 (if filename ; make buffer name reflect filename.
2248 (let ((new-name (file-name-nondirectory buffer-file-name))) 2609 (let ((new-name (file-name-nondirectory buffer-file-name)))
2249 (if (string= new-name "")
2250 (error "Empty file name"))
2251 (if (eq system-type 'vax-vms) 2610 (if (eq system-type 'vax-vms)
2252 (setq new-name (downcase new-name))) 2611 (setq new-name (downcase new-name)))
2253 (setq default-directory (file-name-directory buffer-file-name)) 2612 (setq default-directory (file-name-directory buffer-file-name))
2613 ;; If new-name == old-name, renaming would add a spurious <2>
2614 ;; and it's considered as a feature in rename-buffer.
2254 (or (string= new-name (buffer-name)) 2615 (or (string= new-name (buffer-name))
2255 (rename-buffer new-name t)))) 2616 (rename-buffer new-name t))))
2256 (setq buffer-backed-up nil) 2617 (setq buffer-backed-up nil)
2257 (or along-with-file 2618 (or along-with-file
2258 (clear-visited-file-modtime)) 2619 (clear-visited-file-modtime))
2259 ;; Abbreviate the file names of the buffer. 2620 ;; Abbreviate the file names of the buffer.
2260 (if truename 2621 (if truename
2261 (progn 2622 (progn
2262 (setq buffer-file-truename (abbreviate-file-name truename)) 2623 (setq buffer-file-truename (abbreviate-file-name truename))
2263 (if find-file-visit-truename 2624 (if find-file-visit-truename
2264 (setq buffer-file-name buffer-file-truename)))) 2625 (setq buffer-file-name truename))))
2265 (setq buffer-file-number 2626 (setq buffer-file-number
2266 (if filename 2627 (if filename
2267 (nthcdr 10 (file-attributes buffer-file-name)) 2628 (nthcdr 10 (file-attributes buffer-file-name))
2268 nil))) 2629 nil)))
2269 ;; write-file-functions is normally used for things like ftp-find-file 2630 ;; write-file-functions is normally used for things like ftp-find-file
2318 "Write current buffer into file FILENAME. 2679 "Write current buffer into file FILENAME.
2319 This makes the buffer visit that file, and marks it as not modified. 2680 This makes the buffer visit that file, and marks it as not modified.
2320 2681
2321 If you specify just a directory name as FILENAME, that means to use 2682 If you specify just a directory name as FILENAME, that means to use
2322 the default file name but in that directory. You can also yank 2683 the default file name but in that directory. You can also yank
2323 the default file name into the minibuffer to edit it, using M-n. 2684 the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
2324 2685
2325 If the buffer is not already visiting a file, the default file name 2686 If the buffer is not already visiting a file, the default file name
2326 for the output file is the buffer name. 2687 for the output file is the buffer name.
2327 2688
2328 If optional second arg CONFIRM is non-nil, this function 2689 If optional second arg CONFIRM is non-nil, this function
2355 (set-buffer-modified-p t) 2716 (set-buffer-modified-p t)
2356 ;; Make buffer writable if file is writable. 2717 ;; Make buffer writable if file is writable.
2357 (and buffer-file-name 2718 (and buffer-file-name
2358 (file-writable-p buffer-file-name) 2719 (file-writable-p buffer-file-name)
2359 (setq buffer-read-only nil)) 2720 (setq buffer-read-only nil))
2360 (save-buffer)) 2721 (save-buffer)
2722 ;; It's likely that the VC status at the new location is different from
2723 ;; the one at the old location.
2724 (vc-find-file-hook))
2361 2725
2362 (defun backup-buffer () 2726 (defun backup-buffer ()
2363 "Make a backup of the disk file visited by the current buffer, if appropriate. 2727 "Make a backup of the disk file visited by the current buffer, if appropriate.
2364 This is normally done before saving the buffer the first time. 2728 This is normally done before saving the buffer the first time.
2365 2729
2405 (if (or file-precious-flag 2769 (if (or file-precious-flag
2406 ; (file-symlink-p buffer-file-name) 2770 ; (file-symlink-p buffer-file-name)
2407 backup-by-copying 2771 backup-by-copying
2408 ;; Don't rename a suid or sgid file. 2772 ;; Don't rename a suid or sgid file.
2409 (and modes (< 0 (logand modes #o6000))) 2773 (and modes (< 0 (logand modes #o6000)))
2774 (not (file-writable-p (file-name-directory real-file-name)))
2410 (and backup-by-copying-when-linked 2775 (and backup-by-copying-when-linked
2411 (> (file-nlinks real-file-name) 1)) 2776 (> (file-nlinks real-file-name) 1))
2412 (and (or backup-by-copying-when-mismatch 2777 (and (or backup-by-copying-when-mismatch
2413 (integerp backup-by-copying-when-privileged-mismatch)) 2778 (integerp backup-by-copying-when-privileged-mismatch))
2414 (let ((attr (file-attributes real-file-name))) 2779 (let ((attr (file-attributes real-file-name)))
2441 (setq targets (cdr targets)))) 2806 (setq targets (cdr targets))))
2442 setmodes) 2807 setmodes)
2443 (file-error nil)))))) 2808 (file-error nil))))))
2444 2809
2445 (defun backup-buffer-copy (from-name to-name modes) 2810 (defun backup-buffer-copy (from-name to-name modes)
2446 (condition-case () 2811 (let ((umask (default-file-modes)))
2447 (copy-file from-name to-name t t) 2812 (unwind-protect
2448 (file-error 2813 (progn
2449 ;; If copying fails because file TO-NAME 2814 ;; Create temp files with strict access rights. It's easy to
2450 ;; is not writable, delete that file and try again. 2815 ;; loosen them later, whereas it's impossible to close the
2451 (if (and (file-exists-p to-name) 2816 ;; time-window of loose permissions otherwise.
2452 (not (file-writable-p to-name))) 2817 (set-default-file-modes ?\700)
2453 (delete-file to-name)) 2818 (while (condition-case ()
2454 (copy-file from-name to-name t t))) 2819 (progn
2455 (set-file-modes to-name (logand modes #o1777))) 2820 (condition-case nil
2821 (delete-file to-name)
2822 (file-error nil))
2823 (copy-file from-name to-name t t 'excl)
2824 nil)
2825 (file-already-exists t))
2826 ;; The file was somehow created by someone else between
2827 ;; `delete-file' and `copy-file', so let's try again.
2828 nil))
2829 ;; Reset the umask.
2830 (set-default-file-modes umask)))
2831 (and modes
2832 (set-file-modes to-name (logand modes #o1777))))
2456 2833
2457 (defun file-name-sans-versions (name &optional keep-backup-version) 2834 (defun file-name-sans-versions (name &optional keep-backup-version)
2458 "Return file NAME sans backup versions or strings. 2835 "Return file NAME sans backup versions or strings.
2459 This is a separate procedure so your site-init or startup file can 2836 This is a separate procedure so your site-init or startup file can
2460 redefine it. 2837 redefine it.
2526 (if period 2903 (if period
2527 ""))))) 2904 "")))))
2528 2905
2529 (defcustom make-backup-file-name-function nil 2906 (defcustom make-backup-file-name-function nil
2530 "A function to use instead of the default `make-backup-file-name'. 2907 "A function to use instead of the default `make-backup-file-name'.
2531 A value of nil gives the default `make-backup-file-name' behaviour. 2908 A value of nil gives the default `make-backup-file-name' behavior.
2532 2909
2533 This could be buffer-local to do something special for specific 2910 This could be buffer-local to do something special for specific
2534 files. If you define it, you may need to change `backup-file-name-p' 2911 files. If you define it, you may need to change `backup-file-name-p'
2535 and `file-name-sans-versions' too. 2912 and `file-name-sans-versions' too.
2536 2913
2562 :type '(repeat (cons (regexp :tag "Regexp matching filename") 2939 :type '(repeat (cons (regexp :tag "Regexp matching filename")
2563 (directory :tag "Backup directory name")))) 2940 (directory :tag "Backup directory name"))))
2564 2941
2565 (defun normal-backup-enable-predicate (name) 2942 (defun normal-backup-enable-predicate (name)
2566 "Default `backup-enable-predicate' function. 2943 "Default `backup-enable-predicate' function.
2567 Checks for files in `temporary-file-directory' or 2944 Checks for files in `temporary-file-directory',
2568 `small-temporary-file-directory'." 2945 `small-temporary-file-directory', and /tmp."
2569 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil 2946 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
2570 name 0 nil))) 2947 name 0 nil)))
2571 ;; Directory is under temporary-file-directory. 2948 ;; Directory is under temporary-file-directory.
2572 (and (not (eq comp t)) 2949 (and (not (eq comp t))
2573 (< comp (- (length temporary-file-directory))))) 2950 (< comp (- (length temporary-file-directory)))))
2951 (let ((comp (compare-strings "/tmp" 0 nil
2952 name 0 nil)))
2953 ;; Directory is under /tmp.
2954 (and (not (eq comp t))
2955 (< comp (- (length "/tmp")))))
2574 (if small-temporary-file-directory 2956 (if small-temporary-file-directory
2575 (let ((comp (compare-strings small-temporary-file-directory 2957 (let ((comp (compare-strings small-temporary-file-directory
2576 0 nil 2958 0 nil
2577 name 0 nil))) 2959 name 0 nil)))
2578 ;; Directory is under small-temporary-file-directory. 2960 ;; Directory is under small-temporary-file-directory.
2604 (concat (make-backup-file-name-1 file) "~")))) 2986 (concat (make-backup-file-name-1 file) "~"))))
2605 2987
2606 (defun make-backup-file-name-1 (file) 2988 (defun make-backup-file-name-1 (file)
2607 "Subroutine of `make-backup-file-name' and `find-backup-file-name'." 2989 "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
2608 (let ((alist backup-directory-alist) 2990 (let ((alist backup-directory-alist)
2609 elt backup-directory failed) 2991 elt backup-directory)
2610 (while alist 2992 (while alist
2611 (setq elt (pop alist)) 2993 (setq elt (pop alist))
2612 (if (string-match (car elt) file) 2994 (if (string-match (car elt) file)
2613 (setq backup-directory (cdr elt) 2995 (setq backup-directory (cdr elt)
2614 alist nil))) 2996 alist nil)))
2665 "Given the name of a numeric backup file, FN, return the backup number. 3047 "Given the name of a numeric backup file, FN, return the backup number.
2666 Uses the free variable `backup-extract-version-start', whose value should be 3048 Uses the free variable `backup-extract-version-start', whose value should be
2667 the index in the name where the version number begins." 3049 the index in the name where the version number begins."
2668 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start) 3050 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
2669 (= (match-beginning 0) backup-extract-version-start)) 3051 (= (match-beginning 0) backup-extract-version-start))
2670 (string-to-int (substring fn backup-extract-version-start -1)) 3052 (string-to-number (substring fn backup-extract-version-start -1))
2671 0)) 3053 0))
2672 3054
2673 ;; I believe there is no need to alter this behavior for VMS; 3055 ;; I believe there is no need to alter this behavior for VMS;
2674 ;; since backup files are not made on VMS, it should not get called. 3056 ;; since backup files are not made on VMS, it should not get called.
2675 (defun find-backup-file-name (fn) 3057 (defun find-backup-file-name (fn)
2726 3108
2727 (defun file-nlinks (filename) 3109 (defun file-nlinks (filename)
2728 "Return number of names file FILENAME has." 3110 "Return number of names file FILENAME has."
2729 (car (cdr (file-attributes filename)))) 3111 (car (cdr (file-attributes filename))))
2730 3112
3113 ;; (defun file-relative-name (filename &optional directory)
3114 ;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
3115 ;; This function returns a relative file name which is equivalent to FILENAME
3116 ;; when used with that default directory as the default.
3117 ;; If this is impossible (which can happen on MSDOS and Windows
3118 ;; when the file name and directory use different drive names)
3119 ;; then it returns FILENAME."
3120 ;; (save-match-data
3121 ;; (let ((fname (expand-file-name filename)))
3122 ;; (setq directory (file-name-as-directory
3123 ;; (expand-file-name (or directory default-directory))))
3124 ;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
3125 ;; ;; drive names, they can't be relative, so return the absolute name.
3126 ;; (if (and (or (eq system-type 'ms-dos)
3127 ;; (eq system-type 'cygwin)
3128 ;; (eq system-type 'windows-nt))
3129 ;; (not (string-equal (substring fname 0 2)
3130 ;; (substring directory 0 2))))
3131 ;; filename
3132 ;; (let ((ancestor ".")
3133 ;; (fname-dir (file-name-as-directory fname)))
3134 ;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
3135 ;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
3136 ;; (setq directory (file-name-directory (substring directory 0 -1))
3137 ;; ancestor (if (equal ancestor ".")
3138 ;; ".."
3139 ;; (concat "../" ancestor))))
3140 ;; ;; Now ancestor is empty, or .., or ../.., etc.
3141 ;; (if (string-match (concat "^" (regexp-quote directory)) fname)
3142 ;; ;; We matched within FNAME's directory part.
3143 ;; ;; Add the rest of FNAME onto ANCESTOR.
3144 ;; (let ((rest (substring fname (match-end 0))))
3145 ;; (if (and (equal ancestor ".")
3146 ;; (not (equal rest "")))
3147 ;; ;; But don't bother with ANCESTOR if it would give us `./'.
3148 ;; rest
3149 ;; (concat (file-name-as-directory ancestor) rest)))
3150 ;; ;; We matched FNAME's directory equivalent.
3151 ;; ancestor))))))
3152
2731 (defun file-relative-name (filename &optional directory) 3153 (defun file-relative-name (filename &optional directory)
2732 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). 3154 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
2733 This function returns a relative file name which is equivalent to FILENAME 3155 This function returns a relative file name which is equivalent to FILENAME
2734 when used with that default directory as the default. 3156 when used with that default directory as the default.
2735 If this is impossible (which can happen on MSDOS and Windows 3157 If FILENAME and DIRECTORY lie on different machines or on different drives
2736 when the file name and directory use different drive names) 3158 on a DOS/Windows machine, it returns FILENAME in expanded form."
2737 then it returns FILENAME."
2738 (save-match-data 3159 (save-match-data
2739 (let ((fname (expand-file-name filename))) 3160 (setq directory
2740 (setq directory (file-name-as-directory 3161 (file-name-as-directory (expand-file-name (or directory
2741 (expand-file-name (or directory default-directory)))) 3162 default-directory))))
2742 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different 3163 (setq filename (expand-file-name filename))
2743 ;; drive names, they can't be relative, so return the absolute name. 3164 (let ((fremote (file-remote-p filename))
2744 (if (and (or (eq system-type 'ms-dos) 3165 (dremote (file-remote-p directory)))
2745 (eq system-type 'cygwin) 3166 (if ;; Conditions for separate trees
2746 (eq system-type 'windows-nt)) 3167 (or
2747 (not (string-equal (substring fname 0 2) 3168 ;; Test for different drives on DOS/Windows
2748 (substring directory 0 2)))) 3169 (and
3170 ;; Should `cygwin' really be included here? --stef
3171 (memq system-type '(ms-dos cygwin windows-nt))
3172 (not (eq t (compare-strings filename 0 2 directory 0 2))))
3173 ;; Test for different remote file system identification
3174 (not (equal fremote dremote)))
2749 filename 3175 filename
2750 (let ((ancestor ".") 3176 (let ((ancestor ".")
2751 (fname-dir (file-name-as-directory fname))) 3177 (filename-dir (file-name-as-directory filename)))
2752 (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir)) 3178 (while (not
2753 (not (string-match (concat "^" (regexp-quote directory)) fname))) 3179 (or
2754 (setq directory (file-name-directory (substring directory 0 -1)) 3180 (eq t (compare-strings filename-dir nil (length directory)
3181 directory nil nil case-fold-search))
3182 (eq t (compare-strings filename nil (length directory)
3183 directory nil nil case-fold-search))))
3184 (setq directory (file-name-directory (substring directory 0 -1))
2755 ancestor (if (equal ancestor ".") 3185 ancestor (if (equal ancestor ".")
2756 ".." 3186 ".."
2757 (concat "../" ancestor)))) 3187 (concat "../" ancestor))))
2758 ;; Now ancestor is empty, or .., or ../.., etc. 3188 ;; Now ancestor is empty, or .., or ../.., etc.
2759 (if (string-match (concat "^" (regexp-quote directory)) fname) 3189 (if (eq t (compare-strings filename nil (length directory)
2760 ;; We matched within FNAME's directory part. 3190 directory nil nil case-fold-search))
2761 ;; Add the rest of FNAME onto ANCESTOR. 3191 ;; We matched within FILENAME's directory part.
2762 (let ((rest (substring fname (match-end 0)))) 3192 ;; Add the rest of FILENAME onto ANCESTOR.
2763 (if (and (equal ancestor ".") 3193 (let ((rest (substring filename (length directory))))
2764 (not (equal rest ""))) 3194 (if (and (equal ancestor ".") (not (equal rest "")))
2765 ;; But don't bother with ANCESTOR if it would give us `./'. 3195 ;; But don't bother with ANCESTOR if it would give us `./'.
2766 rest 3196 rest
2767 (concat (file-name-as-directory ancestor) rest))) 3197 (concat (file-name-as-directory ancestor) rest)))
2768 ;; We matched FNAME's directory equivalent. 3198 ;; We matched FILENAME's directory equivalent.
2769 ancestor)))))) 3199 ancestor))))))
2770 3200
2771 (defun save-buffer (&optional args) 3201 (defun save-buffer (&optional args)
2772 "Save current buffer in visited file if modified. Versions described below. 3202 "Save current buffer in visited file if modified.
3203 Variations are described below.
3204
2773 By default, makes the previous version into a backup file 3205 By default, makes the previous version into a backup file
2774 if previously requested or if this is the first save. 3206 if previously requested or if this is the first save.
2775 With 1 \\[universal-argument], marks this version 3207 Prefixed with one \\[universal-argument], marks this version
2776 to become a backup when the next save is done. 3208 to become a backup when the next save is done.
2777 With 2 \\[universal-argument]'s, 3209 Prefixed with two \\[universal-argument]'s,
2778 unconditionally makes the previous version into a backup file. 3210 unconditionally makes the previous version into a backup file.
2779 With 3 \\[universal-argument]'s, marks this version 3211 Prefixed with three \\[universal-argument]'s, marks this version
2780 to become a backup when the next save is done, 3212 to become a backup when the next save is done,
2781 and unconditionally makes the previous version into a backup file. 3213 and unconditionally makes the previous version into a backup file.
2782 3214
2783 With argument of 0, never make the previous version into a backup file. 3215 With a numeric argument of 0, never make the previous version
3216 into a backup file.
2784 3217
2785 If a file's name is FOO, the names of its numbered backup versions are 3218 If a file's name is FOO, the names of its numbered backup versions are
2786 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. 3219 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
2787 Numeric backups (rather than FOO~) will be made if value of 3220 Numeric backups (rather than FOO~) will be made if value of
2788 `version-control' is not the atom `never' and either there are already 3221 `version-control' is not the atom `never' and either there are already
2826 (set-buffer-auto-saved)))) 3259 (set-buffer-auto-saved))))
2827 3260
2828 (defvar auto-save-hook nil 3261 (defvar auto-save-hook nil
2829 "Normal hook run just before auto-saving.") 3262 "Normal hook run just before auto-saving.")
2830 3263
3264 (defcustom before-save-hook nil
3265 "Normal hook that is run before a buffer is saved to its file."
3266 :options '(copyright-update time-stamp)
3267 :type 'hook
3268 :group 'files)
3269
2831 (defcustom after-save-hook nil 3270 (defcustom after-save-hook nil
2832 "Normal hook that is run after a buffer is saved to its file." 3271 "Normal hook that is run after a buffer is saved to its file."
2833 :options '(executable-make-buffer-file-executable-if-script-p) 3272 :options '(executable-make-buffer-file-executable-if-script-p)
2834 :type 'hook 3273 :type 'hook
2835 :group 'files) 3274 :group 'files)
2847 3286
2848 (defun basic-save-buffer () 3287 (defun basic-save-buffer ()
2849 "Save the current buffer in its visited file, if it has been modified. 3288 "Save the current buffer in its visited file, if it has been modified.
2850 The hooks `write-contents-functions' and `write-file-functions' get a chance 3289 The hooks `write-contents-functions' and `write-file-functions' get a chance
2851 to do the job of saving; if they do not, then the buffer is saved in 3290 to do the job of saving; if they do not, then the buffer is saved in
2852 the visited file file in the usual way. 3291 the visited file in the usual way.
2853 After saving the buffer, this function runs `after-save-hook'." 3292 Before and after saving the buffer, this function runs
3293 `before-save-hook' and `after-save-hook', respectively."
2854 (interactive) 3294 (interactive)
2855 (save-current-buffer 3295 (save-current-buffer
2856 ;; In an indirect buffer, save its base buffer instead. 3296 ;; In an indirect buffer, save its base buffer instead.
2857 (if (buffer-base-buffer) 3297 (if (buffer-base-buffer)
2858 (set-buffer (buffer-base-buffer))) 3298 (set-buffer (buffer-base-buffer)))
2859 (if (buffer-modified-p) 3299 (if (buffer-modified-p)
2860 (let ((recent-save (recent-auto-save-p)) 3300 (let ((recent-save (recent-auto-save-p))
2861 setmodes tempsetmodes) 3301 setmodes)
2862 ;; On VMS, rename file and buffer to get rid of version number. 3302 ;; On VMS, rename file and buffer to get rid of version number.
2863 (if (and (eq system-type 'vax-vms) 3303 (if (and (eq system-type 'vax-vms)
2864 (not (string= buffer-file-name 3304 (not (string= buffer-file-name
2865 (file-name-sans-versions buffer-file-name)))) 3305 (file-name-sans-versions buffer-file-name))))
2866 (let (buffer-new-name) 3306 (let (buffer-new-name)
2895 (not find-file-literally) 3335 (not find-file-literally)
2896 (/= (char-after (1- (point-max))) ?\n) 3336 (/= (char-after (1- (point-max))) ?\n)
2897 (not (and (eq selective-display t) 3337 (not (and (eq selective-display t)
2898 (= (char-after (1- (point-max))) ?\r))) 3338 (= (char-after (1- (point-max))) ?\r)))
2899 (or (eq require-final-newline t) 3339 (or (eq require-final-newline t)
3340 (eq require-final-newline 'visit-save)
2900 (and require-final-newline 3341 (and require-final-newline
2901 (y-or-n-p 3342 (y-or-n-p
2902 (format "Buffer %s does not end in newline. Add one? " 3343 (format "Buffer %s does not end in newline. Add one? "
2903 (buffer-name))))) 3344 (buffer-name)))))
2904 (save-excursion 3345 (save-excursion
2905 (goto-char (point-max)) 3346 (goto-char (point-max))
2906 (insert ?\n)))) 3347 (insert ?\n))))
2907 ;; Support VC version backups. 3348 ;; Support VC version backups.
2908 (vc-before-save) 3349 (vc-before-save)
3350 (run-hooks 'before-save-hook)
2909 (or (run-hook-with-args-until-success 'write-contents-functions) 3351 (or (run-hook-with-args-until-success 'write-contents-functions)
2910 (run-hook-with-args-until-success 'local-write-file-hooks) 3352 (run-hook-with-args-until-success 'local-write-file-hooks)
2911 (run-hook-with-args-until-success 'write-file-functions) 3353 (run-hook-with-args-until-success 'write-file-functions)
2912 ;; If a hook returned t, file is already "written". 3354 ;; If a hook returned t, file is already "written".
2913 ;; Otherwise, write it the usual way now. 3355 ;; Otherwise, write it the usual way now.
2935 ;; This does the "real job" of writing a buffer into its visited file 3377 ;; This does the "real job" of writing a buffer into its visited file
2936 ;; and making a backup file. This is what is normally done 3378 ;; and making a backup file. This is what is normally done
2937 ;; but inhibited if one of write-file-functions returns non-nil. 3379 ;; but inhibited if one of write-file-functions returns non-nil.
2938 ;; It returns a value (MODES . BACKUPNAME), like backup-buffer. 3380 ;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
2939 (defun basic-save-buffer-1 () 3381 (defun basic-save-buffer-1 ()
2940 (if save-buffer-coding-system 3382 (prog1
2941 (let ((coding-system-for-write save-buffer-coding-system)) 3383 (if save-buffer-coding-system
3384 (let ((coding-system-for-write save-buffer-coding-system))
3385 (basic-save-buffer-2))
2942 (basic-save-buffer-2)) 3386 (basic-save-buffer-2))
2943 (basic-save-buffer-2))) 3387 (setq buffer-file-coding-system-explicit last-coding-system-used)))
2944 3388
2945 ;; This returns a value (MODES . BACKUPNAME), like backup-buffer. 3389 ;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
2946 (defun basic-save-buffer-2 () 3390 (defun basic-save-buffer-2 ()
2947 (let (tempsetmodes setmodes) 3391 (let (tempsetmodes setmodes)
2948 (if (not (file-writable-p buffer-file-name)) 3392 (if (not (file-writable-p buffer-file-name))
2966 (file-writable-p dir)) 3410 (file-writable-p dir))
2967 ;; If file is precious, write temp name, then rename it. 3411 ;; If file is precious, write temp name, then rename it.
2968 ;; This requires write access to the containing dir, 3412 ;; This requires write access to the containing dir,
2969 ;; which is why we don't try it if we don't have that access. 3413 ;; which is why we don't try it if we don't have that access.
2970 (let ((realname buffer-file-name) 3414 (let ((realname buffer-file-name)
2971 tempname temp nogood i succeed 3415 tempname succeed
3416 (umask (default-file-modes))
2972 (old-modtime (visited-file-modtime))) 3417 (old-modtime (visited-file-modtime)))
2973 (setq i 0) 3418 ;; Create temp files with strict access rights. It's easy to
2974 (setq nogood t) 3419 ;; loosen them later, whereas it's impossible to close the
2975 ;; Find the temporary name to write under. 3420 ;; time-window of loose permissions otherwise.
2976 (while nogood
2977 (setq tempname (format
2978 (if (and (eq system-type 'ms-dos)
2979 (not (msdos-long-file-names)))
2980 "%s#%d.tm#" ; MSDOS limits files to 8+3
2981 (if (memq system-type '(vax-vms axp-vms))
2982 "%s$tmp$%d"
2983 "%s#tmp#%d"))
2984 dir i))
2985 (setq nogood (file-exists-p tempname))
2986 (setq i (1+ i)))
2987 (unwind-protect 3421 (unwind-protect
2988 (progn (clear-visited-file-modtime) 3422 (progn
2989 (write-region (point-min) (point-max) 3423 (clear-visited-file-modtime)
2990 tempname nil realname 3424 (set-default-file-modes ?\700)
2991 buffer-file-truename) 3425 ;; Try various temporary names.
2992 (setq succeed t)) 3426 ;; This code follows the example of make-temp-file,
2993 ;; If writing the temp file fails, 3427 ;; but it calls write-region in the appropriate way
2994 ;; delete the temp file. 3428 ;; for saving the buffer.
2995 (or succeed 3429 (while (condition-case ()
2996 (progn 3430 (progn
2997 (condition-case nil 3431 (setq tempname
2998 (delete-file tempname) 3432 (make-temp-name
2999 (file-error nil)) 3433 (expand-file-name "tmp" dir)))
3000 (set-visited-file-modtime old-modtime)))) 3434 (write-region (point-min) (point-max)
3001 ;; Since we have created an entirely new file 3435 tempname nil realname
3002 ;; and renamed it, make sure it gets the 3436 buffer-file-truename 'excl)
3003 ;; right permission bits set. 3437 nil)
3438 (file-already-exists t))
3439 ;; The file was somehow created by someone else between
3440 ;; `make-temp-name' and `write-region', let's try again.
3441 nil)
3442 (setq succeed t))
3443 ;; Reset the umask.
3444 (set-default-file-modes umask)
3445 ;; If we failed, restore the buffer's modtime.
3446 (unless succeed
3447 (set-visited-file-modtime old-modtime)))
3448 ;; Since we have created an entirely new file,
3449 ;; make sure it gets the right permission bits set.
3004 (setq setmodes (or setmodes (cons (file-modes buffer-file-name) 3450 (setq setmodes (or setmodes (cons (file-modes buffer-file-name)
3005 buffer-file-name))) 3451 buffer-file-name)))
3006 ;; We succeeded in writing the temp file, 3452 ;; We succeeded in writing the temp file,
3007 ;; so rename it. 3453 ;; so rename it.
3008 (rename-file tempname buffer-file-name t)) 3454 (rename-file tempname buffer-file-name t))
3021 buffer-file-name nil t buffer-file-truename) 3467 buffer-file-name nil t buffer-file-truename)
3022 (setq success t)) 3468 (setq success t))
3023 ;; If we get an error writing the new file, and we made 3469 ;; If we get an error writing the new file, and we made
3024 ;; the backup by renaming, undo the backing-up. 3470 ;; the backup by renaming, undo the backing-up.
3025 (and setmodes (not success) 3471 (and setmodes (not success)
3026 (rename-file (cdr setmodes) buffer-file-name)))))) 3472 (progn
3473 (rename-file (cdr setmodes) buffer-file-name t)
3474 (setq buffer-backed-up nil)))))))
3027 setmodes)) 3475 setmodes))
3028 3476
3029 (defun diff-buffer-with-file (&optional buffer) 3477 (defun diff-buffer-with-file (&optional buffer)
3030 "View the differences between BUFFER and its associated file. 3478 "View the differences between BUFFER and its associated file.
3031 This requires the external program `diff' to be in your `exec-path'." 3479 This requires the external program `diff' to be in your `exec-path'."
3057 (lambda (ignore) 3505 (lambda (ignore)
3058 (exit-recursive-edit))) 3506 (exit-recursive-edit)))
3059 (recursive-edit) 3507 (recursive-edit)
3060 ;; Return nil to ask about BUF again. 3508 ;; Return nil to ask about BUF again.
3061 nil) 3509 nil)
3062 "display the current buffer") 3510 "view this file")
3063 (?d diff-buffer-with-file 3511 (?d diff-buffer-with-file
3064 "show difference to last saved version")) 3512 "view changes in file"))
3065 "ACTION-ALIST argument used in call to `map-y-or-n-p'.") 3513 "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
3066 (put 'save-some-buffers-action-alist 'risky-local-variable t) 3514 (put 'save-some-buffers-action-alist 'risky-local-variable t)
3515
3516 (defvar buffer-save-without-query nil
3517 "Non-nil means `save-some-buffers' should save this buffer without asking.")
3518 (make-variable-buffer-local 'buffer-save-without-query)
3067 3519
3068 (defun save-some-buffers (&optional arg pred) 3520 (defun save-some-buffers (&optional arg pred)
3069 "Save some modified file-visiting buffers. Asks user about each one. 3521 "Save some modified file-visiting buffers. Asks user about each one.
3070 You can answer `y' to save, `n' not to save, `C-r' to look at the 3522 You can answer `y' to save, `n' not to save, `C-r' to look at the
3071 buffer in question with `view-buffer' before deciding or `d' to 3523 buffer in question with `view-buffer' before deciding or `d' to
3072 view the differences using `diff-buffer-to-file'. 3524 view the differences using `diff-buffer-with-file'.
3073 3525
3074 Optional argument (the prefix) non-nil means save all with no questions. 3526 Optional argument (the prefix) non-nil means save all with no questions.
3075 Optional second argument PRED determines which buffers are considered: 3527 Optional second argument PRED determines which buffers are considered:
3076 If PRED is nil, all the file-visiting buffers are considered. 3528 If PRED is nil, all the file-visiting buffers are considered.
3077 If PRED is t, then certain non-file buffers will also be considered. 3529 If PRED is t, then certain non-file buffers will also be considered.
3080 3532
3081 See `save-some-buffers-action-alist' if you want to 3533 See `save-some-buffers-action-alist' if you want to
3082 change the additional actions you can take on files." 3534 change the additional actions you can take on files."
3083 (interactive "P") 3535 (interactive "P")
3084 (save-window-excursion 3536 (save-window-excursion
3085 (let* ((queried nil) 3537 (let* (queried some-automatic
3086 (files-done 3538 files-done abbrevs-done)
3539 (dolist (buffer (buffer-list))
3540 ;; First save any buffers that we're supposed to save unconditionally.
3541 ;; That way the following code won't ask about them.
3542 (with-current-buffer buffer
3543 (when (and buffer-save-without-query (buffer-modified-p))
3544 (setq some-automatic t)
3545 (save-buffer))))
3546 ;; Ask about those buffers that merit it,
3547 ;; and record the number thus saved.
3548 (setq files-done
3087 (map-y-or-n-p 3549 (map-y-or-n-p
3088 (function 3550 (function
3089 (lambda (buffer) 3551 (lambda (buffer)
3090 (and (buffer-modified-p buffer) 3552 (and (buffer-modified-p buffer)
3091 (not (buffer-base-buffer buffer)) 3553 (not (buffer-base-buffer buffer))
3110 (set-buffer buffer) 3572 (set-buffer buffer)
3111 (save-buffer))) 3573 (save-buffer)))
3112 (buffer-list) 3574 (buffer-list)
3113 '("buffer" "buffers" "save") 3575 '("buffer" "buffers" "save")
3114 save-some-buffers-action-alist)) 3576 save-some-buffers-action-alist))
3115 (abbrevs-done 3577 ;; Maybe to save abbrevs, and record whether
3116 (and save-abbrevs abbrevs-changed 3578 ;; we either saved them or asked to.
3117 (progn 3579 (and save-abbrevs abbrevs-changed
3118 (if (or arg 3580 (progn
3119 (eq save-abbrevs 'silently) 3581 (if (or arg
3120 (y-or-n-p (format "Save abbrevs in %s? " 3582 (eq save-abbrevs 'silently)
3121 abbrev-file-name))) 3583 (y-or-n-p (format "Save abbrevs in %s? "
3122 (write-abbrev-file nil)) 3584 abbrev-file-name)))
3123 ;; Don't keep bothering user if he says no. 3585 (write-abbrev-file nil))
3124 (setq abbrevs-changed nil) 3586 ;; Don't keep bothering user if he says no.
3125 t)))) 3587 (setq abbrevs-changed nil)
3588 (setq abbrevs-done t)))
3126 (or queried (> files-done 0) abbrevs-done 3589 (or queried (> files-done 0) abbrevs-done
3127 (message "(No files need saving)"))))) 3590 (message (if some-automatic
3591 "(Some special files were saved without asking)"
3592 "(No files need saving)"))))))
3128 3593
3129 (defun not-modified (&optional arg) 3594 (defun not-modified (&optional arg)
3130 "Mark current buffer as unmodified, not needing to be saved. 3595 "Mark current buffer as unmodified, not needing to be saved.
3131 With prefix arg, mark buffer as modified, so \\[save-buffer] will save. 3596 With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
3132 3597
3151 ((and buffer-read-only view-mode) 3616 ((and buffer-read-only view-mode)
3152 (View-exit-and-edit) 3617 (View-exit-and-edit)
3153 (make-local-variable 'view-read-only) 3618 (make-local-variable 'view-read-only)
3154 (setq view-read-only t)) ; Must leave view mode. 3619 (setq view-read-only t)) ; Must leave view mode.
3155 ((and (not buffer-read-only) view-read-only 3620 ((and (not buffer-read-only) view-read-only
3621 ;; If view-mode is already active, `view-mode-enter' is a nop.
3622 (not view-mode)
3156 (not (eq (get major-mode 'mode-class) 'special))) 3623 (not (eq (get major-mode 'mode-class) 'special)))
3157 (view-mode-enter)) 3624 (view-mode-enter))
3158 (t (setq buffer-read-only (not buffer-read-only)) 3625 (t (setq buffer-read-only (not buffer-read-only))
3159 (force-mode-line-update))) 3626 (force-mode-line-update)))
3160 (if (vc-backend buffer-file-name) 3627 (if (vc-backend buffer-file-name)
3161 (message (substitute-command-keys 3628 (message "%s" (substitute-command-keys
3162 (concat "File is under version-control; " 3629 (concat "File is under version-control; "
3163 "use \\[vc-next-action] to check in/out")))))) 3630 "use \\[vc-next-action] to check in/out"))))))
3164 3631
3165 (defun insert-file (filename) 3632 (defun insert-file (filename)
3166 "Insert contents of file FILENAME into buffer after point. 3633 "Insert contents of file FILENAME into buffer after point.
3184 "Return most recent backup file for FILENAME or nil if no backups exist." 3651 "Return most recent backup file for FILENAME or nil if no backups exist."
3185 ;; `make-backup-file-name' will get us the right directory for 3652 ;; `make-backup-file-name' will get us the right directory for
3186 ;; ordinary or numeric backups. It might create a directory for 3653 ;; ordinary or numeric backups. It might create a directory for
3187 ;; backups as a side-effect, according to `backup-directory-alist'. 3654 ;; backups as a side-effect, according to `backup-directory-alist'.
3188 (let* ((filename (file-name-sans-versions 3655 (let* ((filename (file-name-sans-versions
3189 (make-backup-file-name filename))) 3656 (make-backup-file-name (expand-file-name filename))))
3190 (file (file-name-nondirectory filename)) 3657 (file (file-name-nondirectory filename))
3191 (dir (file-name-directory filename)) 3658 (dir (file-name-directory filename))
3192 (comp (file-name-all-completions file dir)) 3659 (comp (file-name-all-completions file dir))
3193 (newest nil) 3660 (newest nil)
3194 tem) 3661 tem)
3225 Interactively, the default choice of directory to create 3692 Interactively, the default choice of directory to create
3226 is the current default directory for file names. 3693 is the current default directory for file names.
3227 That is useful when you have visited a file in a nonexistent directory. 3694 That is useful when you have visited a file in a nonexistent directory.
3228 3695
3229 Noninteractively, the second (optional) argument PARENTS says whether 3696 Noninteractively, the second (optional) argument PARENTS says whether
3230 to create parent directories if they don't exist." 3697 to create parent directories if they don't exist. Interactively,
3698 this happens by default."
3231 (interactive 3699 (interactive
3232 (list (read-file-name "Make directory: " default-directory default-directory 3700 (list (read-file-name "Make directory: " default-directory default-directory
3233 nil nil) 3701 nil nil)
3234 t)) 3702 t))
3235 ;; If default-directory is a remote directory, 3703 ;; If default-directory is a remote directory,
3261 Gets two args, first the nominal file name to use, 3729 Gets two args, first the nominal file name to use,
3262 and second, t if reading the auto-save file. 3730 and second, t if reading the auto-save file.
3263 3731
3264 The function you specify is responsible for updating (or preserving) point.") 3732 The function you specify is responsible for updating (or preserving) point.")
3265 3733
3734 (defvar buffer-stale-function nil
3735 "Function to check whether a non-file buffer needs reverting.
3736 This should be a function with one optional argument NOCONFIRM.
3737 Auto Revert Mode passes t for NOCONFIRM. The function should return
3738 non-nil if the buffer should be reverted. A return value of
3739 `fast' means that the need for reverting was not checked, but
3740 that reverting the buffer is fast. The buffer is current when
3741 this function is called.
3742
3743 The idea behind the NOCONFIRM argument is that it should be
3744 non-nil if the buffer is going to be reverted without asking the
3745 user. In such situations, one has to be careful with potentially
3746 time consuming operations.
3747
3748 For more information on how this variable is used by Auto Revert mode,
3749 see Info node `(emacs-xtra)Supporting additional buffers'.")
3750
3266 (defvar before-revert-hook nil 3751 (defvar before-revert-hook nil
3267 "Normal hook for `revert-buffer' to run before reverting. 3752 "Normal hook for `revert-buffer' to run before reverting.
3268 If `revert-buffer-function' is used to override the normal revert 3753 If `revert-buffer-function' is used to override the normal revert
3269 mechanism, this hook is not used.") 3754 mechanism, this hook is not used.")
3270 3755
3285 With a prefix argument, offer to revert from latest auto-save file, if 3770 With a prefix argument, offer to revert from latest auto-save file, if
3286 that is more recent than the visited file. 3771 that is more recent than the visited file.
3287 3772
3288 This command also works for special buffers that contain text which 3773 This command also works for special buffers that contain text which
3289 doesn't come from a file, but reflects some other data base instead: 3774 doesn't come from a file, but reflects some other data base instead:
3290 for example, Dired buffers and buffer-list buffers. In these cases, 3775 for example, Dired buffers and `buffer-list' buffers. In these cases,
3291 it reconstructs the buffer contents from the appropriate data base. 3776 it reconstructs the buffer contents from the appropriate data base.
3292 3777
3293 When called from Lisp, the first argument is IGNORE-AUTO; only offer 3778 When called from Lisp, the first argument is IGNORE-AUTO; only offer
3294 to revert from the auto-save file when this is nil. Note that the 3779 to revert from the auto-save file when this is nil. Note that the
3295 sense of this argument is the reverse of the prefix argument, for the 3780 sense of this argument is the reverse of the prefix argument, for the
3316 ;; reversal of the argument sense. So I'm just changing the user 3801 ;; reversal of the argument sense. So I'm just changing the user
3317 ;; interface, but leaving the programmatic interface the same. 3802 ;; interface, but leaving the programmatic interface the same.
3318 (interactive (list (not current-prefix-arg))) 3803 (interactive (list (not current-prefix-arg)))
3319 (if revert-buffer-function 3804 (if revert-buffer-function
3320 (funcall revert-buffer-function ignore-auto noconfirm) 3805 (funcall revert-buffer-function ignore-auto noconfirm)
3321 (let* ((auto-save-p (and (not ignore-auto) 3806 (with-current-buffer (or (buffer-base-buffer (current-buffer))
3322 (recent-auto-save-p) 3807 (current-buffer))
3323 buffer-auto-save-file-name 3808 (let* ((auto-save-p (and (not ignore-auto)
3324 (file-readable-p buffer-auto-save-file-name) 3809 (recent-auto-save-p)
3325 (y-or-n-p 3810 buffer-auto-save-file-name
3326 "Buffer has been auto-saved recently. Revert from auto-save file? "))) 3811 (file-readable-p buffer-auto-save-file-name)
3327 (file-name (if auto-save-p 3812 (y-or-n-p
3328 buffer-auto-save-file-name 3813 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
3329 buffer-file-name))) 3814 (file-name (if auto-save-p
3330 (cond ((null file-name) 3815 buffer-auto-save-file-name
3331 (error "Buffer does not seem to be associated with any file")) 3816 buffer-file-name)))
3332 ((or noconfirm 3817 (cond ((null file-name)
3333 (and (not (buffer-modified-p)) 3818 (error "Buffer does not seem to be associated with any file"))
3334 (let ((tail revert-without-query) 3819 ((or noconfirm
3335 (found nil)) 3820 (and (not (buffer-modified-p))
3336 (while tail 3821 (let ((tail revert-without-query)
3337 (if (string-match (car tail) file-name) 3822 (found nil))
3338 (setq found t)) 3823 (while tail
3339 (setq tail (cdr tail))) 3824 (if (string-match (car tail) file-name)
3340 found)) 3825 (setq found t))
3341 (yes-or-no-p (format "Revert buffer from file %s? " 3826 (setq tail (cdr tail)))
3342 file-name))) 3827 found))
3343 (run-hooks 'before-revert-hook) 3828 (yes-or-no-p (format "Revert buffer from file %s? "
3344 ;; If file was backed up but has changed since, 3829 file-name)))
3345 ;; we shd make another backup. 3830 (run-hooks 'before-revert-hook)
3346 (and (not auto-save-p) 3831 ;; If file was backed up but has changed since,
3347 (not (verify-visited-file-modtime (current-buffer))) 3832 ;; we shd make another backup.
3348 (setq buffer-backed-up nil)) 3833 (and (not auto-save-p)
3349 ;; Get rid of all undo records for this buffer. 3834 (not (verify-visited-file-modtime (current-buffer)))
3350 (or (eq buffer-undo-list t) 3835 (setq buffer-backed-up nil))
3351 (setq buffer-undo-list nil)) 3836 ;; Get rid of all undo records for this buffer.
3352 ;; Effectively copy the after-revert-hook status, 3837 (or (eq buffer-undo-list t)
3353 ;; since after-find-file will clobber it. 3838 (setq buffer-undo-list nil))
3354 (let ((global-hook (default-value 'after-revert-hook)) 3839 ;; Effectively copy the after-revert-hook status,
3355 (local-hook-p (local-variable-p 'after-revert-hook)) 3840 ;; since after-find-file will clobber it.
3356 (local-hook (and (local-variable-p 'after-revert-hook) 3841 (let ((global-hook (default-value 'after-revert-hook))
3357 after-revert-hook))) 3842 (local-hook-p (local-variable-p 'after-revert-hook))
3358 (let (buffer-read-only 3843 (local-hook (and (local-variable-p 'after-revert-hook)
3359 ;; Don't make undo records for the reversion. 3844 after-revert-hook)))
3360 (buffer-undo-list t)) 3845 (let (buffer-read-only
3361 (if revert-buffer-insert-file-contents-function 3846 ;; Don't make undo records for the reversion.
3362 (funcall revert-buffer-insert-file-contents-function 3847 (buffer-undo-list t))
3363 file-name auto-save-p) 3848 (if revert-buffer-insert-file-contents-function
3364 (if (not (file-exists-p file-name)) 3849 (funcall revert-buffer-insert-file-contents-function
3365 (error "File %s no longer exists!" file-name)) 3850 file-name auto-save-p)
3366 ;; Bind buffer-file-name to nil 3851 (if (not (file-exists-p file-name))
3367 ;; so that we don't try to lock the file. 3852 (error (if buffer-file-number
3368 (let ((buffer-file-name nil)) 3853 "File %s no longer exists!"
3369 (or auto-save-p 3854 "Cannot revert nonexistent file %s")
3370 (unlock-buffer))) 3855 file-name))
3371 (widen) 3856 ;; Bind buffer-file-name to nil
3372 (let ((coding-system-for-read 3857 ;; so that we don't try to lock the file.
3373 ;; Auto-saved file shoule be read without 3858 (let ((buffer-file-name nil))
3374 ;; any code conversion. 3859 (or auto-save-p
3375 (if auto-save-p 'emacs-mule-unix 3860 (unlock-buffer)))
3376 (or coding-system-for-read 3861 (widen)
3377 buffer-file-coding-system)))) 3862 (let ((coding-system-for-read
3378 ;; This force 3863 ;; Auto-saved file shoule be read by Emacs'
3379 ;; after-insert-file-set-buffer-file-coding-system 3864 ;; internal coding.
3380 ;; (called from insert-file-contents) to set 3865 (if auto-save-p 'auto-save-coding
3381 ;; buffer-file-coding-system to a proper value. 3866 (or coding-system-for-read
3382 (kill-local-variable 'buffer-file-coding-system) 3867 buffer-file-coding-system-explicit))))
3383 3868 ;; This force after-insert-file-set-coding
3384 ;; Note that this preserves point in an intelligent way. 3869 ;; (called from insert-file-contents) to set
3385 (if preserve-modes 3870 ;; buffer-file-coding-system to a proper value.
3386 (let ((buffer-file-format buffer-file-format)) 3871 (kill-local-variable 'buffer-file-coding-system)
3387 (insert-file-contents file-name (not auto-save-p) 3872
3388 nil nil t)) 3873 ;; Note that this preserves point in an intelligent way.
3389 (insert-file-contents file-name (not auto-save-p) 3874 (if preserve-modes
3390 nil nil t))))) 3875 (let ((buffer-file-format buffer-file-format))
3391 ;; Recompute the truename in case changes in symlinks 3876 (insert-file-contents file-name (not auto-save-p)
3392 ;; have changed the truename. 3877 nil nil t))
3393 (setq buffer-file-truename 3878 (insert-file-contents file-name (not auto-save-p)
3394 (abbreviate-file-name (file-truename buffer-file-name))) 3879 nil nil t)))))
3395 (after-find-file nil nil t t preserve-modes) 3880 ;; Recompute the truename in case changes in symlinks
3396 ;; Run after-revert-hook as it was before we reverted. 3881 ;; have changed the truename.
3397 (setq-default revert-buffer-internal-hook global-hook) 3882 (setq buffer-file-truename
3398 (if local-hook-p 3883 (abbreviate-file-name (file-truename buffer-file-name)))
3399 (progn 3884 (after-find-file nil nil t t preserve-modes)
3400 (make-local-variable 'revert-buffer-internal-hook) 3885 ;; Run after-revert-hook as it was before we reverted.
3401 (setq revert-buffer-internal-hook local-hook)) 3886 (setq-default revert-buffer-internal-hook global-hook)
3402 (kill-local-variable 'revert-buffer-internal-hook)) 3887 (if local-hook-p
3403 (run-hooks 'revert-buffer-internal-hook)) 3888 (set (make-local-variable 'revert-buffer-internal-hook)
3404 t))))) 3889 local-hook)
3890 (kill-local-variable 'revert-buffer-internal-hook))
3891 (run-hooks 'revert-buffer-internal-hook))
3892 t))))))
3405 3893
3406 (defun recover-this-file () 3894 (defun recover-this-file ()
3407 "Recover the visited file--get contents from its last auto-save file." 3895 "Recover the visited file--get contents from its last auto-save file."
3408 (interactive) 3896 (interactive)
3409 (recover-file buffer-file-name)) 3897 (recover-file buffer-file-name))
3414 ;; only rarely. 3902 ;; only rarely.
3415 ;; Not just because users often use the default. 3903 ;; Not just because users often use the default.
3416 (interactive "FRecover file: ") 3904 (interactive "FRecover file: ")
3417 (setq file (expand-file-name file)) 3905 (setq file (expand-file-name file))
3418 (if (auto-save-file-name-p (file-name-nondirectory file)) 3906 (if (auto-save-file-name-p (file-name-nondirectory file))
3419 (error "%s is an auto-save file" file)) 3907 (error "%s is an auto-save file" (abbreviate-file-name file)))
3420 (let ((file-name (let ((buffer-file-name file)) 3908 (let ((file-name (let ((buffer-file-name file))
3421 (make-auto-save-file-name)))) 3909 (make-auto-save-file-name))))
3422 (cond ((if (file-exists-p file) 3910 (cond ((if (file-exists-p file)
3423 (not (file-newer-than-file-p file-name file)) 3911 (not (file-newer-than-file-p file-name file))
3424 (not (file-exists-p file-name))) 3912 (not (file-exists-p file-name)))
3425 (error "Auto-save file %s not current" file-name)) 3913 (error "Auto-save file %s not current"
3914 (abbreviate-file-name file-name)))
3426 ((save-window-excursion 3915 ((save-window-excursion
3427 (with-output-to-temp-buffer "*Directory*" 3916 (with-output-to-temp-buffer "*Directory*"
3428 (buffer-disable-undo standard-output) 3917 (buffer-disable-undo standard-output)
3429 (save-excursion 3918 (save-excursion
3430 (let ((switches dired-listing-switches)) 3919 (let ((switches dired-listing-switches))
3442 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 3931 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
3443 (switch-to-buffer (find-file-noselect file t)) 3932 (switch-to-buffer (find-file-noselect file t))
3444 (let ((buffer-read-only nil) 3933 (let ((buffer-read-only nil)
3445 ;; Keep the current buffer-file-coding-system. 3934 ;; Keep the current buffer-file-coding-system.
3446 (coding-system buffer-file-coding-system) 3935 (coding-system buffer-file-coding-system)
3447 ;; Auto-saved file shoule be read without any code conversion. 3936 ;; Auto-saved file shoule be read with special coding.
3448 (coding-system-for-read 'emacs-mule-unix)) 3937 (coding-system-for-read 'auto-save-coding))
3449 (erase-buffer) 3938 (erase-buffer)
3450 (insert-file-contents file-name nil) 3939 (insert-file-contents file-name nil)
3451 (set-buffer-file-coding-system coding-system)) 3940 (set-buffer-file-coding-system coding-system))
3452 (after-find-file nil nil t)) 3941 (after-find-file nil nil t))
3453 (t (error "Recover-file cancelled"))))) 3942 (t (error "Recover-file cancelled")))))
3461 (interactive) 3950 (interactive)
3462 (if (null auto-save-list-file-prefix) 3951 (if (null auto-save-list-file-prefix)
3463 (error "You set `auto-save-list-file-prefix' to disable making session files")) 3952 (error "You set `auto-save-list-file-prefix' to disable making session files"))
3464 (let ((dir (file-name-directory auto-save-list-file-prefix))) 3953 (let ((dir (file-name-directory auto-save-list-file-prefix)))
3465 (unless (file-directory-p dir) 3954 (unless (file-directory-p dir)
3466 (make-directory dir t))) 3955 (make-directory dir t))
3956 (unless (directory-files dir nil
3957 (concat "\\`" (regexp-quote
3958 (file-name-nondirectory
3959 auto-save-list-file-prefix)))
3960 t)
3961 (error "No previous sessions to recover")))
3467 (let ((ls-lisp-support-shell-wildcards t)) 3962 (let ((ls-lisp-support-shell-wildcards t))
3468 (dired (concat auto-save-list-file-prefix "*") 3963 (dired (concat auto-save-list-file-prefix "*")
3469 (concat dired-listing-switches "t"))) 3964 (concat dired-listing-switches "t")))
3470 (save-excursion 3965 (save-excursion
3471 (goto-char (point-min)) 3966 (goto-char (point-min))
3505 ;; This is a pair of lines for a non-file-visiting buffer. 4000 ;; This is a pair of lines for a non-file-visiting buffer.
3506 ;; Get the auto-save file name and manufacture 4001 ;; Get the auto-save file name and manufacture
3507 ;; a "visited file name" from that. 4002 ;; a "visited file name" from that.
3508 (progn 4003 (progn
3509 (forward-line 1) 4004 (forward-line 1)
3510 (setq autofile 4005 ;; If there is no auto-save file name, the
3511 (buffer-substring-no-properties 4006 ;; auto-save-list file is probably corrupted.
3512 (point) 4007 (unless (eolp)
3513 (save-excursion 4008 (setq autofile
3514 (end-of-line) 4009 (buffer-substring-no-properties
3515 (point)))) 4010 (point)
3516 (setq thisfile 4011 (save-excursion
3517 (expand-file-name 4012 (end-of-line)
3518 (substring 4013 (point))))
3519 (file-name-nondirectory autofile) 4014 (setq thisfile
3520 1 -1) 4015 (expand-file-name
3521 (file-name-directory autofile))) 4016 (substring
4017 (file-name-nondirectory autofile)
4018 1 -1)
4019 (file-name-directory autofile))))
3522 (forward-line 1)) 4020 (forward-line 1))
3523 ;; This pair of lines is a file-visiting 4021 ;; This pair of lines is a file-visiting
3524 ;; buffer. Use the visited file name. 4022 ;; buffer. Use the visited file name.
3525 (progn 4023 (progn
3526 (setq thisfile 4024 (setq thisfile
3530 (setq autofile 4028 (setq autofile
3531 (buffer-substring-no-properties 4029 (buffer-substring-no-properties
3532 (point) (progn (end-of-line) (point)))) 4030 (point) (progn (end-of-line) (point))))
3533 (forward-line 1))) 4031 (forward-line 1)))
3534 ;; Ignore a file if its auto-save file does not exist now. 4032 ;; Ignore a file if its auto-save file does not exist now.
3535 (if (file-exists-p autofile) 4033 (if (and autofile (file-exists-p autofile))
3536 (setq files (cons thisfile files))))) 4034 (setq files (cons thisfile files)))))
3537 (setq files (nreverse files)) 4035 (setq files (nreverse files))
3538 ;; The file contains a pair of line for each auto-saved buffer. 4036 ;; The file contains a pair of line for each auto-saved buffer.
3539 ;; The first line of the pair contains the visited file name 4037 ;; The first line of the pair contains the visited file name
3540 ;; or is empty if the buffer was not visiting a file. 4038 ;; or is empty if the buffer was not visiting a file.
3550 '("file" "files" "recover")) 4048 '("file" "files" "recover"))
3551 (message "No files can be recovered from this session now"))) 4049 (message "No files can be recovered from this session now")))
3552 (kill-buffer buffer)))) 4050 (kill-buffer buffer))))
3553 4051
3554 (defun kill-some-buffers (&optional list) 4052 (defun kill-some-buffers (&optional list)
3555 "For each buffer in LIST, ask whether to kill it. 4053 "Kill some buffers. Asks the user whether to kill each one of them.
3556 LIST defaults to all existing live buffers." 4054 Non-interactively, if optional argument LIST is non-nil, it
4055 specifies the list of buffers to kill, asking for approval for each one."
3557 (interactive) 4056 (interactive)
3558 (if (null list) 4057 (if (null list)
3559 (setq list (buffer-list))) 4058 (setq list (buffer-list)))
3560 (while list 4059 (while list
3561 (let* ((buffer (car list)) 4060 (let* ((buffer (car list))
3562 (name (buffer-name buffer))) 4061 (name (buffer-name buffer)))
3563 (and (not (string-equal name "")) 4062 (and name ; Can be nil for an indirect buffer
3564 (/= (aref name 0) ? ) 4063 ; if we killed the base buffer.
4064 (not (string-equal name ""))
4065 (/= (aref name 0) ?\s)
3565 (yes-or-no-p 4066 (yes-or-no-p
3566 (format "Buffer %s %s. Kill? " 4067 (format "Buffer %s %s. Kill? "
3567 name 4068 name
3568 (if (buffer-modified-p buffer) 4069 (if (buffer-modified-p buffer)
3569 "HAS BEEN EDITED" "is unmodified"))) 4070 "HAS BEEN EDITED" "is unmodified")))
3611 "Return file name to use for auto-saves of current buffer. 4112 "Return file name to use for auto-saves of current buffer.
3612 Does not consider `auto-save-visited-file-name' as that variable is checked 4113 Does not consider `auto-save-visited-file-name' as that variable is checked
3613 before calling this function. You can redefine this for customization. 4114 before calling this function. You can redefine this for customization.
3614 See also `auto-save-file-name-p'." 4115 See also `auto-save-file-name-p'."
3615 (if buffer-file-name 4116 (if buffer-file-name
3616 (let ((list auto-save-file-name-transforms) 4117 (let ((handler (find-file-name-handler buffer-file-name
3617 (filename buffer-file-name) 4118 'make-auto-save-file-name)))
3618 result uniq) 4119 (if handler
3619 ;; Apply user-specified translations 4120 (funcall handler 'make-auto-save-file-name)
3620 ;; to the file name. 4121 (let ((list auto-save-file-name-transforms)
3621 (while (and list (not result)) 4122 (filename buffer-file-name)
3622 (if (string-match (car (car list)) filename) 4123 result uniq)
3623 (setq result (replace-match (cadr (car list)) t nil 4124 ;; Apply user-specified translations
3624 filename) 4125 ;; to the file name.
3625 uniq (car (cddr (car list))))) 4126 (while (and list (not result))
3626 (setq list (cdr list))) 4127 (if (string-match (car (car list)) filename)
3627 (if result 4128 (setq result (replace-match (cadr (car list)) t nil
3628 (if uniq 4129 filename)
3629 (setq filename (concat 4130 uniq (car (cddr (car list)))))
3630 (file-name-directory result) 4131 (setq list (cdr list)))
3631 (subst-char-in-string 4132 (if result
3632 ?/ ?! 4133 (if uniq
3633 (replace-regexp-in-string "!" "!!" 4134 (setq filename (concat
3634 filename)))) 4135 (file-name-directory result)
3635 (setq filename result))) 4136 (subst-char-in-string
3636 (setq result 4137 ?/ ?!
3637 (if (and (eq system-type 'ms-dos) 4138 (replace-regexp-in-string "!" "!!"
3638 (not (msdos-long-file-names))) 4139 filename))))
3639 ;; We truncate the file name to DOS 8+3 limits 4140 (setq filename result)))
3640 ;; before doing anything else, because the regexp 4141 (setq result
3641 ;; passed to string-match below cannot handle 4142 (if (and (eq system-type 'ms-dos)
3642 ;; extensions longer than 3 characters, multiple 4143 (not (msdos-long-file-names)))
3643 ;; dots, and other atrocities. 4144 ;; We truncate the file name to DOS 8+3 limits
3644 (let ((fn (dos-8+3-filename 4145 ;; before doing anything else, because the regexp
3645 (file-name-nondirectory buffer-file-name)))) 4146 ;; passed to string-match below cannot handle
3646 (string-match 4147 ;; extensions longer than 3 characters, multiple
3647 "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" 4148 ;; dots, and other atrocities.
3648 fn) 4149 (let ((fn (dos-8+3-filename
3649 (concat (file-name-directory buffer-file-name) 4150 (file-name-nondirectory buffer-file-name))))
3650 "#" (match-string 1 fn) 4151 (string-match
3651 "." (match-string 3 fn) "#")) 4152 "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
3652 (concat (file-name-directory filename) 4153 fn)
3653 "#" 4154 (concat (file-name-directory buffer-file-name)
3654 (file-name-nondirectory filename) 4155 "#" (match-string 1 fn)
3655 "#"))) 4156 "." (match-string 3 fn) "#"))
3656 ;; Make sure auto-save file names don't contain characters 4157 (concat (file-name-directory filename)
3657 ;; invalid for the underlying filesystem. 4158 "#"
3658 (if (and (memq system-type '(ms-dos windows-nt)) 4159 (file-name-nondirectory filename)
3659 ;; Don't modify remote (ange-ftp) filenames 4160 "#")))
3660 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) 4161 ;; Make sure auto-save file names don't contain characters
3661 (convert-standard-filename result) 4162 ;; invalid for the underlying filesystem.
3662 result)) 4163 (if (and (memq system-type '(ms-dos windows-nt))
4164 ;; Don't modify remote (ange-ftp) filenames
4165 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
4166 (convert-standard-filename result)
4167 result))))
3663 4168
3664 ;; Deal with buffers that don't have any associated files. (Mail 4169 ;; Deal with buffers that don't have any associated files. (Mail
3665 ;; mode tends to create a good number of these.) 4170 ;; mode tends to create a good number of these.)
3666 4171
3667 (let ((buffer-name (buffer-name)) 4172 (let ((buffer-name (buffer-name))
3800 4305
3801 (defun file-expand-wildcards (pattern &optional full) 4306 (defun file-expand-wildcards (pattern &optional full)
3802 "Expand wildcard pattern PATTERN. 4307 "Expand wildcard pattern PATTERN.
3803 This returns a list of file names which match the pattern. 4308 This returns a list of file names which match the pattern.
3804 4309
3805 If PATTERN is written as an absolute relative file name, 4310 If PATTERN is written as an absolute file name,
3806 the values are absolute also. 4311 the values are absolute also.
3807 4312
3808 If PATTERN is written as a relative file name, it is interpreted 4313 If PATTERN is written as a relative file name, it is interpreted
3809 relative to the current default directory, `default-directory'. 4314 relative to the current default directory, `default-directory'.
3810 The file names returned are normally also relative to the current 4315 The file names returned are normally also relative to the current
3942 "*Options to use when running `directory-free-space-program'." 4447 "*Options to use when running `directory-free-space-program'."
3943 :type 'string 4448 :type 'string
3944 :group 'dired) 4449 :group 'dired)
3945 4450
3946 (defun get-free-disk-space (dir) 4451 (defun get-free-disk-space (dir)
3947 "Return the mount of free space on directory DIR's file system. 4452 "Return the amount of free space on directory DIR's file system.
3948 The result is a string that gives the number of free 1KB blocks, 4453 The result is a string that gives the number of free 1KB blocks,
3949 or nil if the system call or the program which retrieve the infornmation 4454 or nil if the system call or the program which retrieve the information
3950 fail. 4455 fail.
3951 4456
3952 This function calls `file-system-info' if it is available, or invokes the 4457 This function calls `file-system-info' if it is available, or invokes the
3953 program specified by `directory-free-space-program' if that is non-nil." 4458 program specified by `directory-free-space-program' if that is non-nil."
3954 ;; Try to find the number of free blocks. Non-Posix systems don't 4459 ;; Try to find the number of free blocks. Non-Posix systems don't
3958 (if fsinfo 4463 (if fsinfo
3959 (format "%.0f" (/ (nth 2 fsinfo) 1024)))) 4464 (format "%.0f" (/ (nth 2 fsinfo) 1024))))
3960 (save-match-data 4465 (save-match-data
3961 (with-temp-buffer 4466 (with-temp-buffer
3962 (when (and directory-free-space-program 4467 (when (and directory-free-space-program
3963 (zerop (call-process directory-free-space-program 4468 (eq 0 (call-process directory-free-space-program
3964 nil t nil 4469 nil t nil
3965 directory-free-space-args 4470 directory-free-space-args
3966 dir))) 4471 dir)))
3967 ;; Usual format is a header line followed by a line of 4472 ;; Usual format is a header line followed by a line of
3968 ;; numbers. 4473 ;; numbers.
3969 (goto-char (point-min)) 4474 (goto-char (point-min))
3970 (forward-line 1) 4475 (forward-line 1)
3971 (if (not (eobp)) 4476 (if (not (eobp))
3976 ;; Copy it into AVAILABLE. 4481 ;; Copy it into AVAILABLE.
3977 (let ((end (point))) 4482 (let ((end (point)))
3978 (forward-word -1) 4483 (forward-word -1)
3979 (buffer-substring (point) end))))))))) 4484 (buffer-substring (point) end)))))))))
3980 4485
4486 ;; The following expression replaces `dired-move-to-filename-regexp'.
4487 (defvar directory-listing-before-filename-regexp
4488 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
4489 (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
4490 ;; In some locales, month abbreviations are as short as 2 letters,
4491 ;; and they can be followed by ".".
4492 ;; In Breton, a month name can include a quote character.
4493 (month (concat l-or-quote l-or-quote "+\\.?"))
4494 (s " ")
4495 (yyyy "[0-9][0-9][0-9][0-9]")
4496 (dd "[ 0-3][0-9]")
4497 (HH:MM "[ 0-2][0-9][:.][0-5][0-9]")
4498 (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
4499 (zone "[-+][0-2][0-9][0-5][0-9]")
4500 (iso-mm-dd "[01][0-9]-[0-3][0-9]")
4501 (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
4502 (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
4503 "\\|" yyyy "-" iso-mm-dd "\\)"))
4504 (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
4505 s "+"
4506 "\\(" HH:MM "\\|" yyyy "\\)"))
4507 (western-comma (concat month s "+" dd "," s "+" yyyy))
4508 ;; Japanese MS-Windows ls-lisp has one-digit months, and
4509 ;; omits the Kanji characters after month and day-of-month.
4510 ;; On Mac OS X 10.3, the date format in East Asian locales is
4511 ;; day-of-month digits followed by month digits.
4512 (mm "[ 0-1]?[0-9]")
4513 (east-asian
4514 (concat "\\(" mm l "?" s dd l "?" s "+"
4515 "\\|" dd s mm s "+" "\\)"
4516 "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
4517 ;; The "[0-9]" below requires the previous column to end in a digit.
4518 ;; This avoids recognizing `1 may 1997' as a date in the line:
4519 ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
4520
4521 ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output.
4522 ;; The ".*" below finds the last match if there are multiple matches.
4523 ;; This avoids recognizing `jservice 10 1024' as a date in the line:
4524 ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
4525
4526 ;; vc dired listings provide the state or blanks between file
4527 ;; permissions and date. The state is always surrounded by
4528 ;; parantheses:
4529 ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el
4530 ;; This is not supported yet.
4531 (concat ".*[0-9][BkKMGTPEZY]?" s
4532 "\\(" western "\\|" western-comma "\\|" east-asian "\\|" iso "\\)"
4533 s "+"))
4534 "Regular expression to match up to the file name in a directory listing.
4535 The default value is designed to recognize dates and times
4536 regardless of the language.")
4537
4538 (defvar insert-directory-ls-version 'unknown)
3981 4539
3982 ;; insert-directory 4540 ;; insert-directory
3983 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and 4541 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
3984 ;; FULL-DIRECTORY-P is nil. 4542 ;; FULL-DIRECTORY-P is nil.
3985 ;; The single line of output must display FILE's name as it was 4543 ;; The single line of output must display FILE's name as it was
4001 ;; Filename handlers might have to remove this switch if their 4559 ;; Filename handlers might have to remove this switch if their
4002 ;; "ls" command does not support it. 4560 ;; "ls" command does not support it.
4003 (defun insert-directory (file switches &optional wildcard full-directory-p) 4561 (defun insert-directory (file switches &optional wildcard full-directory-p)
4004 "Insert directory listing for FILE, formatted according to SWITCHES. 4562 "Insert directory listing for FILE, formatted according to SWITCHES.
4005 Leaves point after the inserted text. 4563 Leaves point after the inserted text.
4006 SWITCHES may be a string of options, or a list of strings. 4564 SWITCHES may be a string of options, or a list of strings
4565 representing individual options.
4007 Optional third arg WILDCARD means treat FILE as shell wildcard. 4566 Optional third arg WILDCARD means treat FILE as shell wildcard.
4008 Optional fourth arg FULL-DIRECTORY-P means file is a directory and 4567 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
4009 switches do not contain `d', so that a full listing is expected. 4568 switches do not contain `d', so that a full listing is expected.
4010 4569
4011 This works by running a directory listing program 4570 This works by running a directory listing program
4012 whose name is in the variable `insert-directory-program'. 4571 whose name is in the variable `insert-directory-program'.
4013 If WILDCARD, it also runs the shell specified by `shell-file-name'." 4572 If WILDCARD, it also runs the shell specified by `shell-file-name'.
4573
4574 When SWITCHES contains the long `--dired' option, this function
4575 treats it specially, for the sake of dired. However, the
4576 normally equivalent short `-D' option is just passed on to
4577 `insert-directory-program', as any other option."
4014 ;; We need the directory in order to find the right handler. 4578 ;; We need the directory in order to find the right handler.
4015 (let ((handler (find-file-name-handler (expand-file-name file) 4579 (let ((handler (find-file-name-handler (expand-file-name file)
4016 'insert-directory))) 4580 'insert-directory)))
4017 (if handler 4581 (if handler
4018 (funcall handler 'insert-directory file switches 4582 (funcall handler 'insert-directory file switches
4019 wildcard full-directory-p) 4583 wildcard full-directory-p)
4020 (if (eq system-type 'vax-vms) 4584 (if (eq system-type 'vax-vms)
4021 (vms-read-directory file switches (current-buffer)) 4585 (vms-read-directory file switches (current-buffer))
4022 (let (result available (beg (point))) 4586 (let (result (beg (point)))
4023 4587
4024 ;; Read the actual directory using `insert-directory-program'. 4588 ;; Read the actual directory using `insert-directory-program'.
4025 ;; RESULT gets the status code. 4589 ;; RESULT gets the status code.
4026 (let* (;; We at first read by no-conversion, then after 4590 (let* (;; We at first read by no-conversion, then after
4027 ;; putting text property `dired-filename, decode one 4591 ;; putting text property `dired-filename, decode one
4080 (list 4644 (list
4081 (if full-directory-p 4645 (if full-directory-p
4082 (concat (file-name-as-directory file) ".") 4646 (concat (file-name-as-directory file) ".")
4083 file)))))))) 4647 file))))))))
4084 4648
4649 ;; If we got "//DIRED//" in the output, it means we got a real
4650 ;; directory listing, even if `ls' returned nonzero.
4651 ;; So ignore any errors.
4652 (when (if (stringp switches)
4653 (string-match "--dired\\>" switches)
4654 (member "--dired" switches))
4655 (save-excursion
4656 (forward-line -2)
4657 (when (looking-at "//SUBDIRED//")
4658 (forward-line -1))
4659 (if (looking-at "//DIRED//")
4660 (setq result 0))))
4661
4662 (when (and (not (eq 0 result))
4663 (eq insert-directory-ls-version 'unknown))
4664 ;; The first time ls returns an error,
4665 ;; find the version numbers of ls,
4666 ;; and set insert-directory-ls-version
4667 ;; to > if it is more than 5.2.1, < if it is less, nil if it
4668 ;; is equal or if the info cannot be obtained.
4669 ;; (That can mean it isn't GNU ls.)
4670 (let ((version-out
4671 (with-temp-buffer
4672 (call-process "ls" nil t nil "--version")
4673 (buffer-string))))
4674 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
4675 (let* ((version (match-string 1 version-out))
4676 (split (split-string version "[.]"))
4677 (numbers (mapcar 'string-to-number split))
4678 (min '(5 2 1))
4679 comparison)
4680 (while (and (not comparison) (or numbers min))
4681 (cond ((null min)
4682 (setq comparison '>))
4683 ((null numbers)
4684 (setq comparison '<))
4685 ((> (car numbers) (car min))
4686 (setq comparison '>))
4687 ((< (car numbers) (car min))
4688 (setq comparison '<))
4689 (t
4690 (setq numbers (cdr numbers)
4691 min (cdr min)))))
4692 (setq insert-directory-ls-version (or comparison '=)))
4693 (setq insert-directory-ls-version nil))))
4694
4695 ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
4696 (when (and (eq 1 result) (eq insert-directory-ls-version '>))
4697 (setq result 0))
4698
4085 ;; If `insert-directory-program' failed, signal an error. 4699 ;; If `insert-directory-program' failed, signal an error.
4086 (if (/= result 0) 4700 (unless (eq 0 result)
4087 ;; On non-Posix systems, we cannot open a directory, so 4701 ;; Delete the error message it may have output.
4088 ;; don't even try, because that will always result in 4702 (delete-region beg (point))
4089 ;; the ubiquitous "Access denied". Instead, show the 4703 ;; On non-Posix systems, we cannot open a directory, so
4090 ;; command line so the user can try to guess what went wrong. 4704 ;; don't even try, because that will always result in
4091 (if (and (file-directory-p file) 4705 ;; the ubiquitous "Access denied". Instead, show the
4092 (memq system-type '(ms-dos windows-nt))) 4706 ;; command line so the user can try to guess what went wrong.
4093 (error 4707 (if (and (file-directory-p file)
4094 "Reading directory: \"%s %s -- %s\" exited with status %s" 4708 (memq system-type '(ms-dos windows-nt)))
4095 insert-directory-program 4709 (error
4096 (if (listp switches) (concat switches) switches) 4710 "Reading directory: \"%s %s -- %s\" exited with status %s"
4097 file result) 4711 insert-directory-program
4098 ;; Unix. Access the file to get a suitable error. 4712 (if (listp switches) (concat switches) switches)
4099 (access-file file "Reading directory") 4713 file result)
4100 (error "Listing directory failed but `access-file' worked"))) 4714 ;; Unix. Access the file to get a suitable error.
4101 4715 (access-file file "Reading directory")
4102 (when (string-match "--dired\\>" switches) 4716 (error "Listing directory failed but `access-file' worked")))
4717
4718 (when (if (stringp switches)
4719 (string-match "--dired\\>" switches)
4720 (member "--dired" switches))
4721 ;; The following overshoots by one line for an empty
4722 ;; directory listed with "--dired", but without "-a"
4723 ;; switch, where the ls output contains a
4724 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
4725 ;; We take care of that case later.
4103 (forward-line -2) 4726 (forward-line -2)
4104 (when (looking-at "//SUBDIRED//") 4727 (when (looking-at "//SUBDIRED//")
4105 (delete-region (point) (progn (forward-line 1) (point))) 4728 (delete-region (point) (progn (forward-line 1) (point)))
4106 (forward-line -1)) 4729 (forward-line -1))
4107 (let ((end (line-end-position))) 4730 (if (looking-at "//DIRED//")
4108 (forward-word 1) 4731 (let ((end (line-end-position))
4109 (forward-char 3) 4732 (linebeg (point))
4110 (while (< (point) end) 4733 error-lines)
4111 (let ((start (+ beg (read (current-buffer)))) 4734 ;; Find all the lines that are error messages,
4112 (end (+ beg (read (current-buffer))))) 4735 ;; and record the bounds of each one.
4113 (put-text-property start end 'dired-filename t))) 4736 (goto-char beg)
4114 (goto-char end) 4737 (while (< (point) linebeg)
4115 (beginning-of-line) 4738 (or (eql (following-char) ?\s)
4116 (delete-region (point) (progn (forward-line 2) (point))))) 4739 (push (list (point) (line-end-position)) error-lines))
4740 (forward-line 1))
4741 (setq error-lines (nreverse error-lines))
4742 ;; Now read the numeric positions of file names.
4743 (goto-char linebeg)
4744 (forward-word 1)
4745 (forward-char 3)
4746 (while (< (point) end)
4747 (let ((start (insert-directory-adj-pos
4748 (+ beg (read (current-buffer)))
4749 error-lines))
4750 (end (insert-directory-adj-pos
4751 (+ beg (read (current-buffer)))
4752 error-lines)))
4753 (if (memq (char-after end) '(?\n ?\s))
4754 ;; End is followed by \n or by " -> ".
4755 (put-text-property start end 'dired-filename t)
4756 ;; It seems that we can't trust ls's output as to
4757 ;; byte positions of filenames.
4758 (put-text-property beg (point) 'dired-filename nil)
4759 (end-of-line))))
4760 (goto-char end)
4761 (beginning-of-line)
4762 (delete-region (point) (progn (forward-line 1) (point))))
4763 ;; Take care of the case where the ls output contains a
4764 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
4765 ;; and we went one line too far back (see above).
4766 (forward-line 1))
4767 (if (looking-at "//DIRED-OPTIONS//")
4768 (delete-region (point) (progn (forward-line 1) (point)))))
4117 4769
4118 ;; Now decode what read if necessary. 4770 ;; Now decode what read if necessary.
4119 (let ((coding (or coding-system-for-write 4771 (let ((coding (or coding-system-for-read
4120 (detect-coding-region beg (point) t))) 4772 file-name-coding-system
4773 default-file-name-coding-system
4774 'undecided))
4775 coding-no-eol
4121 val pos) 4776 val pos)
4122 (if (not (eq (coding-system-base coding) 'undecided)) 4777 (when (and enable-multibyte-characters
4123 (save-restriction 4778 (not (memq (coding-system-base coding)
4124 (narrow-to-region beg (point)) 4779 '(raw-text no-conversion))))
4125 (goto-char (point-min)) 4780 ;; If no coding system is specified or detection is
4126 (while (not (eobp)) 4781 ;; requested, detect the coding.
4127 (setq pos (point) 4782 (if (eq (coding-system-base coding) 'undecided)
4128 val (get-text-property (point) 'dired-filename)) 4783 (setq coding (detect-coding-region beg (point) t)))
4129 (goto-char (next-single-property-change 4784 (if (not (eq (coding-system-base coding) 'undecided))
4130 (point) 'dired-filename nil (point-max))) 4785 (save-restriction
4131 (decode-coding-region pos (point) coding) 4786 (setq coding-no-eol
4132 (if val 4787 (coding-system-change-eol-conversion coding 'unix))
4133 (put-text-property pos (point) 'dired-filename t)))))) 4788 (narrow-to-region beg (point))
4789 (goto-char (point-min))
4790 (while (not (eobp))
4791 (setq pos (point)
4792 val (get-text-property (point) 'dired-filename))
4793 (goto-char (next-single-property-change
4794 (point) 'dired-filename nil (point-max)))
4795 ;; Force no eol conversion on a file name, so
4796 ;; that CR is preserved.
4797 (decode-coding-region pos (point)
4798 (if val coding-no-eol coding))
4799 (if val
4800 (put-text-property pos (point)
4801 'dired-filename t)))))))
4134 4802
4135 (if full-directory-p 4803 (if full-directory-p
4136 ;; Try to insert the amount of free space. 4804 ;; Try to insert the amount of free space.
4137 (save-excursion 4805 (save-excursion
4138 (goto-char beg) 4806 (goto-char beg)
4143 ;; Replace "total" with "used", to avoid confusion. 4811 ;; Replace "total" with "used", to avoid confusion.
4144 (replace-match "total used in directory" nil nil nil 1) 4812 (replace-match "total used in directory" nil nil nil 1)
4145 (end-of-line) 4813 (end-of-line)
4146 (insert " available " available))))))))))) 4814 (insert " available " available)))))))))))
4147 4815
4816 (defun insert-directory-adj-pos (pos error-lines)
4817 "Convert `ls --dired' file name position value POS to a buffer position.
4818 File name position values returned in ls --dired output
4819 count only stdout; they don't count the error messages sent to stderr.
4820 So this function converts to them to real buffer positions.
4821 ERROR-LINES is a list of buffer positions of error message lines,
4822 of the form (START END)."
4823 (while (and error-lines (< (caar error-lines) pos))
4824 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
4825 (pop error-lines))
4826 pos)
4827
4148 (defun insert-directory-safely (file switches 4828 (defun insert-directory-safely (file switches
4149 &optional wildcard full-directory-p) 4829 &optional wildcard full-directory-p)
4150 "Insert directory listing for FILE, formatted according to SWITCHES. 4830 "Insert directory listing for FILE, formatted according to SWITCHES.
4151 4831
4152 Like `insert-directory', but if FILE does not exist, it inserts a 4832 Like `insert-directory', but if FILE does not exist, it inserts a
4168 If nil, the default, don't ask at all. If the value is non-nil, it should 4848 If nil, the default, don't ask at all. If the value is non-nil, it should
4169 be a predicate function such as `yes-or-no-p'." 4849 be a predicate function such as `yes-or-no-p'."
4170 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p) 4850 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
4171 (const :tag "Ask with y-or-n-p" y-or-n-p) 4851 (const :tag "Ask with y-or-n-p" y-or-n-p)
4172 (const :tag "Don't confirm" nil)) 4852 (const :tag "Don't confirm" nil))
4173 :group 'emacs 4853 :group 'convenience
4174 :version "21.1") 4854 :version "21.1")
4175 4855
4176 (defun save-buffers-kill-emacs (&optional arg) 4856 (defun save-buffers-kill-emacs (&optional arg)
4177 "Offer to save each buffer, then kill this Emacs process. 4857 "Offer to save each buffer, then kill this Emacs process.
4178 With prefix arg, silently save all file-visiting buffers, then kill." 4858 With prefix arg, silently save all file-visiting buffers, then kill."
4222 (unhandled-file-name-directory default-directory))) 4902 (unhandled-file-name-directory default-directory)))
4223 default-directory)) 4903 default-directory))
4224 ;; Get a list of the indices of the args which are file names. 4904 ;; Get a list of the indices of the args which are file names.
4225 (file-arg-indices 4905 (file-arg-indices
4226 (cdr (or (assq operation 4906 (cdr (or (assq operation
4227 ;; The first five are special because they 4907 ;; The first six are special because they
4228 ;; return a file name. We want to include the /: 4908 ;; return a file name. We want to include the /:
4229 ;; in the return value. 4909 ;; in the return value.
4230 ;; So just avoid stripping it in the first place. 4910 ;; So just avoid stripping it in the first place.
4231 '((expand-file-name . nil) 4911 '((expand-file-name . nil)
4232 (file-name-directory . nil) 4912 (file-name-directory . nil)
4233 (file-name-as-directory . nil) 4913 (file-name-as-directory . nil)
4234 (directory-file-name . nil) 4914 (directory-file-name . nil)
4235 (file-name-sans-versions . nil) 4915 (file-name-sans-versions . nil)
4916 (find-backup-file-name . nil)
4236 ;; `identity' means just return the first arg 4917 ;; `identity' means just return the first arg
4237 ;; as stripped of its quoting. 4918 ;; not stripped of its quoting.
4238 (substitute-in-file-name . identity) 4919 (substitute-in-file-name identity)
4920 ;; `add' means add "/:" to the result.
4921 (file-truename add 0)
4922 ;; `quote' means add "/:" to buffer-file-name.
4923 (insert-file-contents quote 0)
4924 ;; `unquote-then-quote' means set buffer-file-name
4925 ;; temporarily to unquoted filename.
4926 (verify-visited-file-modtime unquote-then-quote)
4927 ;; List the arguments which are filenames.
4239 (file-name-completion 1) 4928 (file-name-completion 1)
4240 (file-name-all-completions 1) 4929 (file-name-all-completions 1)
4930 (write-region 2 5)
4241 (rename-file 0 1) 4931 (rename-file 0 1)
4242 (copy-file 0 1) 4932 (copy-file 0 1)
4243 (make-symbolic-link 0 1) 4933 (make-symbolic-link 0 1)
4244 (add-name-to-file 0 1))) 4934 (add-name-to-file 0 1)))
4245 ;; For all other operations, treat the first argument only 4935 ;; For all other operations, treat the first argument only
4246 ;; as the file name. 4936 ;; as the file name.
4247 '(nil 0)))) 4937 '(nil 0))))
4938 method
4248 ;; Copy ARGUMENTS so we can replace elements in it. 4939 ;; Copy ARGUMENTS so we can replace elements in it.
4249 (arguments (copy-sequence arguments))) 4940 (arguments (copy-sequence arguments)))
4250 ;; Strip off the /: from the file names that have this handler. 4941 (if (symbolp (car file-arg-indices))
4942 (setq method (pop file-arg-indices)))
4943 ;; Strip off the /: from the file names that have it.
4251 (save-match-data 4944 (save-match-data
4252 (while (consp file-arg-indices) 4945 (while (consp file-arg-indices)
4253 (let ((pair (nthcdr (car file-arg-indices) arguments))) 4946 (let ((pair (nthcdr (car file-arg-indices) arguments)))
4254 (and (car pair) 4947 (and (car pair)
4255 (string-match "\\`/:" (car pair)) 4948 (string-match "\\`/:" (car pair))
4256 (setcar pair 4949 (setcar pair
4257 (if (= (length (car pair)) 2) 4950 (if (= (length (car pair)) 2)
4258 "/" 4951 "/"
4259 (substring (car pair) 2))))) 4952 (substring (car pair) 2)))))
4260 (setq file-arg-indices (cdr file-arg-indices)))) 4953 (setq file-arg-indices (cdr file-arg-indices))))
4261 (if (eq file-arg-indices 'identity) 4954 (cond ((eq method 'identity)
4262 (car arguments) 4955 (car arguments))
4263 (apply operation arguments)))) 4956 ((eq method 'add)
4957 (concat "/:" (apply operation arguments)))
4958 ((eq method 'quote)
4959 (unwind-protect
4960 (apply operation arguments)
4961 (setq buffer-file-name (concat "/:" buffer-file-name))))
4962 ((eq method 'unquote-then-quote)
4963 (let (res)
4964 (setq buffer-file-name (substring buffer-file-name 2))
4965 (setq res (apply operation arguments))
4966 (setq buffer-file-name (concat "/:" buffer-file-name))
4967 res))
4968 (t
4969 (apply operation arguments)))))
4264 4970
4265 (define-key ctl-x-map "\C-f" 'find-file) 4971 (define-key ctl-x-map "\C-f" 'find-file)
4266 (define-key ctl-x-map "\C-r" 'find-file-read-only) 4972 (define-key ctl-x-map "\C-r" 'find-file-read-only)
4267 (define-key ctl-x-map "\C-v" 'find-alternate-file) 4973 (define-key ctl-x-map "\C-v" 'find-alternate-file)
4268 (define-key ctl-x-map "\C-s" 'save-buffer) 4974 (define-key ctl-x-map "\C-s" 'save-buffer)
4283 (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) 4989 (define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
4284 (define-key ctl-x-5-map "f" 'find-file-other-frame) 4990 (define-key ctl-x-5-map "f" 'find-file-other-frame)
4285 (define-key ctl-x-5-map "\C-f" 'find-file-other-frame) 4991 (define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
4286 (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) 4992 (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
4287 4993
4994 ;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
4288 ;;; files.el ends here 4995 ;;; files.el ends here