1;;; files.el --- file input and output commands for Emacs 2 3;; Copyright (C) 1985, 86, 87, 92, 93, 94 Free Software Foundation, Inc. 4 5;; Maintainer: FSF 6 7;; This file is part of GNU Emacs. 8 9;; GNU Emacs is free software; you can redistribute it and/or modify 10;; it under the terms of the GNU General Public License as published by 11;; the Free Software Foundation; either version 2, or (at your option) 12;; any later version. 13 14;; GNU Emacs is distributed in the hope that it will be useful, 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;; GNU General Public License for more details. 18 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs; see the file COPYING. If not, write to 21;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 23;;; Commentary: 24 25;; Defines most of Emacs's file- and directory-handling functions, 26;; including basic file visiting, backup generation, link handling, 27;; ITS-id version control, load- and write-hook handling, and the like. 28 29;;; Code: 30 31(defconst delete-auto-save-files t 32 "*Non-nil means delete a buffer's auto-save file when the buffer is saved.") 33 34(defconst directory-abbrev-alist 35 nil 36 "*Alist of abbreviations for file directories. 37A list of elements of the form (FROM . TO), each meaning to replace 38FROM with TO when it appears in a directory name. This replacement is 39done when setting up the default directory of a newly visited file. 40*Every* FROM string should start with `^'. 41 42Do not use `~' in the TO strings. 43They should be ordinary absolute directory names. 44 45Use this feature when you have directories which you normally refer to 46via absolute symbolic links. Make TO the name of the link, and FROM 47the name it is linked to.") 48 49;;; Turn off backup files on VMS since it has version numbers. 50(defconst make-backup-files (not (eq system-type 'vax-vms)) 51 "*Non-nil means make a backup of a file the first time it is saved. 52This can be done by renaming the file or by copying. 53 54Renaming means that Emacs renames the existing file so that it is a 55backup file, then writes the buffer into a new file. Any other names 56that the old file had will now refer to the backup file. The new file 57is owned by you and its group is defaulted. 58 59Copying means that Emacs copies the existing file into the backup 60file, then writes the buffer on top of the existing file. Any other 61names that the old file had will now refer to the new (edited) file. 62The file's owner and group are unchanged. 63 64The choice of renaming or copying is controlled by the variables 65`backup-by-copying', `backup-by-copying-when-linked' and 66`backup-by-copying-when-mismatch'. See also `backup-inhibited'.") 67 68;; Do this so that local variables based on the file name 69;; are not overridden by the major mode. 70(defvar backup-inhibited nil 71 "Non-nil means don't make a backup, regardless of the other parameters. 72This variable is intended for use by making it local to a buffer. 73But it is local only if you make it local.") 74(put 'backup-inhibited 'permanent-local t) 75 76(defconst backup-by-copying nil 77 "*Non-nil means always use copying to create backup files. 78See documentation of variable `make-backup-files'.") 79 80(defconst backup-by-copying-when-linked nil 81 "*Non-nil means use copying to create backups for files with multiple names. 82This causes the alternate names to refer to the latest version as edited. 83This variable is relevant only if `backup-by-copying' is nil.") 84 85(defconst backup-by-copying-when-mismatch nil 86 "*Non-nil means create backups by copying if this preserves owner or group. 87Renaming may still be used (subject to control of other variables) 88when it would not result in changing the owner or group of the file; 89that is, for files which are owned by you and whose group matches 90the default for a new file created there by you. 91This variable is relevant only if `backup-by-copying' is nil.") 92 93(defvar backup-enable-predicate 94 '(lambda (name) 95 (or (< (length name) 5) 96 (not (string-equal "/tmp/" (substring name 0 5))))) 97 "Predicate that looks at a file name and decides whether to make backups. 98Called with an absolute file name as argument, it returns t to enable backup.") 99 100(defconst buffer-offer-save nil 101 "*Non-nil in a buffer means offer to save the buffer on exit 102even if the buffer is not visiting a file. 103Automatically local in all buffers.") 104(make-variable-buffer-local 'buffer-offer-save) 105 106(defconst find-file-existing-other-name nil 107 "*Non-nil means find a file under alternative names, in existing buffers. 108This means if any existing buffer is visiting the file you want 109under another name, you get the existing buffer instead of a new buffer.") 110 111(defconst find-file-visit-truename nil 112 "*Non-nil means visit a file under its truename. 113The truename of a file is found by chasing all links 114both at the file level and at the levels of the containing directories.") 115 116(defvar buffer-file-truename nil 117 "The abbreviated truename of the file visited in the current buffer. 118That is, (abbreviated-file-name (file-truename buffer-file-name)). 119This variable is automatically local in all buffers, when non-nil.") 120(make-variable-buffer-local 'buffer-file-truename) 121(put 'buffer-file-truename 'permanent-local t) 122 123(defvar buffer-file-number nil 124 "The device number and file number of the file visited in the current buffer. 125The value is a list of the form (FILENUM DEVNUM). 126This pair of numbers uniquely identifies the file. 127If the buffer is visiting a new file, the value is nil.") 128(make-variable-buffer-local 'buffer-file-number) 129(put 'buffer-file-number 'permanent-local t) 130 131(defconst file-precious-flag nil 132 "*Non-nil means protect against I/O errors while saving files. 133Some modes set this non-nil in particular buffers.") 134 135(defvar version-control nil 136 "*Control use of version numbers for backup files. 137t means make numeric backup versions unconditionally. 138nil means make them for files that have some already. 139`never' means do not make them.") 140 141(defvar dired-kept-versions 2 142 "*When cleaning directory, number of versions to keep.") 143 144(defvar trim-versions-without-asking nil 145 "*If t, deletes excess backup versions silently. 146If nil, asks confirmation. Any other value prevents any trimming.") 147 148(defvar kept-old-versions 2 149 "*Number of oldest versions to keep when a new numbered backup is made.") 150 151(defvar kept-new-versions 2 152 "*Number of newest versions to keep when a new numbered backup is made. 153Includes the new backup. Must be > 0") 154 155(defconst require-final-newline nil 156 "*Value of t says silently ensure a file ends in a newline when it is saved. 157Non-nil but not t says ask user whether to add a newline when there isn't one. 158nil means don't add newlines.") 159 160(defconst auto-save-default t 161 "*Non-nil says by default do auto-saving of every file-visiting buffer.") 162 163(defconst auto-save-visited-file-name nil 164 "*Non-nil says auto-save a buffer in the file it is visiting, when practical. 165Normally auto-save files are written under other names.") 166 167(defconst save-abbrevs nil 168 "*Non-nil means save word abbrevs too when files are saved. 169Loading an abbrev file sets this to t.") 170 171(defconst find-file-run-dired t 172 "*Non-nil says run dired if `find-file' is given the name of a directory.") 173 174;;;It is not useful to make this a local variable. 175;;;(put 'find-file-not-found-hooks 'permanent-local t) 176(defvar find-file-not-found-hooks nil 177 "List of functions to be called for `find-file' on nonexistent file. 178These functions are called as soon as the error is detected. 179`buffer-file-name' is already set up. 180The functions are called in the order given until one of them returns non-nil.") 181 182;;;It is not useful to make this a local variable. 183;;;(put 'find-file-hooks 'permanent-local t) 184(defvar find-file-hooks nil 185 "List of functions to be called after a buffer is loaded from a file. 186The buffer's local variables (if any) will have been processed before the 187functions are called.") 188 189(defvar write-file-hooks nil 190 "List of functions to be called before writing out a buffer to a file. 191If one of them returns non-nil, the file is considered already written 192and the rest are not called. 193These hooks are considered to pertain to the visited file. 194So this list is cleared if you change the visited file name. 195See also `write-contents-hooks'. 196Don't make this variable buffer-local; instead, use `local-write-file-hooks'.") 197;;; However, in case someone does make it local... 198(put 'write-file-hooks 'permanent-local t) 199 200(defvar local-write-file-hooks nil 201 "Just like `write-file-hooks', except intended for per-buffer use. 202The functions in this list are called before the ones in 203`write-file-hooks'.") 204(make-variable-buffer-local 'local-write-file-hooks) 205(put 'local-write-file-hooks 'permanent-local t) 206 207(defvar write-contents-hooks nil 208 "List of functions to be called before writing out a buffer to a file. 209If one of them returns non-nil, the file is considered already written 210and the rest are not called. 211These hooks are considered to pertain to the buffer's contents, 212not to the particular visited file; thus, `set-visited-file-name' does 213not clear this variable, but changing the major mode does clear it. 214See also `write-file-hooks'.") 215 216(defconst enable-local-variables t 217 "*Control use of local-variables lists in files you visit. 218The value can be t, nil or something else. 219A value of t means local-variables lists are obeyed; 220nil means they are ignored; anything else means query. 221 222The command \\[normal-mode] always obeys local-variables lists 223and ignores this variable.") 224 225(defconst enable-local-eval 'maybe 226 "*Control processing of the \"variable\" `eval' in a file's local variables. 227The value can be t, nil or something else. 228A value of t means obey `eval' variables; 229nil means ignore them; anything else means query. 230 231The command \\[normal-mode] always obeys local-variables lists 232and ignores this variable.") 233 234;; Avoid losing in versions where CLASH_DETECTION is disabled. 235(or (fboundp 'lock-buffer) 236 (defalias 'lock-buffer 'ignore)) 237(or (fboundp 'unlock-buffer) 238 (defalias 'unlock-buffer 'ignore)) 239 240;; This hook function provides support for ange-ftp host name 241;; completion. It runs the usual ange-ftp hook, but only for 242;; completion operations. Having this here avoids the need 243;; to load ange-ftp when it's not really in use. 244(defun ange-ftp-completion-hook-function (op &rest args) 245 (if (memq op '(file-name-completion file-name-all-completions)) 246 (apply 'ange-ftp-hook-function op args) 247 (let ((inhibit-file-name-handlers 248 (cons 'ange-ftp-completion-hook-function 249 (and (eq inhibit-file-name-operation op) 250 inhibit-file-name-handlers))) 251 (inhibit-file-name-operation op)) 252 (apply op args)))) 253 254(defun pwd () 255 "Show the current default directory." 256 (interactive nil) 257 (message "Directory %s" default-directory)) 258 259(defvar cd-path nil 260 "Value of the CDPATH environment variable, as a list. 261Not actually set up until the first time you you use it.") 262 263(defun parse-colon-path (cd-path) 264 "Explode a colon-separated list of paths into a string list." 265 (and cd-path 266 (let (cd-prefix cd-list (cd-start 0) cd-colon) 267 (setq cd-path (concat cd-path ":")) 268 (while (setq cd-colon (string-match ":" cd-path cd-start)) 269 (setq cd-list 270 (nconc cd-list 271 (list (if (= cd-start cd-colon) 272 nil 273 (substitute-in-file-name 274 (file-name-as-directory 275 (substring cd-path cd-start cd-colon))))))) 276 (setq cd-start (+ cd-colon 1))) 277 cd-list))) 278 279(defun cd-absolute (dir) 280 "Change current directory to given absolute file name DIR." 281 (setq dir (abbreviate-file-name (expand-file-name dir))) 282 (if (not (eq system-type 'vax-vms)) 283 (setq dir (file-name-as-directory dir))) 284 (if (not (file-directory-p dir)) 285 (error "%s is not a directory" dir) 286 (if (file-executable-p dir) 287 (setq default-directory dir) 288 (error "Cannot cd to %s: Permission denied" dir)))) 289 290(defun cd (dir) 291 "Make DIR become the current buffer's default directory. 292If your environment includes a `CDPATH' variable, try each one of that 293colon-separated list of directories when resolving a relative directory name." 294 (interactive "FChange default directory: ") 295 (if (file-name-absolute-p dir) 296 (cd-absolute (expand-file-name dir)) 297 (if (null cd-path) 298 (let ((trypath (parse-colon-path (getenv "CDPATH")))) 299 (setq cd-path (or trypath (list "./"))))) 300 (if (not (catch 'found 301 (mapcar 302 (function (lambda (x) 303 (let ((f (expand-file-name (concat x dir)))) 304 (if (file-directory-p f) 305 (progn 306 (cd-absolute f) 307 (throw 'found t)))))) 308 cd-path) 309 nil)) 310 (error "No such directory found via CDPATH environment variable")))) 311 312(defun load-file (file) 313 "Load the Lisp file named FILE." 314 (interactive "fLoad file: ") 315 (load (expand-file-name file) nil nil t)) 316 317(defun load-library (library) 318 "Load the library named LIBRARY. 319This is an interface to the function `load'." 320 (interactive "sLoad library: ") 321 (load library)) 322 323(defun file-local-copy (file &optional buffer) 324 "Copy the file FILE into a temporary file on this machine. 325Returns the name of the local copy, or nil, if FILE is directly 326accessible." 327 (let ((handler (find-file-name-handler file 'file-local-copy))) 328 (if handler 329 (funcall handler 'file-local-copy file) 330 nil))) 331 332(defun file-truename (filename) 333 "Return the truename of FILENAME, which should be absolute. 334The truename of a file name is found by chasing symbolic links 335both at the level of the file and at the level of the directories 336containing it, until no links are left at any level." 337 (if (or (string= filename "~") 338 (and (string= (substring filename 0 1) "~") 339 (string-match "~[^/]*" filename))) 340 (progn 341 (setq filename (expand-file-name filename)) 342 (if (string= filename "") 343 (setq filename "/")))) 344 (let ((handler (find-file-name-handler filename 'file-truename))) 345 ;; For file name that has a special handler, call handler. 346 ;; This is so that ange-ftp can save time by doing a no-op. 347 (if handler 348 (funcall handler 'file-truename filename) 349 (let ((dir (file-name-directory filename)) 350 target dirfile) 351 ;; Get the truename of the directory. 352 (setq dirfile (directory-file-name dir)) 353 ;; If these are equal, we have the (or a) root directory. 354 (or (string= dir dirfile) 355 (setq dir (file-name-as-directory (file-truename dirfile)))) 356 (if (equal ".." (file-name-nondirectory filename)) 357 (directory-file-name (file-name-directory (directory-file-name dir))) 358 (if (equal "." (file-name-nondirectory filename)) 359 (directory-file-name dir) 360 ;; Put it back on the file name. 361 (setq filename (concat dir (file-name-nondirectory filename))) 362 ;; Is the file name the name of a link? 363 (setq target (file-symlink-p filename)) 364 (if target 365 ;; Yes => chase that link, then start all over 366 ;; since the link may point to a directory name that uses links. 367 ;; We can't safely use expand-file-name here 368 ;; since target might look like foo/../bar where foo 369 ;; is itself a link. Instead, we handle . and .. above. 370 (if (file-name-absolute-p target) 371 (file-truename target) 372 (file-truename (concat dir target))) 373 ;; No, we are done! 374 filename))))))) 375 376(defun file-chase-links (filename) 377 "Chase links in FILENAME until a name that is not a link. 378Does not examine containing directories for links, 379unlike `file-truename'." 380 (let (tem (count 100) (newname filename)) 381 (while (setq tem (file-symlink-p newname)) 382 (if (= count 0) 383 (error "Apparent cycle of symbolic links for %s" filename)) 384 ;; In the context of a link, `//' doesn't mean what Emacs thinks. 385 (while (string-match "//+" tem) 386 (setq tem (concat (substring tem 0 (1+ (match-beginning 0))) 387 (substring tem (match-end 0))))) 388 ;; Handle `..' by hand, since it needs to work in the 389 ;; target of any directory symlink. 390 ;; This code is not quite complete; it does not handle 391 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. 392 (while (string-match "\\`\\.\\./" tem) 393 (setq tem (substring tem 3)) 394 (setq newname (file-name-as-directory 395 ;; Do the .. by hand. 396 (directory-file-name 397 (file-name-directory 398 ;; Chase links in the default dir of the symlink. 399 (file-chase-links 400 (directory-file-name 401 (file-name-directory newname)))))))) 402 (setq newname (expand-file-name tem (file-name-directory newname))) 403 (setq count (1- count))) 404 newname)) 405 406(defun switch-to-buffer-other-window (buffer) 407 "Select buffer BUFFER in another window." 408 (interactive "BSwitch to buffer in other window: ") 409 (let ((pop-up-windows t)) 410 (pop-to-buffer buffer t))) 411 412(defun switch-to-buffer-other-frame (buffer) 413 "Switch to buffer BUFFER in another frame." 414 (interactive "BSwitch to buffer in other frame: ") 415 (let ((pop-up-frames t)) 416 (pop-to-buffer buffer t))) 417 418(defun find-file (filename) 419 "Edit file FILENAME. 420Switch to a buffer visiting file FILENAME, 421creating one if none already exists." 422 (interactive "FFind file: ") 423 (switch-to-buffer (find-file-noselect filename))) 424 425(defun find-file-other-window (filename) 426 "Edit file FILENAME, in another window. 427May create a new window, or reuse an existing one. 428See the function `display-buffer'." 429 (interactive "FFind file in other window: ") 430 (switch-to-buffer-other-window (find-file-noselect filename))) 431 432(defun find-file-other-frame (filename) 433 "Edit file FILENAME, in another frame. 434May create a new frame, or reuse an existing one. 435See the function `display-buffer'." 436 (interactive "FFind file in other frame: ") 437 (switch-to-buffer-other-frame (find-file-noselect filename))) 438 439(defun find-file-read-only (filename) 440 "Edit file FILENAME but don't allow changes. 441Like \\[find-file] but marks buffer as read-only. 442Use \\[toggle-read-only] to permit editing." 443 (interactive "fFind file read-only: ") 444 (find-file filename) 445 (setq buffer-read-only t) 446 (current-buffer)) 447 448(defun find-file-read-only-other-window (filename) 449 "Edit file FILENAME in another window but don't allow changes. 450Like \\[find-file-other-window] but marks buffer as read-only. 451Use \\[toggle-read-only] to permit editing." 452 (interactive "fFind file read-only other window: ") 453 (find-file-other-window filename) 454 (setq buffer-read-only t) 455 (current-buffer)) 456 457(defun find-file-read-only-other-frame (filename) 458 "Edit file FILENAME in another frame but don't allow changes. 459Like \\[find-file-other-frame] but marks buffer as read-only. 460Use \\[toggle-read-only] to permit editing." 461 (interactive "fFind file read-only other frame: ") 462 (find-file-other-frame filename) 463 (setq buffer-read-only t) 464 (current-buffer)) 465 466(defun find-alternate-file (filename) 467 "Find file FILENAME, select its buffer, kill previous buffer. 468If the current buffer now contains an empty file that you just visited 469\(presumably by mistake), use this command to visit the file you really want." 470 (interactive 471 (let ((file buffer-file-name) 472 (file-name nil) 473 (file-dir nil)) 474 (and file 475 (setq file-name (file-name-nondirectory file) 476 file-dir (file-name-directory file))) 477 (list (read-file-name 478 "Find alternate file: " file-dir nil nil file-name)))) 479 (and (buffer-modified-p) 480 ;; (not buffer-read-only) 481 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? " 482 (buffer-name)))) 483 (error "Aborted")) 484 (let ((obuf (current-buffer)) 485 (ofile buffer-file-name) 486 (onum buffer-file-number) 487 (otrue buffer-file-truename) 488 (oname (buffer-name))) 489 (rename-buffer " **lose**") 490 (setq buffer-file-name nil) 491 (setq buffer-file-number nil) 492 (setq buffer-file-truename nil) 493 (unwind-protect 494 (progn 495 (unlock-buffer) 496 (find-file filename)) 497 (cond ((eq obuf (current-buffer)) 498 (setq buffer-file-name ofile) 499 (setq buffer-file-number onum) 500 (setq buffer-file-truename otrue) 501 (lock-buffer) 502 (rename-buffer oname)))) 503 (or (eq (current-buffer) obuf) 504 (kill-buffer obuf)))) 505 506(defun create-file-buffer (filename) 507 "Create a suitably named buffer for visiting FILENAME, and return it. 508FILENAME (sans directory) is used unchanged if that name is free; 509otherwise a string <2> or <3> or ... is appended to get an unused name." 510 (let ((lastname (file-name-nondirectory filename))) 511 (if (string= lastname "") 512 (setq lastname filename)) 513 (generate-new-buffer lastname))) 514 515(defun generate-new-buffer (name) 516 "Create and return a buffer with a name based on NAME. 517Choose the buffer's name using `generate-new-buffer-name'." 518 (get-buffer-create (generate-new-buffer-name name))) 519 520(defconst automount-dir-prefix "^/tmp_mnt/" 521 "Regexp to match the automounter prefix in a directory name.") 522 523(defvar abbreviated-home-dir nil 524 "The user's homedir abbreviated according to `directory-abbrev-list'.") 525 526(defun abbreviate-file-name (filename) 527 "Return a version of FILENAME shortened using `directory-abbrev-alist'. 528This also substitutes \"~\" for the user's home directory. 529Type \\[describe-variable] directory-abbrev-alist RET for more information." 530 ;; Get rid of the prefixes added by the automounter. 531 (if (and (string-match automount-dir-prefix filename) 532 (file-exists-p (file-name-directory 533 (substring filename (1- (match-end 0)))))) 534 (setq filename (substring filename (1- (match-end 0))))) 535 (let ((tail directory-abbrev-alist)) 536 ;; If any elt of directory-abbrev-alist matches this name, 537 ;; abbreviate accordingly. 538 (while tail 539 (if (string-match (car (car tail)) filename) 540 (setq filename 541 (concat (cdr (car tail)) (substring filename (match-end 0))))) 542 (setq tail (cdr tail))) 543 ;; Compute and save the abbreviated homedir name. 544 ;; We defer computing this until the first time it's needed, to 545 ;; give time for directory-abbrev-alist to be set properly. 546 ;; We include a slash at the end, to avoid spurious matches 547 ;; such as `/usr/foobar' when the home dir is `/usr/foo'. 548 (or abbreviated-home-dir 549 (setq abbreviated-home-dir 550 (let ((abbreviated-home-dir "$foo")) 551 (concat "^" (abbreviate-file-name (expand-file-name "~")) 552 "\\(/\\|$\\)")))) 553 554 ;; If FILENAME starts with the abbreviated homedir, 555 ;; make it start with `~' instead. 556 (if (and (string-match abbreviated-home-dir filename) 557 ;; If the home dir is just /, don't change it. 558 (not (and (= (match-end 0) 1) 559 (= (aref filename 0) ?/))) 560 (not (and (eq system-type 'ms-dos) 561 (save-match-data 562 (string-match "^[a-zA-Z]:/$" filename))))) 563 (setq filename 564 (concat "~" 565 (substring filename (match-beginning 1) (match-end 1)) 566 (substring filename (match-end 0))))) 567 filename)) 568 569(defvar find-file-not-true-dirname-list nil 570 "*List of logical names for which visiting shouldn't save the true dirname. 571On VMS, when you visit a file using a logical name that searches a path, 572you may or may not want the visited file name to record the specific 573directory where the file was found. If you *do not* want that, add the logical 574name to this list as a string.") 575 576(defun find-buffer-visiting (filename) 577 "Return the buffer visiting file FILENAME (a string). 578This is like `get-file-buffer', except that it checks for any buffer 579visiting the same file, possibly under a different name. 580If there is no such live buffer, return nil." 581 (let ((buf (get-file-buffer filename)) 582 (truename (abbreviate-file-name (file-truename filename)))) 583 (or buf 584 (let ((list (buffer-list)) found) 585 (while (and (not found) list) 586 (save-excursion 587 (set-buffer (car list)) 588 (if (and buffer-file-name 589 (string= buffer-file-truename truename)) 590 (setq found (car list)))) 591 (setq list (cdr list))) 592 found) 593 (let ((number (nthcdr 10 (file-attributes truename))) 594 (list (buffer-list)) found) 595 (and number 596 (while (and (not found) list) 597 (save-excursion 598 (set-buffer (car list)) 599 (if (and buffer-file-name 600 (equal buffer-file-number number) 601 ;; Verify this buffer's file number 602 ;; still belongs to its file. 603 (file-exists-p buffer-file-name) 604 (equal (nthcdr 10 (file-attributes buffer-file-name)) 605 number)) 606 (setq found (car list)))) 607 (setq list (cdr list)))) 608 found)))) 609 610(defun find-file-noselect (filename &optional nowarn) 611 "Read file FILENAME into a buffer and return the buffer. 612If a buffer exists visiting FILENAME, return that one, but 613verify that the file has not changed since visited or saved. 614The buffer is not selected, just returned to the caller." 615 (setq filename 616 (abbreviate-file-name 617 (expand-file-name filename))) 618 (if (file-directory-p filename) 619 (if find-file-run-dired 620 (dired-noselect filename) 621 (error "%s is a directory." filename)) 622 (let* ((buf (get-file-buffer filename)) 623 (truename (abbreviate-file-name (file-truename filename))) 624 (number (nthcdr 10 (file-attributes truename))) 625 ;; Find any buffer for a file which has same truename. 626 (other (and (not buf) (find-buffer-visiting filename))) 627 error) 628 ;; Let user know if there is a buffer with the same truename. 629 (if other 630 (progn 631 (or nowarn 632 (string-equal filename (buffer-file-name other)) 633 (message "%s and %s are the same file" 634 filename (buffer-file-name other))) 635 ;; Optionally also find that buffer. 636 (if (or find-file-existing-other-name find-file-visit-truename) 637 (setq buf other)))) 638 (if buf 639 (or nowarn 640 (verify-visited-file-modtime buf) 641 (cond ((not (file-exists-p filename)) 642 (error "File %s no longer exists!" filename)) 643 ((yes-or-no-p 644 (format 645 (if (buffer-modified-p buf) 646 "File %s changed on disk. Discard your edits? " 647 "File %s changed on disk. Read the new version? ") 648 (file-name-nondirectory filename))) 649 (save-excursion 650 (set-buffer buf) 651 (revert-buffer t t))))) 652 (save-excursion 653;;; The truename stuff makes this obsolete. 654;;; (let* ((link-name (car (file-attributes filename))) 655;;; (linked-buf (and (stringp link-name) 656;;; (get-file-buffer link-name)))) 657;;; (if (bufferp linked-buf) 658;;; (message "Symbolic link to file in buffer %s" 659;;; (buffer-name linked-buf)))) 660 (setq buf (create-file-buffer filename)) 661 (set-buffer buf) 662 (erase-buffer) 663 (condition-case () 664 (insert-file-contents filename t) 665 (file-error 666 (setq error t) 667 ;; Run find-file-not-found-hooks until one returns non-nil. 668 (let ((hooks find-file-not-found-hooks)) 669 (while (and hooks 670 (not (and (funcall (car hooks)) 671 ;; If a hook succeeded, clear error. 672 (progn (setq error nil) 673 ;; Also exit the loop. 674 t)))) 675 (setq hooks (cdr hooks)))))) 676 ;; Find the file's truename, and maybe use that as visited name. 677 (setq buffer-file-truename truename) 678 (setq buffer-file-number number) 679 ;; On VMS, we may want to remember which directory in a search list 680 ;; the file was found in. 681 (and (eq system-type 'vax-vms) 682 (let (logical) 683 (if (string-match ":" (file-name-directory filename)) 684 (setq logical (substring (file-name-directory filename) 685 0 (match-beginning 0)))) 686 (not (member logical find-file-not-true-dirname-list))) 687 (setq buffer-file-name buffer-file-truename)) 688 (if find-file-visit-truename 689 (setq buffer-file-name 690 (setq filename 691 (expand-file-name buffer-file-truename)))) 692 ;; Set buffer's default directory to that of the file. 693 (setq default-directory (file-name-directory filename)) 694 ;; Turn off backup files for certain file names. Since 695 ;; this is a permanent local, the major mode won't eliminate it. 696 (and (not (funcall backup-enable-predicate buffer-file-name)) 697 (progn 698 (make-local-variable 'backup-inhibited) 699 (setq backup-inhibited t))) 700 (after-find-file error (not nowarn)))) 701 buf))) 702 703(defun after-find-file (&optional error warn noauto) 704 "Called after finding a file and by the default revert function. 705Sets buffer mode, parses local variables. 706Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an 707error in reading the file. WARN non-nil means warn if there 708exists an auto-save file more recent than the visited file. 709NOAUTO means don't mess with auto-save mode. 710Finishes by calling the functions in `find-file-hooks'." 711 (setq buffer-read-only (not (file-writable-p buffer-file-name))) 712 (if noninteractive 713 nil 714 (let* (not-serious 715 (msg 716 (cond ((and error (file-attributes buffer-file-name)) 717 (setq buffer-read-only t) 718 "File exists, but cannot be read.") 719 ((not buffer-read-only) 720 (if (and warn 721 (file-newer-than-file-p (make-auto-save-file-name) 722 buffer-file-name)) 723 "Auto save file is newer; consider M-x recover-file" 724 (setq not-serious t) 725 (if error "(New file)" nil))) 726 ((not error) 727 (setq not-serious t) 728 "Note: file is write protected") 729 ((file-attributes (directory-file-name default-directory)) 730 "File not found and directory write-protected") 731 ((file-exists-p (file-name-directory buffer-file-name)) 732 (setq buffer-read-only nil)) 733 (t 734 (setq buffer-read-only nil) 735 (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name)))) 736 "Use M-x make-dir RET RET to create the directory" 737 "Use C-u M-x make-dir RET RET to create directory and its parents"))))) 738 (if msg 739 (progn 740 (message msg) 741 (or not-serious (sit-for 1 nil t))))) 742 (if (and auto-save-default (not noauto)) 743 (auto-save-mode t))) 744 (normal-mode t) 745 (mapcar 'funcall find-file-hooks)) 746 747(defun normal-mode (&optional find-file) 748 "Choose the major mode for this buffer automatically. 749Also sets up any specified local variables of the file. 750Uses the visited file name, the -*- line, and the local variables spec. 751 752This function is called automatically from `find-file'. In that case, 753we may set up specified local variables depending on the value of 754`enable-local-variables': if it is t, we do; if it is nil, we don't; 755otherwise, we query. `enable-local-variables' is ignored if you 756run `normal-mode' explicitly." 757 (interactive) 758 (or find-file (funcall (or default-major-mode 'fundamental-mode))) 759 (condition-case err 760 (set-auto-mode) 761 (error (message "File mode specification error: %s" 762 (prin1-to-string err)))) 763 (condition-case err 764 (let ((enable-local-variables (or (not find-file) 765 enable-local-variables))) 766 (hack-local-variables)) 767 (error (message "File local-variables error: %s" 768 (prin1-to-string err))))) 769 770(defvar auto-mode-alist (mapcar 'purecopy 771 '(("\\.text\\'" . text-mode) 772 ("\\.c\\'" . c-mode) 773 ("\\.h\\'" . c-mode) 774 ("\\.tex\\'" . TeX-mode) 775 ("\\.ltx\\'" . LaTeX-mode) 776 ("\\.el\\'" . emacs-lisp-mode) 777 ("\\.mm\\'" . nroff-mode) 778 ("\\.me\\'" . nroff-mode) 779 ("\\.ms\\'" . nroff-mode) 780 ("\\.man\\'" . nroff-mode) 781 ("\\.scm\\'" . scheme-mode) 782 ("\\.l\\'" . lisp-mode) 783 ("\\.lisp\\'" . lisp-mode) 784 ("\\.f\\'" . fortran-mode) 785 ("\\.for\\'" . fortran-mode) 786 ("\\.p\\'" . pascal-mode) 787 ("\\.pas\\'" . pascal-mode) 788 ("\\.mss\\'" . scribe-mode) 789 ("\\.pl\\'" . prolog-mode) 790 ("\\.cc\\'" . c++-mode) 791 ("\\.hh\\'" . c++-mode) 792 ("\\.C\\'" . c++-mode) 793 ("\\.H\\'" . c++-mode) 794;;; ("\\.mk\\'" . makefile-mode) 795;;; ("[Mm]akefile" . makefile-mode) 796;;; Less common extensions come here 797;;; so more common ones above are found faster. 798 ("\\.texinfo\\'" . texinfo-mode) 799 ("\\.texi\\'" . texinfo-mode) 800 ("\\.s\\'" . asm-mode) 801 ("ChangeLog\\'" . change-log-mode) 802 ("change.log\\'" . change-log-mode) 803 ("changelo\\'" . change-log-mode) 804 ("ChangeLog.[0-9]+\\'" . change-log-mode) 805 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) 806;; The following should come after the ChangeLog pattern 807;; for the sake of ChangeLog.1, etc. 808 ("\\.[12345678]\\'" . nroff-mode) 809 ("\\.TeX\\'" . TeX-mode) 810 ("\\.sty\\'" . LaTeX-mode) 811 ("\\.bbl\\'" . LaTeX-mode) 812 ("\\.bib\\'" . bibtex-mode) 813 ("\\.article\\'" . text-mode) 814 ("\\.letter\\'" . text-mode) 815 ("\\.tcl\\'" . tcl-mode) 816 ("\\.lsp\\'" . lisp-mode) 817 ("\\.awk\\'" . awk-mode) 818 ("\\.prolog\\'" . prolog-mode) 819 ("\\.tar\\'" . tar-mode) 820 ;; Mailer puts message to be edited in 821 ;; /tmp/Re.... or Message 822 ("^/tmp/Re" . text-mode) 823 ("/Message[0-9]*\\'" . text-mode) 824 ;; some news reader is reported to use this 825 ("^/tmp/fol/" . text-mode) 826 ("\\.y\\'" . c-mode) 827 ("\\.lex\\'" . c-mode) 828 ("\\.oak\\'" . scheme-mode) 829 ("\\.scm.[0-9]*\\'" . scheme-mode) 830 ("\\.sgm\\'" . sgml-mode) 831 ("\\.sgml\\'" . sgml-mode) 832 ("\\.dtd\\'" . sgml-mode) 833 ;; .emacs following a directory delimiter 834 ;; in either Unix or VMS syntax. 835 ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) 836 ;; _emacs following a directory delimiter 837 ;; in MsDos syntax 838 ("[:/]_emacs\\'" . emacs-lisp-mode) 839 ("\\.ml\\'" . lisp-mode))) 840 "\ 841Alist of filename patterns vs corresponding major mode functions. 842Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION). 843Visiting a file whose name matches REGEXP causes FUNCTION to be called. 844If the element has the form (REGEXP FUNCTION), then after calling 845FUNCTION, we delete the suffix that matched REGEXP and search the list 846again for another match.") 847 848(defconst interpreter-mode-alist 849 '(("perl" . perl-mode) 850 ("wish" . tcl-mode) 851 ("wishx" . tcl-mode) 852 ("tcl" . tcl-mode) 853 ("tclsh" . tcl-mode) 854 ("awk" . awk-mode) 855 ("gawk" . awk-mode) 856 ("scm" . scheme-mode)) 857 "Alist mapping interpreter names to major modes. 858This alist applies to files whose first line starts with `#!'. 859Each element looks like (INTERPRETER . MODE). 860The car of each element is compared with 861the name of the interpreter specified in the first line. 862If it matches, mode MODE is selected.") 863 864(defconst inhibit-first-line-modes-regexps '("\\.tar$") 865 "List of regexps; if one matches a file name, don't look for `-*-'.") 866 867(defvar user-init-file 868 "" ; set by command-line 869 "File name including directory of user's initialization file.") 870 871(defun set-auto-mode () 872 "Select major mode appropriate for current buffer. 873This checks for a -*- mode tag in the buffer's text, 874compares the filename against the entries in `auto-mode-alist', 875or checks the interpreter that runs this file against 876`interpreter-mode-alist'. 877 878It does not check for the `mode:' local variable in the 879Local Variables section of the file; for that, use `hack-local-variables'. 880 881If `enable-local-variables' is nil, this function does not check for a 882-*- mode tag." 883 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- 884 (let (beg end done) 885 (save-excursion 886 (goto-char (point-min)) 887 (skip-chars-forward " \t\n") 888 (and enable-local-variables 889 ;; Don't look for -*- if this file name matches any 890 ;; of the regexps in inhibit-first-line-modes-regexps. 891 (let ((temp inhibit-first-line-modes-regexps)) 892 (while (and temp 893 (not (string-match (car temp) 894 buffer-file-name))) 895 (setq temp (cdr temp))) 896 (not temp)) 897 (search-forward "-*-" (save-excursion 898 ;; If the file begins with "#!" 899 ;; (exec interpreter magic), look 900 ;; for mode frobs in the first two 901 ;; lines. You cannot necessarily 902 ;; put them in the first line of 903 ;; such a file without screwing up 904 ;; the interpreter invocation. 905 (end-of-line (and (looking-at "^#!") 2)) 906 (point)) t) 907 (progn 908 (skip-chars-forward " \t") 909 (setq beg (point)) 910 (search-forward "-*-" 911 (save-excursion (end-of-line) (point)) 912 t)) 913 (progn 914 (forward-char -3) 915 (skip-chars-backward " \t") 916 (setq end (point)) 917 (goto-char beg) 918 (if (save-excursion (search-forward ":" end t)) 919 ;; Find all specifications for the `mode:' variable 920 ;; and execute them left to right. 921 (while (let ((case-fold-search t)) 922 (search-forward "mode:" end t)) 923 (skip-chars-forward " \t") 924 (setq beg (point)) 925 (if (search-forward ";" end t) 926 (forward-char -1) 927 (goto-char end)) 928 (skip-chars-backward " \t") 929 (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode")))) 930 ;; Simple -*-MODE-*- case. 931 (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode")))) 932 (setq done t))) 933 ;; If we didn't find a mode from a -*- line, try using the file name. 934 (if (and (not done) buffer-file-name) 935 (let ((name buffer-file-name) 936 (case-fold-search (eq system-type 'vax-vms)) 937 (keep-going t)) 938 ;; Remove backup-suffixes from file name. 939 (setq name (file-name-sans-versions name)) 940 (while keep-going 941 (setq keep-going nil) 942 (let ((alist auto-mode-alist) 943 (mode nil)) 944 ;; Find first matching alist entry. 945 (while (and (not mode) alist) 946 (if (string-match (car (car alist)) name) 947 (if (and (consp (cdr (car alist))) 948 (nth 2 (car alist))) 949 (progn 950 (setq mode (car (cdr (car alist))) 951 name (substring name 0 (match-beginning 0)) 952 keep-going t)) 953 (setq mode (cdr (car alist)) 954 keep-going nil))) 955 (setq alist (cdr alist))) 956 (if mode 957 (funcall mode) 958 ;; If we can't deduce a mode from the file name, 959 ;; look for an interpreter specified in the first line. 960 (let ((interpreter 961 (save-excursion 962 (goto-char (point-min)) 963 (if (looking-at "#! *\\([^ \t\n]+\\)") 964 (buffer-substring (match-beginning 1) 965 (match-end 1)) 966 ""))) 967 elt) 968 ;; Map interpreter name to a mode. 969 (setq elt (assoc (file-name-nondirectory interpreter) 970 interpreter-mode-alist)) 971 (if elt 972 (funcall (cdr elt)))))))))))) 973 974(defun hack-local-variables-prop-line () 975 ;; Set local variables specified in the -*- line. 976 ;; Ignore any specification for `mode:'; 977 ;; set-auto-mode should already have handled that. 978 (save-excursion 979 (goto-char (point-min)) 980 (let ((result nil) 981 (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point)))) 982 ;; Parse the -*- line into the `result' alist. 983 (cond ((not (search-forward "-*-" end t)) 984 ;; doesn't have one. 985 nil) 986 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") 987 ;; Simple form: "-*- MODENAME -*-". Already handled. 988 nil) 989 (t 990 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' 991 ;; (last ";" is optional). 992 (save-excursion 993 (if (search-forward "-*-" end t) 994 (setq end (- (point) 3)) 995 (error "-*- not terminated before end of line"))) 996 (while (< (point) end) 997 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") 998 (error "malformed -*- line")) 999 (goto-char (match-end 0)) 1000 (let ((key (intern (downcase (buffer-substring 1001 (match-beginning 1) 1002 (match-end 1))))) 1003 (val (save-restriction 1004 (narrow-to-region (point) end) 1005 (read (current-buffer))))) 1006 (or (eq key 'mode) 1007 (setq result (cons (cons key val) result))) 1008 (skip-chars-forward " \t;"))) 1009 (setq result (nreverse result)))) 1010 1011 (if (and result 1012 (or (eq enable-local-variables t) 1013 (and enable-local-variables 1014 (save-window-excursion 1015 (condition-case nil 1016 (switch-to-buffer (current-buffer)) 1017 (error 1018 ;; If we fail to switch in the selected window, 1019 ;; it is probably a minibuffer. 1020 ;; So try another window. 1021 (condition-case nil 1022 (switch-to-buffer-other-window (current-buffer)) 1023 (error 1024 (switch-to-buffer-other-frame (current-buffer)))))) 1025 (y-or-n-p (format "Set local variables as specified in -*- line of %s? " 1026 (file-name-nondirectory buffer-file-name))))))) 1027 (while result 1028 (hack-one-local-variable (car (car result)) (cdr (car result))) 1029 (setq result (cdr result))))))) 1030 1031(defun hack-local-variables () 1032 "Parse and put into effect this buffer's local variables spec." 1033 (hack-local-variables-prop-line) 1034 ;; Look for "Local variables:" line in last page. 1035 (save-excursion 1036 (goto-char (point-max)) 1037 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) 1038 (if (let ((case-fold-search t)) 1039 (and (search-forward "Local Variables:" nil t) 1040 (or (eq enable-local-variables t) 1041 (and enable-local-variables 1042 (save-window-excursion 1043 (switch-to-buffer (current-buffer)) 1044 (save-excursion 1045 (beginning-of-line) 1046 (set-window-start (selected-window) (point))) 1047 (y-or-n-p (format "Set local variables as specified at end of %s? " 1048 (if buffer-file-name 1049 (file-name-nondirectory 1050 buffer-file-name) 1051 (concat "buffer " 1052 (buffer-name)))))))))) 1053 (let ((continue t) 1054 prefix prefixlen suffix beg 1055 (enable-local-eval enable-local-eval)) 1056 ;; The prefix is what comes before "local variables:" in its line. 1057 ;; The suffix is what comes after "local variables:" in its line. 1058 (skip-chars-forward " \t") 1059 (or (eolp) 1060 (setq suffix (buffer-substring (point) 1061 (progn (end-of-line) (point))))) 1062 (goto-char (match-beginning 0)) 1063 (or (bolp) 1064 (setq prefix 1065 (buffer-substring (point) 1066 (progn (beginning-of-line) (point))))) 1067 1068 (if prefix (setq prefixlen (length prefix) 1069 prefix (regexp-quote prefix))) 1070 (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) 1071 (while continue 1072 ;; Look at next local variable spec. 1073 (if selective-display (re-search-forward "[\n\C-m]") 1074 (forward-line 1)) 1075 ;; Skip the prefix, if any. 1076 (if prefix 1077 (if (looking-at prefix) 1078 (forward-char prefixlen) 1079 (error "Local variables entry is missing the prefix"))) 1080 ;; Find the variable name; strip whitespace. 1081 (skip-chars-forward " \t") 1082 (setq beg (point)) 1083 (skip-chars-forward "^:\n") 1084 (if (eolp) (error "Missing colon in local variables entry")) 1085 (skip-chars-backward " \t") 1086 (let* ((str (buffer-substring beg (point))) 1087 (var (read str)) 1088 val) 1089 ;; Setting variable named "end" means end of list. 1090 (if (string-equal (downcase str) "end") 1091 (setq continue nil) 1092 ;; Otherwise read the variable value. 1093 (skip-chars-forward "^:") 1094 (forward-char 1) 1095 (setq val (read (current-buffer))) 1096 (skip-chars-backward "\n") 1097 (skip-chars-forward " \t") 1098 (or (if suffix (looking-at suffix) (eolp)) 1099 (error "Local variables entry is terminated incorrectly")) 1100 ;; Set the variable. "Variables" mode and eval are funny. 1101 (hack-one-local-variable var val)))))))) 1102 1103(defconst ignored-local-variables 1104 '(enable-local-eval) 1105 "Variables to be ignored in a file's local variable spec.") 1106 1107;; Get confirmation before setting these variables as locals in a file. 1108(put 'enable-local-eval 'risky-local-variable t) 1109(put 'eval 'risky-local-variable t) 1110(put 'file-name-handler-alist 'risky-local-variable t) 1111(put 'minor-mode-map-alist 'risky-local-variable t) 1112(put 'after-load-alist 'risky-local-variable t) 1113(put 'buffer-file-name 'risky-local-variable t) 1114(put 'buffer-auto-save-file-name 'risky-local-variable t) 1115(put 'buffer-file-truename 'risky-local-variable t) 1116 1117(defun hack-one-local-variable-quotep (exp) 1118 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) 1119 1120;; "Set" one variable in a local variables spec. 1121;; A few variable names are treated specially. 1122(defun hack-one-local-variable (var val) 1123 (cond ((eq var 'mode) 1124 (funcall (intern (concat (downcase (symbol-name val)) 1125 "-mode")))) 1126 ((memq var ignored-local-variables) 1127 nil) 1128 ;; "Setting" eval means either eval it or do nothing. 1129 ;; Likewise for setting hook variables. 1130 ((or (get var 'risky-local-variable) 1131 (string-match "-hooks?$\\|-functions?$\\|-forms?$" 1132 (symbol-name var))) 1133 ;; Permit evaling a put of a harmless property 1134 ;; if the args do nothing tricky. 1135 (if (or (and (eq var 'eval) 1136 (consp val) 1137 (eq (car val) 'put) 1138 (hack-one-local-variable-quotep (nth 1 val)) 1139 (hack-one-local-variable-quotep (nth 2 val)) 1140 ;; Only allow safe values of lisp-indent-hook; 1141 ;; not functions. 1142 (or (numberp (nth 3 val)) 1143 (equal (nth 3 val) ''defun)) 1144 (memq (nth 1 (nth 2 val)) 1145 '(lisp-indent-hook))) 1146 ;; Permit eval if not root and user says ok. 1147 (and (not (string= (user-login-name) "root")) 1148 (or (eq enable-local-eval t) 1149 (and enable-local-eval 1150 (save-window-excursion 1151 (switch-to-buffer (current-buffer)) 1152 (save-excursion 1153 (beginning-of-line) 1154 (set-window-start (selected-window) (point))) 1155 (setq enable-local-eval 1156 (y-or-n-p (format "Process `eval' or hook local variables in file %s? " 1157 (file-name-nondirectory buffer-file-name))))))))) 1158 (if (eq var 'eval) 1159 (save-excursion (eval val)) 1160 (make-local-variable var) 1161 (set var val)) 1162 (message "Ignoring `eval:' in file's local variables"))) 1163 ;; Ordinary variable, really set it. 1164 (t (make-local-variable var) 1165 (set var val)))) 1166 1167 1168(defun set-visited-file-name (filename) 1169 "Change name of file visited in current buffer to FILENAME. 1170The next time the buffer is saved it will go in the newly specified file. 1171nil or empty string as argument means make buffer not be visiting any file. 1172Remember to delete the initial contents of the minibuffer 1173if you wish to pass an empty string as the argument." 1174 (interactive "FSet visited file name: ") 1175 (if filename 1176 (setq filename 1177 (if (string-equal filename "") 1178 nil 1179 (expand-file-name filename)))) 1180 (or (equal filename buffer-file-name) 1181 (progn 1182 (and filename (lock-buffer filename)) 1183 (unlock-buffer))) 1184 (setq buffer-file-name filename) 1185 (if filename ; make buffer name reflect filename. 1186 (let ((new-name (file-name-nondirectory buffer-file-name))) 1187 (if (string= new-name "") 1188 (error "Empty file name")) 1189 (if (eq system-type 'vax-vms) 1190 (setq new-name (downcase new-name))) 1191 (setq default-directory (file-name-directory buffer-file-name)) 1192 (or (string= new-name (buffer-name)) 1193 (rename-buffer new-name t)))) 1194 (setq buffer-backed-up nil) 1195 (clear-visited-file-modtime) 1196 (if filename 1197 (progn 1198 (setq buffer-file-truename 1199 (abbreviate-file-name (file-truename buffer-file-name))) 1200 (if find-file-visit-truename 1201 (setq buffer-file-name buffer-file-truename)) 1202 (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))) 1203 (setq buffer-file-truename nil buffer-file-number nil)) 1204 ;; write-file-hooks is normally used for things like ftp-find-file 1205 ;; that visit things that are not local files as if they were files. 1206 ;; Changing to visit an ordinary local file instead should flush the hook. 1207 (kill-local-variable 'write-file-hooks) 1208 (kill-local-variable 'local-write-file-hooks) 1209 (kill-local-variable 'revert-buffer-function) 1210 (kill-local-variable 'backup-inhibited) 1211 ;; If buffer was read-only because of version control, 1212 ;; that reason is gone now, so make it writable. 1213 (if vc-mode 1214 (setq buffer-read-only nil)) 1215 (kill-local-variable 'vc-mode) 1216 ;; Turn off backup files for certain file names. 1217 ;; Since this is a permanent local, the major mode won't eliminate it. 1218 (and (not (funcall backup-enable-predicate buffer-file-name)) 1219 (progn 1220 (make-local-variable 'backup-inhibited) 1221 (setq backup-inhibited t))) 1222 (let ((oauto buffer-auto-save-file-name)) 1223 ;; If auto-save was not already on, turn it on if appropriate. 1224 (if (not buffer-auto-save-file-name) 1225 (and buffer-file-name auto-save-default 1226 (auto-save-mode t)) 1227 ;; If auto save is on, start using a new name. 1228 ;; We deliberately don't rename or delete the old auto save 1229 ;; for the old visited file name. This is because perhaps 1230 ;; the user wants to save the new state and then compare with the 1231 ;; previous state from the auto save file. 1232 (setq buffer-auto-save-file-name 1233 (make-auto-save-file-name))) 1234 ;; Rename the old auto save file if any. 1235 (and oauto buffer-auto-save-file-name 1236 (file-exists-p oauto) 1237 (rename-file oauto buffer-auto-save-file-name t))) 1238 (if buffer-file-name 1239 (set-buffer-modified-p t))) 1240 1241(defun write-file (filename) 1242 "Write current buffer into file FILENAME. 1243Makes buffer visit that file, and marks it not modified. 1244If the buffer is already visiting a file, you can specify 1245a directory name as FILENAME, to write a file of the same 1246old name in that directory." 1247;; (interactive "FWrite file: ") 1248 (interactive 1249 (list (if buffer-file-name 1250 (read-file-name "Write file: " 1251 nil nil nil nil) 1252 (read-file-name "Write file: " 1253 (cdr (assq 'default-directory 1254 (buffer-local-variables))) 1255 nil nil (buffer-name))))) 1256 (or (null filename) (string-equal filename "") 1257 (progn 1258 ;; If arg is just a directory, 1259 ;; use same file name, but in that directory. 1260 (if (and (file-directory-p filename) buffer-file-name) 1261 (setq filename (concat (file-name-as-directory filename) 1262 (file-name-nondirectory buffer-file-name)))) 1263 (set-visited-file-name filename))) 1264 (set-buffer-modified-p t) 1265 (save-buffer)) 1266 1267(defun backup-buffer () 1268 "Make a backup of the disk file visited by the current buffer, if appropriate. 1269This is normally done before saving the buffer the first time. 1270If the value is non-nil, it is the result of `file-modes' on the original 1271file; this means that the caller, after saving the buffer, should change 1272the modes of the new file to agree with the old modes." 1273 (if (and make-backup-files (not backup-inhibited) 1274 (not buffer-backed-up) 1275 (file-exists-p buffer-file-name) 1276 (memq (aref (elt (file-attributes buffer-file-name) 8) 0) 1277 '(?- ?l))) 1278 (let ((real-file-name buffer-file-name) 1279 backup-info backupname targets setmodes) 1280 ;; If specified name is a symbolic link, chase it to the target. 1281 ;; Thus we make the backups in the directory where the real file is. 1282 (setq real-file-name (file-chase-links real-file-name)) 1283 (setq backup-info (find-backup-file-name real-file-name) 1284 backupname (car backup-info) 1285 targets (cdr backup-info)) 1286;;; (if (file-directory-p buffer-file-name) 1287;;; (error "Cannot save buffer in directory %s" buffer-file-name)) 1288 (condition-case () 1289 (let ((delete-old-versions 1290 ;; If have old versions to maybe delete, 1291 ;; ask the user to confirm now, before doing anything. 1292 ;; But don't actually delete til later. 1293 (and targets 1294 (or (eq trim-versions-without-asking t) (eq trim-versions-without-asking nil)) 1295 (or trim-versions-without-asking 1296 (y-or-n-p (format "Delete excess backup versions of %s? " 1297 real-file-name)))))) 1298 ;; Actually write the back up file. 1299 (condition-case () 1300 (if (or file-precious-flag 1301; (file-symlink-p buffer-file-name) 1302 backup-by-copying 1303 (and backup-by-copying-when-linked 1304 (> (file-nlinks real-file-name) 1)) 1305 (and backup-by-copying-when-mismatch 1306 (let ((attr (file-attributes real-file-name))) 1307 (or (nth 9 attr) 1308 (/= (nth 2 attr) (user-uid)))))) 1309 (condition-case () 1310 (copy-file real-file-name backupname t t) 1311 (file-error 1312 ;; If copying fails because file BACKUPNAME 1313 ;; is not writable, delete that file and try again. 1314 (if (and (file-exists-p backupname) 1315 (not (file-writable-p backupname))) 1316 (delete-file backupname)) 1317 (copy-file real-file-name backupname t t))) 1318 ;; rename-file should delete old backup. 1319 (rename-file real-file-name backupname t) 1320 (setq setmodes (file-modes backupname))) 1321 (file-error 1322 ;; If trouble writing the backup, write it in ~. 1323 (setq backupname (expand-file-name "~/%backup%~")) 1324 (message "Cannot write backup file; backing up in ~/%%backup%%~") 1325 (sleep-for 1) 1326 (condition-case () 1327 (copy-file real-file-name backupname t t) 1328 (file-error 1329 ;; If copying fails because file BACKUPNAME 1330 ;; is not writable, delete that file and try again. 1331 (if (and (file-exists-p backupname) 1332 (not (file-writable-p backupname))) 1333 (delete-file backupname)) 1334 (copy-file real-file-name backupname t t))))) 1335 (setq buffer-backed-up t) 1336 ;; Now delete the old versions, if desired. 1337 (if delete-old-versions 1338 (while targets 1339 (condition-case () 1340 (delete-file (car targets)) 1341 (file-error nil)) 1342 (setq targets (cdr targets)))) 1343 setmodes) 1344 (file-error nil))))) 1345 1346(defun file-name-sans-versions (name &optional keep-backup-version) 1347 "Return FILENAME sans backup versions or strings. 1348This is a separate procedure so your site-init or startup file can 1349redefine it. 1350If the optional argument KEEP-BACKUP-VERSION is non-nil, 1351we do not remove backup version numbers, only true file version numbers." 1352 (let ((handler (find-file-name-handler name 'file-name-sans-versions))) 1353 (if handler 1354 (funcall handler 'file-name-sans-versions name keep-backup-version) 1355 (substring name 0 1356 (if (eq system-type 'vax-vms) 1357 ;; VMS version number is (a) semicolon, optional 1358 ;; sign, zero or more digits or (b) period, option 1359 ;; sign, zero or more digits, provided this is the 1360 ;; second period encountered outside of the 1361 ;; device/directory part of the file name. 1362 (or (string-match ";[-+]?[0-9]*\\'" name) 1363 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" 1364 name) 1365 (match-beginning 1)) 1366 (length name)) 1367 (if keep-backup-version 1368 (length name) 1369 (or (string-match "\\.~[0-9]+~\\'" name) 1370 (string-match "~\\'" name) 1371 (length name)))))))) 1372 1373(defun make-backup-file-name (file) 1374 "Create the non-numeric backup file name for FILE. 1375This is a separate function so you can redefine it for customization." 1376 (if (eq system-type 'ms-dos) 1377 (let ((fn (file-name-nondirectory file))) 1378 (concat (file-name-directory file) 1379 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) 1380 (substring fn 0 (match-end 1))) 1381 ".bak")) 1382 (concat file "~"))) 1383 1384(defun backup-file-name-p (file) 1385 "Return non-nil if FILE is a backup file name (numeric or not). 1386This is a separate function so you can redefine it for customization. 1387You may need to redefine `file-name-sans-versions' as well." 1388 (if (eq system-type 'ms-dos) 1389 (string-match "\\.bak$" file) 1390 (string-match "~$" file))) 1391 1392;; This is used in various files. 1393;; The usage of bv-length is not very clean, 1394;; but I can't see a good alternative, 1395;; so as of now I am leaving it alone. 1396(defun backup-extract-version (fn) 1397 "Given the name of a numeric backup file, return the backup number. 1398Uses the free variable `bv-length', whose value should be 1399the index in the name where the version number begins." 1400 (if (and (string-match "[0-9]+~$" fn bv-length) 1401 (= (match-beginning 0) bv-length)) 1402 (string-to-int (substring fn bv-length -1)) 1403 0)) 1404 1405;; I believe there is no need to alter this behavior for VMS; 1406;; since backup files are not made on VMS, it should not get called. 1407(defun find-backup-file-name (fn) 1408 "Find a file name for a backup file, and suggestions for deletions. 1409Value is a list whose car is the name for the backup file 1410 and whose cdr is a list of old versions to consider deleting now." 1411 (if (eq version-control 'never) 1412 (list (make-backup-file-name fn)) 1413 (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) 1414 (bv-length (length base-versions)) 1415 possibilities 1416 (versions nil) 1417 (high-water-mark 0) 1418 (deserve-versions-p nil) 1419 (number-to-delete 0)) 1420 (condition-case () 1421 (setq possibilities (file-name-all-completions 1422 base-versions 1423 (file-name-directory fn)) 1424 versions (sort (mapcar 1425 (function backup-extract-version) 1426 possibilities) 1427 '<) 1428 high-water-mark (apply 'max 0 versions) 1429 deserve-versions-p (or version-control 1430 (> high-water-mark 0)) 1431 number-to-delete (- (length versions) 1432 kept-old-versions kept-new-versions -1)) 1433 (file-error 1434 (setq possibilities nil))) 1435 (if (not deserve-versions-p) 1436 (list (make-backup-file-name fn)) 1437 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") 1438 (if (and (> number-to-delete 0) 1439 ;; Delete nothing if there is overflow 1440 ;; in the number of versions to keep. 1441 (>= (+ kept-new-versions kept-old-versions -1) 0)) 1442 (mapcar (function (lambda (n) 1443 (concat fn ".~" (int-to-string n) "~"))) 1444 (let ((v (nthcdr kept-old-versions versions))) 1445 (rplacd (nthcdr (1- number-to-delete) v) ()) 1446 v)))))))) 1447 1448(defun file-nlinks (filename) 1449 "Return number of names file FILENAME has." 1450 (car (cdr (file-attributes filename)))) 1451 1452(defun file-relative-name (filename &optional directory) 1453 "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." 1454 (setq filename (expand-file-name filename) 1455 directory (file-name-as-directory (expand-file-name 1456 (or directory default-directory)))) 1457 (let ((ancestor "")) 1458 (while (not (string-match (concat "^" (regexp-quote directory)) filename)) 1459 (setq directory (file-name-directory (substring directory 0 -1)) 1460 ancestor (concat "../" ancestor))) 1461 (concat ancestor (substring filename (match-end 0))))) 1462 1463(defun save-buffer (&optional args) 1464 "Save current buffer in visited file if modified. Versions described below. 1465By default, makes the previous version into a backup file 1466 if previously requested or if this is the first save. 1467With 1 or 3 \\[universal-argument]'s, marks this version 1468 to become a backup when the next save is done. 1469With 2 or 3 \\[universal-argument]'s, 1470 unconditionally makes the previous version into a backup file. 1471With argument of 0, never makes the previous version into a backup file. 1472 1473If a file's name is FOO, the names of its numbered backup versions are 1474 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. 1475Numeric backups (rather than FOO~) will be made if value of 1476 `version-control' is not the atom `never' and either there are already 1477 numeric versions of the file being backed up, or `version-control' is 1478 non-nil. 1479We don't want excessive versions piling up, so there are variables 1480 `kept-old-versions', which tells Emacs how many oldest versions to keep, 1481 and `kept-new-versions', which tells how many newest versions to keep. 1482 Defaults are 2 old versions and 2 new. 1483`dired-kept-versions' controls dired's clean-directory (.) command. 1484If `trim-versions-without-asking' is nil, system will query user 1485 before trimming versions. Otherwise it does it silently." 1486 (interactive "p") 1487 (let ((modp (buffer-modified-p)) 1488 (large (> (buffer-size) 50000)) 1489 (make-backup-files (and make-backup-files (not (eq args 0))))) 1490 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) 1491 (if (and modp large) (message "Saving file %s..." (buffer-file-name))) 1492 (basic-save-buffer) 1493 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) 1494 1495(defun delete-auto-save-file-if-necessary (&optional force) 1496 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. 1497Normally delete only if the file was written by this Emacs since 1498the last real save, but optional arg FORCE non-nil means delete anyway." 1499 (and buffer-auto-save-file-name delete-auto-save-files 1500 (not (string= buffer-file-name buffer-auto-save-file-name)) 1501 (or force (recent-auto-save-p)) 1502 (progn 1503 (condition-case () 1504 (delete-file buffer-auto-save-file-name) 1505 (file-error nil)) 1506 (set-buffer-auto-saved)))) 1507 1508(defun basic-save-buffer () 1509 "Save the current buffer in its visited file, if it has been modified." 1510 (interactive) 1511 (if (buffer-modified-p) 1512 (let ((recent-save (recent-auto-save-p)) 1513 setmodes tempsetmodes) 1514 ;; On VMS, rename file and buffer to get rid of version number. 1515 (if (and (eq system-type 'vax-vms) 1516 (not (string= buffer-file-name 1517 (file-name-sans-versions buffer-file-name)))) 1518 (let (buffer-new-name) 1519 ;; Strip VMS version number before save. 1520 (setq buffer-file-name 1521 (file-name-sans-versions buffer-file-name)) 1522 ;; Construct a (unique) buffer name to correspond. 1523 (let ((buf (create-file-buffer (downcase buffer-file-name)))) 1524 (setq buffer-new-name (buffer-name buf)) 1525 (kill-buffer buf)) 1526 (rename-buffer buffer-new-name))) 1527 ;; If buffer has no file name, ask user for one. 1528 (or buffer-file-name 1529 (set-visited-file-name 1530 (expand-file-name (read-file-name "File to save in: ") nil))) 1531 (or (verify-visited-file-modtime (current-buffer)) 1532 (not (file-exists-p buffer-file-name)) 1533 (yes-or-no-p 1534 (format "%s has changed since visited or saved. Save anyway? " 1535 (file-name-nondirectory buffer-file-name))) 1536 (error "Save not confirmed")) 1537 (save-restriction 1538 (widen) 1539 (and (> (point-max) 1) 1540 (/= (char-after (1- (point-max))) ?\n) 1541 (not (and (eq selective-display t) 1542 (= (char-after (1- (point-max))) ?\r))) 1543 (or (eq require-final-newline t) 1544 (and require-final-newline 1545 (y-or-n-p 1546 (format "Buffer %s does not end in newline. Add one? " 1547 (buffer-name))))) 1548 (save-excursion 1549 (goto-char (point-max)) 1550 (insert ?\n))) 1551 (let ((hooks (append write-contents-hooks local-write-file-hooks 1552 write-file-hooks)) 1553 (done nil)) 1554 (while (and hooks 1555 (not (setq done (funcall (car hooks))))) 1556 (setq hooks (cdr hooks))) 1557 ;; If a hook returned t, file is already "written". 1558 (cond ((not done) 1559 (setq setmodes (basic-save-buffer-1))))) 1560 (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))) 1561 (if setmodes 1562 (condition-case () 1563 (set-file-modes buffer-file-name setmodes) 1564 (error nil)))) 1565 ;; If the auto-save file was recent before this command, 1566 ;; delete it now. 1567 (delete-auto-save-file-if-necessary recent-save) 1568 (run-hooks 'after-save-hook)) 1569 (message "(No changes need to be saved)"))) 1570 1571;; This does the "real job" of writing a buffer into its visited file 1572;; and making a backup file. This is what is normally done 1573;; but inhibited if one of write-file-hooks returns non-nil. 1574;; It returns a value to store in setmodes. 1575(defun basic-save-buffer-1 () 1576 (let (tempsetmodes setmodes) 1577 (if (not (file-writable-p buffer-file-name)) 1578 (let ((dir (file-name-directory buffer-file-name))) 1579 (if (not (file-directory-p dir)) 1580 (error "%s is not a directory" dir) 1581 (if (not (file-exists-p buffer-file-name)) 1582 (error "Directory %s write-protected" dir) 1583 (if (yes-or-no-p 1584 (format "File %s is write-protected; try to save anyway? " 1585 (file-name-nondirectory 1586 buffer-file-name))) 1587 (setq tempsetmodes t) 1588 (error "Attempt to save to a file which you aren't allowed to write")))))) 1589 (or buffer-backed-up 1590 (setq setmodes (backup-buffer))) 1591 (if file-precious-flag 1592 ;; If file is precious, write temp name, then rename it. 1593 (let ((dir (file-name-directory buffer-file-name)) 1594 (realname buffer-file-name) 1595 tempname temp nogood i succeed) 1596 (setq i 0) 1597 (setq nogood t) 1598 ;; Find the temporary name to write under. 1599 (while nogood 1600 (setq tempname (format "%s#tmp#%d" dir i)) 1601 (setq nogood (file-exists-p tempname)) 1602 (setq i (1+ i))) 1603 (unwind-protect 1604 (progn (clear-visited-file-modtime) 1605 (write-region (point-min) (point-max) 1606 tempname nil realname) 1607 (setq succeed t)) 1608 ;; If writing the temp file fails, 1609 ;; delete the temp file. 1610 (or succeed (delete-file tempname))) 1611 ;; Since we have created an entirely new file 1612 ;; and renamed it, make sure it gets the 1613 ;; right permission bits set. 1614 (setq setmodes (file-modes buffer-file-name)) 1615 ;; We succeeded in writing the temp file, 1616 ;; so rename it. 1617 (rename-file tempname buffer-file-name t)) 1618 ;; If file not writable, see if we can make it writable 1619 ;; temporarily while we write it. 1620 ;; But no need to do so if we have just backed it up 1621 ;; (setmodes is set) because that says we're superseding. 1622 (cond ((and tempsetmodes (not setmodes)) 1623 ;; Change the mode back, after writing. 1624 (setq setmodes (file-modes buffer-file-name)) 1625 (set-file-modes buffer-file-name 511))) 1626 (write-region (point-min) (point-max) 1627 buffer-file-name nil t)) 1628 setmodes)) 1629 1630(defun save-some-buffers (&optional arg exiting) 1631 "Save some modified file-visiting buffers. Asks user about each one. 1632Optional argument (the prefix) non-nil means save all with no questions. 1633Optional second argument EXITING means ask about certain non-file buffers 1634 as well as about file buffers." 1635 (interactive "P") 1636 (save-window-excursion 1637 (let ((files-done 1638 (map-y-or-n-p 1639 (function 1640 (lambda (buffer) 1641 (and (buffer-modified-p buffer) 1642 (or 1643 (buffer-file-name buffer) 1644 (and exiting 1645 (progn 1646 (set-buffer buffer) 1647 (and buffer-offer-save (> (buffer-size) 0))))) 1648 (if arg 1649 t 1650 (if (buffer-file-name buffer) 1651 (format "Save file %s? " 1652 (buffer-file-name buffer)) 1653 (format "Save buffer %s? " 1654 (buffer-name buffer))))))) 1655 (function 1656 (lambda (buffer) 1657 (set-buffer buffer) 1658 (save-buffer))) 1659 (buffer-list) 1660 '("buffer" "buffers" "save") 1661 (list (list ?\C-r (lambda (buf) 1662 (view-buffer buf) 1663 (setq view-exit-action 1664 '(lambda (ignore) 1665 (exit-recursive-edit))) 1666 (recursive-edit) 1667 ;; Return nil to ask about BUF again. 1668 nil) 1669 "display the current buffer")))) 1670 (abbrevs-done 1671 (and save-abbrevs abbrevs-changed 1672 (progn 1673 (if (or arg 1674 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) 1675 (write-abbrev-file nil)) 1676 ;; Don't keep bothering user if he says no. 1677 (setq abbrevs-changed nil) 1678 t)))) 1679 (or (> files-done 0) abbrevs-done 1680 (message "(No files need saving)"))))) 1681 1682(defun not-modified (&optional arg) 1683 "Mark current buffer as unmodified, not needing to be saved. 1684With prefix arg, mark buffer as modified, so \\[save-buffer] will save." 1685 (interactive "P") 1686 (message (if arg "Modification-flag set" 1687 "Modification-flag cleared")) 1688 (set-buffer-modified-p arg)) 1689 1690(defun toggle-read-only (&optional arg) 1691 "Change whether this buffer is visiting its file read-only. 1692With arg, set read-only iff arg is positive." 1693 (interactive "P") 1694 (setq buffer-read-only 1695 (if (null arg) 1696 (not buffer-read-only) 1697 (> (prefix-numeric-value arg) 0))) 1698 ;; Force mode-line redisplay 1699 (set-buffer-modified-p (buffer-modified-p))) 1700 1701(defun insert-file (filename) 1702 "Insert contents of file FILENAME into buffer after point. 1703Set mark after the inserted text. 1704 1705This function is meant for the user to run interactively. 1706Don't call it from programs! Use `insert-file-contents' instead. 1707\(Its calling sequence is different; see its documentation)." 1708 (interactive "*fInsert file: ") 1709 (if (file-directory-p filename) 1710 (signal 'file-error (list "Opening input file" "file is a directory" 1711 filename))) 1712 (let ((tem (insert-file-contents filename))) 1713 (push-mark (+ (point) (car (cdr tem)))))) 1714 1715(defun append-to-file (start end filename) 1716 "Append the contents of the region to the end of file FILENAME. 1717When called from a function, expects three arguments, 1718START, END and FILENAME. START and END are buffer positions 1719saying what text to write." 1720 (interactive "r\nFAppend to file: ") 1721 (write-region start end filename t)) 1722 1723(defun file-newest-backup (filename) 1724 "Return most recent backup file for FILENAME or nil if no backups exist." 1725 (let* ((filename (expand-file-name filename)) 1726 (file (file-name-nondirectory filename)) 1727 (dir (file-name-directory filename)) 1728 (comp (file-name-all-completions file dir)) 1729 newest) 1730 (while comp 1731 (setq file (concat dir (car comp)) 1732 comp (cdr comp)) 1733 (if (and (backup-file-name-p file) 1734 (or (null newest) (file-newer-than-file-p file newest))) 1735 (setq newest file))) 1736 newest)) 1737 1738(defun rename-uniquely () 1739 "Rename current buffer to a similar name not already taken. 1740This function is useful for creating multiple shell process buffers 1741or multiple mail buffers, etc." 1742 (interactive) 1743 (let* ((new-buf (generate-new-buffer (buffer-name))) 1744 (name (buffer-name new-buf))) 1745 (kill-buffer new-buf) 1746 (rename-buffer name) 1747 (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update 1748 1749(defun make-directory (dir &optional parents) 1750 "Create the directory DIR and any nonexistent parent dirs. 1751Interactively, the default choice of directory to create 1752is the current default directory for file names. 1753That is useful when you have visited a file in a nonexistint directory. 1754 1755Noninteractively, the second (optional) argument PARENTS says whether 1756to create parent directories if they don't exist." 1757 (interactive 1758 (list (read-file-name "Make directory: " default-directory default-directory 1759 nil nil) 1760 t)) 1761 (let ((handler (find-file-name-handler dir 'make-directory))) 1762 (if handler 1763 (funcall handler 'make-directory dir parents) 1764 (if (not parents) 1765 (make-directory-internal dir) 1766 (let ((dir (directory-file-name (expand-file-name dir))) 1767 create-list) 1768 (while (not (file-exists-p dir)) 1769 (setq create-list (cons dir create-list) 1770 dir (directory-file-name (file-name-directory dir)))) 1771 (while create-list 1772 (make-directory-internal (car create-list)) 1773 (setq create-list (cdr create-list)))))))) 1774 1775(put 'revert-buffer-function 'permanent-local t) 1776(defvar revert-buffer-function nil 1777 "Function to use to revert this buffer, or nil to do the default.") 1778 1779(put 'revert-buffer-insert-file-contents-function 'permanent-local t) 1780(defvar revert-buffer-insert-file-contents-function nil 1781 "Function to use to insert contents when reverting this buffer. 1782Gets two args, first the nominal file name to use, 1783and second, t if reading the auto-save file.") 1784 1785(defun revert-buffer (&optional ignore-auto noconfirm) 1786 "Replace the buffer text with the text of the visited file on disk. 1787This undoes all changes since the file was visited or saved. 1788With a prefix argument, offer to revert from latest auto-save file, if 1789that is more recent than the visited file. 1790 1791When called from lisp, The first argument is IGNORE-AUTO; only offer 1792to revert from the auto-save file when this is nil. Note that the 1793sense of this argument is the reverse of the prefix argument, for the 1794sake of backward compatibility. IGNORE-AUTO is optional, defaulting 1795to nil. 1796 1797Optional second argument NOCONFIRM means don't ask for confirmation at 1798all. 1799 1800If the value of `revert-buffer-function' is non-nil, it is called to 1801do the work. 1802 1803The default revert function runs the hook `before-revert-hook' at the 1804beginning and `after-revert-hook' at the end." 1805 ;; I admit it's odd to reverse the sense of the prefix argument, but 1806 ;; there is a lot of code out there which assumes that the first 1807 ;; argument should be t to avoid consulting the auto-save file, and 1808 ;; there's no straightforward way to encourage authors to notice a 1809 ;; reversal of the argument sense. So I'm just changing the user 1810 ;; interface, but leaving the programmatic interface the same. 1811 (interactive (list (not prefix-arg))) 1812 (if revert-buffer-function 1813 (funcall revert-buffer-function ignore-auto noconfirm) 1814 (let* ((opoint (point)) 1815 (auto-save-p (and (not ignore-auto) 1816 (recent-auto-save-p) 1817 buffer-auto-save-file-name 1818 (file-readable-p buffer-auto-save-file-name) 1819 (y-or-n-p 1820 "Buffer has been auto-saved recently. Revert from auto-save file? "))) 1821 (file-name (if auto-save-p 1822 buffer-auto-save-file-name 1823 buffer-file-name))) 1824 (cond ((null file-name) 1825 (error "Buffer does not seem to be associated with any file")) 1826 ((or noconfirm 1827 (yes-or-no-p (format "Revert buffer from file %s? " 1828 file-name))) 1829 (run-hooks 'before-revert-hook) 1830 ;; If file was backed up but has changed since, 1831 ;; we shd make another backup. 1832 (and (not auto-save-p) 1833 (not (verify-visited-file-modtime (current-buffer))) 1834 (setq buffer-backed-up nil)) 1835 ;; Get rid of all undo records for this buffer. 1836 (or (eq buffer-undo-list t) 1837 (setq buffer-undo-list nil)) 1838 (let ((buffer-read-only nil) 1839 ;; Don't make undo records for the reversion. 1840 (buffer-undo-list t)) 1841 (if revert-buffer-insert-file-contents-function 1842 (funcall revert-buffer-insert-file-contents-function 1843 file-name auto-save-p) 1844 (if (not (file-exists-p file-name)) 1845 (error "File %s no longer exists!" file-name)) 1846 ;; Bind buffer-file-name to nil 1847 ;; so that we don't try to lock the file. 1848 (let ((buffer-file-name nil)) 1849 (or auto-save-p 1850 (unlock-buffer))) 1851 (widen) 1852 (insert-file-contents file-name (not auto-save-p) 1853 nil nil t))) 1854 (goto-char (min opoint (point-max))) 1855 (after-find-file nil nil t) 1856 (run-hooks 'after-revert-hook) 1857 t))))) 1858 1859(defun recover-file (file) 1860 "Visit file FILE, but get contents from its last auto-save file." 1861 (interactive 1862 (let ((prompt-file buffer-file-name) 1863 (file-name nil) 1864 (file-dir nil)) 1865 (and prompt-file 1866 (setq file-name (file-name-nondirectory prompt-file) 1867 file-dir (file-name-directory prompt-file))) 1868 (list (read-file-name "Recover file: " 1869 file-dir nil nil file-name)))) 1870 (setq file (expand-file-name file)) 1871 (if (auto-save-file-name-p (file-name-nondirectory file)) 1872 (error "%s is an auto-save file" file)) 1873 (let ((file-name (let ((buffer-file-name file)) 1874 (make-auto-save-file-name)))) 1875 (cond ((not (file-newer-than-file-p file-name file)) 1876 (error "Auto-save file %s not current" file-name)) 1877 ((save-window-excursion 1878 (if (not (eq system-type 'vax-vms)) 1879 (with-output-to-temp-buffer "*Directory*" 1880 (buffer-disable-undo standard-output) 1881 (call-process "ls" nil standard-output nil 1882 (if (file-symlink-p file) "-lL" "-l") 1883 file file-name))) 1884 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 1885 (switch-to-buffer (find-file-noselect file t)) 1886 (let ((buffer-read-only nil)) 1887 (erase-buffer) 1888 (insert-file-contents file-name nil)) 1889 (after-find-file nil nil t)) 1890 (t (error "Recover-file cancelled."))))) 1891 1892(defun kill-some-buffers () 1893 "For each buffer, ask whether to kill it." 1894 (interactive) 1895 (let ((list (buffer-list))) 1896 (while list 1897 (let* ((buffer (car list)) 1898 (name (buffer-name buffer))) 1899 (and (not (string-equal name "")) 1900 (/= (aref name 0) ? ) 1901 (yes-or-no-p 1902 (format "Buffer %s %s. Kill? " 1903 name 1904 (if (buffer-modified-p buffer) 1905 "HAS BEEN EDITED" "is unmodified"))) 1906 (kill-buffer buffer))) 1907 (setq list (cdr list))))) 1908 1909(defun auto-save-mode (arg) 1910 "Toggle auto-saving of contents of current buffer. 1911With prefix argument ARG, turn auto-saving on if positive, else off." 1912 (interactive "P") 1913 (setq buffer-auto-save-file-name 1914 (and (if (null arg) 1915 (not buffer-auto-save-file-name) 1916 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) 1917 (if (and buffer-file-name auto-save-visited-file-name 1918 (not buffer-read-only)) 1919 buffer-file-name 1920 (make-auto-save-file-name)))) 1921 ;; If -1 was stored here, to temporarily turn off saving, 1922 ;; turn it back on. 1923 (and (< buffer-saved-size 0) 1924 (setq buffer-saved-size 0)) 1925 (if (interactive-p) 1926 (message "Auto-save %s (in this buffer)" 1927 (if buffer-auto-save-file-name "on" "off"))) 1928 buffer-auto-save-file-name) 1929 1930(defun rename-auto-save-file () 1931 "Adjust current buffer's auto save file name for current conditions. 1932Also rename any existing auto save file, if it was made in this session." 1933 (let ((osave buffer-auto-save-file-name)) 1934 (setq buffer-auto-save-file-name 1935 (make-auto-save-file-name)) 1936 (if (and osave buffer-auto-save-file-name 1937 (not (string= buffer-auto-save-file-name buffer-file-name)) 1938 (not (string= buffer-auto-save-file-name osave)) 1939 (file-exists-p osave) 1940 (recent-auto-save-p)) 1941 (rename-file osave buffer-auto-save-file-name t)))) 1942 1943(defun make-auto-save-file-name () 1944 "Return file name to use for auto-saves of current buffer. 1945Does not consider `auto-save-visited-file-name' as that variable is checked 1946before calling this function. You can redefine this for customization. 1947See also `auto-save-file-name-p'." 1948 (if buffer-file-name 1949 (concat (file-name-directory buffer-file-name) 1950 "#" 1951 (file-name-nondirectory buffer-file-name) 1952 "#") 1953 ;; For non-file bfr, use bfr name and Emacs pid. 1954 (expand-file-name (format "#%s#%s#" (buffer-name) (make-temp-name ""))))) 1955 1956(defun auto-save-file-name-p (filename) 1957 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. 1958FILENAME should lack slashes. You can redefine this for customization." 1959 (string-match "^#.*#$" filename)) 1960 1961(defconst list-directory-brief-switches 1962 (if (eq system-type 'vax-vms) "" "-CF") 1963 "*Switches for list-directory to pass to `ls' for brief listing,") 1964 1965(defconst list-directory-verbose-switches 1966 (if (eq system-type 'vax-vms) 1967 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" 1968 "-l") 1969 "*Switches for list-directory to pass to `ls' for verbose listing,") 1970 1971(defun list-directory (dirname &optional verbose) 1972 "Display a list of files in or matching DIRNAME, a la `ls'. 1973DIRNAME is globbed by the shell if necessary. 1974Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. 1975Actions controlled by variables `list-directory-brief-switches' 1976and `list-directory-verbose-switches'." 1977 (interactive (let ((pfx current-prefix-arg)) 1978 (list (read-file-name (if pfx "List directory (verbose): " 1979 "List directory (brief): ") 1980 nil default-directory nil) 1981 pfx))) 1982 (let ((switches (if verbose list-directory-verbose-switches 1983 list-directory-brief-switches))) 1984 (or dirname (setq dirname default-directory)) 1985 (setq dirname (expand-file-name dirname)) 1986 (with-output-to-temp-buffer "*Directory*" 1987 (buffer-disable-undo standard-output) 1988 (princ "Directory ") 1989 (princ dirname) 1990 (terpri) 1991 (save-excursion 1992 (set-buffer "*Directory*") 1993 (let ((wildcard (not (file-directory-p dirname)))) 1994 (insert-directory dirname switches wildcard (not wildcard))))))) 1995 1996(defvar insert-directory-program "ls" 1997 "Absolute or relative name of the `ls' program used by `insert-directory'.") 1998 1999;; insert-directory 2000;; - must insert _exactly_one_line_ describing FILE if WILDCARD and 2001;; FULL-DIRECTORY-P is nil. 2002;; The single line of output must display FILE's name as it was 2003;; given, namely, an absolute path name. 2004;; - must insert exactly one line for each file if WILDCARD or 2005;; FULL-DIRECTORY-P is t, plus one optional "total" line 2006;; before the file lines, plus optional text after the file lines. 2007;; Lines are delimited by "\n", so filenames containing "\n" are not 2008;; allowed. 2009;; File lines should display the basename. 2010;; - must be consistent with 2011;; - functions dired-move-to-filename, (these two define what a file line is) 2012;; dired-move-to-end-of-filename, 2013;; dired-between-files, (shortcut for (not (dired-move-to-filename))) 2014;; dired-insert-headerline 2015;; dired-after-subdir-garbage (defines what a "total" line is) 2016;; - variable dired-subdir-regexp 2017(defun insert-directory (file switches &optional wildcard full-directory-p) 2018 "Insert directory listing for FILE, formatted according to SWITCHES. 2019Leaves point after the inserted text. 2020Optional third arg WILDCARD means treat FILE as shell wildcard. 2021Optional fourth arg FULL-DIRECTORY-P means file is a directory and 2022switches do not contain `d', so that a full listing is expected. 2023 2024This works by running a directory listing program 2025whose name is in the variable `insert-directory-program'. 2026If WILDCARD, it also runs the shell specified by `shell-file-name'." 2027 ;; We need the directory in order to find the right handler. 2028 (let ((handler (find-file-name-handler (expand-file-name file) 2029 'insert-directory))) 2030 (if handler 2031 (funcall handler 'insert-directory file switches 2032 wildcard full-directory-p) 2033 (if (eq system-type 'vax-vms) 2034 (vms-read-directory file switches (current-buffer)) 2035 (if wildcard 2036 ;; Run ls in the directory of the file pattern we asked for. 2037 (let ((default-directory 2038 (if (file-name-absolute-p file) 2039 (file-name-directory file) 2040 (file-name-directory (expand-file-name file)))) 2041 (pattern (file-name-nondirectory file)) 2042 (beg 0)) 2043 ;; Quote some characters that have special meanings in shells; 2044 ;; but don't quote the wildcards--we want them to be special. 2045 ;; We also currently don't quote the quoting characters 2046 ;; in case people want to use them explicitly to quote 2047 ;; wildcard characters. 2048 (while (string-match "[ \t\n;<>&|{}()#$]" pattern beg) 2049 (setq pattern 2050 (concat (substring pattern 0 (match-beginning 0)) 2051 "\\" 2052 (substring pattern (match-beginning 0))) 2053 beg (1+ (match-end 0)))) 2054 (call-process shell-file-name nil t nil 2055 "-c" (concat insert-directory-program 2056 " -d " switches " " 2057 pattern))) 2058 ;; SunOS 4.1.3, SVr4 and others need the "." to list the 2059 ;; directory if FILE is a symbolic link. 2060 (call-process insert-directory-program nil t nil switches 2061 (if full-directory-p 2062 (concat (file-name-as-directory file) ".") 2063 file))))))) 2064 2065(defvar kill-emacs-query-functions nil 2066 "Functions to call with no arguments to query about killing Emacs. 2067If any of these functions returns nil, killing Emacs is cancelled.") 2068 2069(defun save-buffers-kill-emacs (&optional arg) 2070 "Offer to save each buffer, then kill this Emacs process. 2071With prefix arg, silently save all file-visiting buffers, then kill." 2072 (interactive "P") 2073 (save-some-buffers arg t) 2074 (and (or (not (memq t (mapcar (function 2075 (lambda (buf) (and (buffer-file-name buf) 2076 (buffer-modified-p buf)))) 2077 (buffer-list)))) 2078 (yes-or-no-p "Modified buffers exist; exit anyway? ")) 2079 (or (not (fboundp 'process-list)) 2080 ;; process-list is not defined on VMS. 2081 (let ((processes (process-list)) 2082 active) 2083 (while processes 2084 (and (memq (process-status (car processes)) '(run stop open)) 2085 (let ((val (process-kill-without-query (car processes)))) 2086 (process-kill-without-query (car processes) val) 2087 val) 2088 (setq active t)) 2089 (setq processes (cdr processes))) 2090 (or (not active) 2091 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) 2092 ;; Query the user for other things, perhaps. 2093 (let ((functions kill-emacs-query-functions) 2094 (yes t)) 2095 (while (and functions yes) 2096 (setq yes (and yes (funcall (car functions)))) 2097 (setq functions (cdr functions))) 2098 yes) 2099 (kill-emacs))) 2100 2101(define-key ctl-x-map "\C-f" 'find-file) 2102(define-key ctl-x-map "\C-q" 'toggle-read-only) 2103(define-key ctl-x-map "\C-r" 'find-file-read-only) 2104(define-key ctl-x-map "\C-v" 'find-alternate-file) 2105(define-key ctl-x-map "\C-s" 'save-buffer) 2106(define-key ctl-x-map "s" 'save-some-buffers) 2107(define-key ctl-x-map "\C-w" 'write-file) 2108(define-key ctl-x-map "i" 'insert-file) 2109(define-key esc-map "~" 'not-modified) 2110(define-key ctl-x-map "\C-d" 'list-directory) 2111(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) 2112 2113(define-key ctl-x-4-map "f" 'find-file-other-window) 2114(define-key ctl-x-4-map "r" 'find-file-read-only-other-window) 2115(define-key ctl-x-4-map "\C-f" 'find-file-other-window) 2116(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) 2117(define-key ctl-x-4-map "\C-o" 'display-buffer) 2118 2119(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) 2120(define-key ctl-x-5-map "f" 'find-file-other-frame) 2121(define-key ctl-x-5-map "\C-f" 'find-file-other-frame) 2122(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) 2123 2124;;; files.el ends here 2125