Mercurial > emacs
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 |