1;;; files.el --- file input and output commands for Emacs 2 3;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 4;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 5;; 2006, 2007 Free Software Foundation, Inc. 6 7;; Maintainer: FSF 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Defines most of Emacs's file- and directory-handling functions, 29;; including basic file visiting, backup generation, link handling, 30;; ITS-id version control, load- and write-hook handling, and the like. 31 32;;; Code: 33 34(defvar font-lock-keywords) 35 36 37(defgroup backup nil 38 "Backups of edited data files." 39 :group 'files) 40 41(defgroup find-file nil 42 "Finding files." 43 :group 'files) 44 45 46(defcustom delete-auto-save-files t 47 "Non-nil means delete auto-save file when a buffer is saved or killed. 48 49Note that the auto-save file will not be deleted if the buffer is killed 50when it has unsaved changes." 51 :type 'boolean 52 :group 'auto-save) 53 54(defcustom directory-abbrev-alist 55 nil 56 "Alist of abbreviations for file directories. 57A list of elements of the form (FROM . TO), each meaning to replace 58FROM with TO when it appears in a directory name. This replacement is 59done when setting up the default directory of a newly visited file. 60*Every* FROM string should start with `^'. 61 62Do not use `~' in the TO strings. 63They should be ordinary absolute directory names. 64 65Use this feature when you have directories which you normally refer to 66via absolute symbolic links. Make TO the name of the link, and FROM 67the name it is linked to." 68 :type '(repeat (cons :format "%v" 69 :value ("" . "") 70 (regexp :tag "From") 71 (regexp :tag "To"))) 72 :group 'abbrev 73 :group 'find-file) 74 75;; Turn off backup files on VMS since it has version numbers. 76(defcustom make-backup-files (not (eq system-type 'vax-vms)) 77 "Non-nil means make a backup of a file the first time it is saved. 78This can be done by renaming the file or by copying. 79 80Renaming means that Emacs renames the existing file so that it is a 81backup file, then writes the buffer into a new file. Any other names 82that the old file had will now refer to the backup file. The new file 83is owned by you and its group is defaulted. 84 85Copying means that Emacs copies the existing file into the backup 86file, then writes the buffer on top of the existing file. Any other 87names that the old file had will now refer to the new (edited) file. 88The file's owner and group are unchanged. 89 90The choice of renaming or copying is controlled by the variables 91`backup-by-copying', `backup-by-copying-when-linked', 92`backup-by-copying-when-mismatch' and 93`backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'." 94 :type 'boolean 95 :group 'backup) 96 97;; Do this so that local variables based on the file name 98;; are not overridden by the major mode. 99(defvar backup-inhibited nil 100 "Non-nil means don't make a backup, regardless of the other parameters. 101This variable is intended for use by making it local to a buffer. 102But it is local only if you make it local.") 103(put 'backup-inhibited 'permanent-local t) 104 105(defcustom backup-by-copying nil 106 "Non-nil means always use copying to create backup files. 107See documentation of variable `make-backup-files'." 108 :type 'boolean 109 :group 'backup) 110 111(defcustom backup-by-copying-when-linked nil 112 "Non-nil means use copying to create backups for files with multiple names. 113This causes the alternate names to refer to the latest version as edited. 114This variable is relevant only if `backup-by-copying' is nil." 115 :type 'boolean 116 :group 'backup) 117 118(defcustom backup-by-copying-when-mismatch nil 119 "Non-nil means create backups by copying if this preserves owner or group. 120Renaming may still be used (subject to control of other variables) 121when it would not result in changing the owner or group of the file; 122that is, for files which are owned by you and whose group matches 123the default for a new file created there by you. 124This variable is relevant only if `backup-by-copying' is nil." 125 :type 'boolean 126 :group 'backup) 127 128(defcustom backup-by-copying-when-privileged-mismatch 200 129 "Non-nil means create backups by copying to preserve a privileged owner. 130Renaming may still be used (subject to control of other variables) 131when it would not result in changing the owner of the file or if the owner 132has a user id greater than the value of this variable. This is useful 133when low-numbered uid's are used for special system users (such as root) 134that must maintain ownership of certain files. 135This variable is relevant only if `backup-by-copying' and 136`backup-by-copying-when-mismatch' are nil." 137 :type '(choice (const nil) integer) 138 :group 'backup) 139 140(defvar backup-enable-predicate 'normal-backup-enable-predicate 141 "Predicate that looks at a file name and decides whether to make backups. 142Called with an absolute file name as argument, it returns t to enable backup.") 143 144(defcustom buffer-offer-save nil 145 "Non-nil in a buffer means always offer to save buffer on exit. 146Do so even if the buffer is not visiting a file. 147Automatically local in all buffers." 148 :type 'boolean 149 :group 'backup) 150(make-variable-buffer-local 'buffer-offer-save) 151 152(defcustom find-file-existing-other-name t 153 "Non-nil means find a file under alternative names, in existing buffers. 154This means if any existing buffer is visiting the file you want 155under another name, you get the existing buffer instead of a new buffer." 156 :type 'boolean 157 :group 'find-file) 158 159(defcustom find-file-visit-truename nil 160 "*Non-nil means visit a file under its truename. 161The truename of a file is found by chasing all links 162both at the file level and at the levels of the containing directories." 163 :type 'boolean 164 :group 'find-file) 165(put 'find-file-visit-truename 'safe-local-variable 'boolean) 166 167(defcustom revert-without-query nil 168 "Specify which files should be reverted without query. 169The value is a list of regular expressions. 170If the file name matches one of these regular expressions, 171then `revert-buffer' reverts the file without querying 172if the file has changed on disk and you have not edited the buffer." 173 :type '(repeat regexp) 174 :group 'find-file) 175 176(defvar buffer-file-number nil 177 "The device number and file number of the file visited in the current buffer. 178The value is a list of the form (FILENUM DEVNUM). 179This pair of numbers uniquely identifies the file. 180If the buffer is visiting a new file, the value is nil.") 181(make-variable-buffer-local 'buffer-file-number) 182(put 'buffer-file-number 'permanent-local t) 183 184(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) 185 "Non-nil means that `buffer-file-number' uniquely identifies files.") 186 187(defvar buffer-file-read-only nil 188 "Non-nil if visited file was read-only when visited.") 189(make-variable-buffer-local 'buffer-file-read-only) 190 191(defcustom temporary-file-directory 192 (file-name-as-directory 193 (cond ((memq system-type '(ms-dos windows-nt)) 194 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) 195 ((memq system-type '(vax-vms axp-vms)) 196 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:")) 197 (t 198 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) 199 "The directory for writing temporary files." 200 :group 'files 201 :type 'directory) 202 203(defcustom small-temporary-file-directory 204 (if (eq system-type 'ms-dos) (getenv "TMPDIR")) 205 "The directory for writing small temporary files. 206If non-nil, this directory is used instead of `temporary-file-directory' 207by programs that create small temporary files. This is for systems that 208have fast storage with limited space, such as a RAM disk." 209 :group 'files 210 :type '(choice (const nil) directory)) 211 212;; The system null device. (Should reference NULL_DEVICE from C.) 213(defvar null-device "/dev/null" "The system null device.") 214 215(defvar file-name-invalid-regexp 216 (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names))) 217 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive 218 "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters 219 "[\000-\031]\\|" ; control characters 220 "\\(/\\.\\.?[^/]\\)\\|" ; leading dots 221 "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot 222 ((memq system-type '(ms-dos windows-nt cygwin)) 223 (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive 224 "[|<>\"?*\000-\031]")) ; invalid characters 225 (t "[\000]")) 226 "Regexp recognizing file names which aren't allowed by the filesystem.") 227 228(defcustom file-precious-flag nil 229 "Non-nil means protect against I/O errors while saving files. 230Some modes set this non-nil in particular buffers. 231 232This feature works by writing the new contents into a temporary file 233and then renaming the temporary file to replace the original. 234In this way, any I/O error in writing leaves the original untouched, 235and there is never any instant where the file is nonexistent. 236 237Note that this feature forces backups to be made by copying. 238Yet, at the same time, saving a precious file 239breaks any hard links between it and other files." 240 :type 'boolean 241 :group 'backup) 242 243(defcustom version-control nil 244 "Control use of version numbers for backup files. 245When t, make numeric backup versions unconditionally. 246When nil, make them for files that have some already. 247The value `never' means do not make them." 248 :type '(choice (const :tag "Never" never) 249 (const :tag "If existing" nil) 250 (other :tag "Always" t)) 251 :group 'backup 252 :group 'vc) 253(put 'version-control 'safe-local-variable 254 '(lambda (x) (or (booleanp x) (equal x 'never)))) 255 256(defcustom dired-kept-versions 2 257 "When cleaning directory, number of versions to keep." 258 :type 'integer 259 :group 'backup 260 :group 'dired) 261 262(defcustom delete-old-versions nil 263 "If t, delete excess backup versions silently. 264If nil, ask confirmation. Any other value prevents any trimming." 265 :type '(choice (const :tag "Delete" t) 266 (const :tag "Ask" nil) 267 (other :tag "Leave" other)) 268 :group 'backup) 269 270(defcustom kept-old-versions 2 271 "Number of oldest versions to keep when a new numbered backup is made." 272 :type 'integer 273 :group 'backup) 274(put 'kept-old-versions 'safe-local-variable 'integerp) 275 276(defcustom kept-new-versions 2 277 "Number of newest versions to keep when a new numbered backup is made. 278Includes the new backup. Must be > 0" 279 :type 'integer 280 :group 'backup) 281(put 'kept-new-versions 'safe-local-variable 'integerp) 282 283(defcustom require-final-newline nil 284 "Whether to add a newline automatically at the end of the file. 285 286A value of t means do this only when the file is about to be saved. 287A value of `visit' means do this right after the file is visited. 288A value of `visit-save' means do it at both of those times. 289Any other non-nil value means ask user whether to add a newline, when saving. 290A value of nil means don't add newlines. 291 292Certain major modes set this locally to the value obtained 293from `mode-require-final-newline'." 294 :type '(choice (const :tag "When visiting" visit) 295 (const :tag "When saving" t) 296 (const :tag "When visiting or saving" visit-save) 297 (const :tag "Don't add newlines" nil) 298 (other :tag "Ask each time" ask)) 299 :group 'editing-basics) 300 301(defcustom mode-require-final-newline t 302 "Whether to add a newline at end of file, in certain major modes. 303Those modes set `require-final-newline' to this value when you enable them. 304They do so because they are often used for files that are supposed 305to end in newlines, and the question is how to arrange that. 306 307A value of t means do this only when the file is about to be saved. 308A value of `visit' means do this right after the file is visited. 309A value of `visit-save' means do it at both of those times. 310Any other non-nil value means ask user whether to add a newline, when saving. 311 312A value of nil means do not add newlines. That is a risky choice in this 313variable since this value is used for modes for files that ought to have 314final newlines. So if you set this to nil, you must explicitly check and 315add a final newline, whenever you save a file that really needs one." 316 :type '(choice (const :tag "When visiting" visit) 317 (const :tag "When saving" t) 318 (const :tag "When visiting or saving" visit-save) 319 (const :tag "Don't add newlines" nil) 320 (other :tag "Ask each time" ask)) 321 :group 'editing-basics 322 :version "22.1") 323 324(defcustom auto-save-default t 325 "Non-nil says by default do auto-saving of every file-visiting buffer." 326 :type 'boolean 327 :group 'auto-save) 328 329(defcustom auto-save-visited-file-name nil 330 "Non-nil says auto-save a buffer in the file it is visiting, when practical. 331Normally auto-save files are written under other names." 332 :type 'boolean 333 :group 'auto-save) 334 335(defcustom auto-save-file-name-transforms 336 `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'" 337 ;; Don't put "\\2" inside expand-file-name, since it will be 338 ;; transformed to "/2" on DOS/Windows. 339 ,(concat temporary-file-directory "\\2") t)) 340 "Transforms to apply to buffer file name before making auto-save file name. 341Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): 342REGEXP is a regular expression to match against the file name. 343If it matches, `replace-match' is used to replace the 344matching part with REPLACEMENT. 345If the optional element UNIQUIFY is non-nil, the auto-save file name is 346constructed by taking the directory part of the replaced file-name, 347concatenated with the buffer file name with all directory separators 348changed to `!' to prevent clashes. This will not work 349correctly if your filesystem truncates the resulting name. 350 351All the transforms in the list are tried, in the order they are listed. 352When one transform applies, its result is final; 353no further transforms are tried. 354 355The default value is set up to put the auto-save file into the 356temporary directory (see the variable `temporary-file-directory') for 357editing a remote file. 358 359On MS-DOS filesystems without long names this variable is always 360ignored." 361 :group 'auto-save 362 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement") 363 (boolean :tag "Uniquify"))) 364 :version "21.1") 365 366(defcustom save-abbrevs t 367 "Non-nil means save word abbrevs too when files are saved. 368If `silently', don't ask the user before saving." 369 :type '(choice (const t) (const nil) (const silently)) 370 :group 'abbrev) 371 372(defcustom find-file-run-dired t 373 "Non-nil means allow `find-file' to visit directories. 374To visit the directory, `find-file' runs `find-directory-functions'." 375 :type 'boolean 376 :group 'find-file) 377 378(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect) 379 "List of functions to try in sequence to visit a directory. 380Each function is called with the directory name as the sole argument 381and should return either a buffer or nil." 382 :type '(hook :options (cvs-dired-noselect dired-noselect)) 383 :group 'find-file) 384 385;;;It is not useful to make this a local variable. 386;;;(put 'find-file-not-found-hooks 'permanent-local t) 387(defvar find-file-not-found-functions nil 388 "List of functions to be called for `find-file' on nonexistent file. 389These functions are called as soon as the error is detected. 390Variable `buffer-file-name' is already set up. 391The functions are called in the order given until one of them returns non-nil.") 392(define-obsolete-variable-alias 'find-file-not-found-hooks 393 'find-file-not-found-functions "22.1") 394 395;;;It is not useful to make this a local variable. 396;;;(put 'find-file-hooks 'permanent-local t) 397(defcustom find-file-hook nil 398 "List of functions to be called after a buffer is loaded from a file. 399The buffer's local variables (if any) will have been processed before the 400functions are called." 401 :group 'find-file 402 :type 'hook 403 :options '(auto-insert) 404 :version "22.1") 405(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1") 406 407(defvar write-file-functions nil 408 "List of functions to be called before writing out a buffer to a file. 409If one of them returns non-nil, the file is considered already written 410and the rest are not called. 411These hooks are considered to pertain to the visited file. 412So any buffer-local binding of this variable is discarded if you change 413the visited file name with \\[set-visited-file-name], but not when you 414change the major mode. 415 416This hook is not run if any of the functions in 417`write-contents-functions' returns non-nil. Both hooks pertain 418to how to save a buffer to file, for instance, choosing a suitable 419coding system and setting mode bits. (See Info 420node `(elisp)Saving Buffers'.) To perform various checks or 421updates before the buffer is saved, use `before-save-hook'.") 422(put 'write-file-functions 'permanent-local t) 423(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1") 424 425(defvar local-write-file-hooks nil) 426(make-variable-buffer-local 'local-write-file-hooks) 427(put 'local-write-file-hooks 'permanent-local t) 428(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1") 429 430(defvar write-contents-functions nil 431 "List of functions to be called before writing out a buffer to a file. 432If one of them returns non-nil, the file is considered already written 433and the rest are not called and neither are the functions in 434`write-file-functions'. 435 436This variable is meant to be used for hooks that pertain to the 437buffer's contents, not to the particular visited file; thus, 438`set-visited-file-name' does not clear this variable; but changing the 439major mode does clear it. 440 441For hooks that _do_ pertain to the particular visited file, use 442`write-file-functions'. Both this variable and 443`write-file-functions' relate to how a buffer is saved to file. 444To perform various checks or updates before the buffer is saved, 445use `before-save-hook'.") 446(make-variable-buffer-local 'write-contents-functions) 447(define-obsolete-variable-alias 'write-contents-hooks 448 'write-contents-functions "22.1") 449 450(defcustom enable-local-variables t 451 "Control use of local variables in files you visit. 452The value can be t, nil, :safe, or something else. 453 454A value of t means file local variables specifications are obeyed 455if all the specified variable values are safe; if any values are 456not safe, Emacs queries you, once, whether to set them all. 457\(When you say yes to certain values, they are remembered as safe.) 458 459:safe means set the safe variables, and ignore the rest. 460:all means set all variables, whether safe or not. 461 (Don't set it permanently to :all.) 462A value of nil means always ignore the file local variables. 463 464Any other value means always query you once whether to set them all. 465\(When you say yes to certain values, they are remembered as safe, but 466this has no effect when `enable-local-variables' is \"something else\".) 467 468This variable also controls use of major modes specified in 469a -*- line. 470 471The command \\[normal-mode], when used interactively, 472always obeys file local variable specifications and the -*- line, 473and ignores this variable." 474 :type '(choice (const :tag "Query Unsafe" t) 475 (const :tag "Safe Only" :safe) 476 (const :tag "Do all" :all) 477 (const :tag "Ignore" nil) 478 (other :tag "Query" other)) 479 :group 'find-file) 480 481(defvar local-enable-local-variables t 482 "Like `enable-local-variables' but meant for buffer-local bindings. 483The meaningful values are nil and non-nil. The default is non-nil. 484If a major mode sets this to nil, buffer-locally, then any local 485variables list in the file will be ignored. 486 487This variable does not affect the use of major modes 488specified in a -*- line.") 489 490(defcustom enable-local-eval 'maybe 491 "Control processing of the \"variable\" `eval' in a file's local variables. 492The value can be t, nil or something else. 493A value of t means obey `eval' variables; 494A value of nil means ignore them; anything else means query." 495 :type '(choice (const :tag "Obey" t) 496 (const :tag "Ignore" nil) 497 (other :tag "Query" other)) 498 :group 'find-file) 499 500;; Avoid losing in versions where CLASH_DETECTION is disabled. 501(or (fboundp 'lock-buffer) 502 (defalias 'lock-buffer 'ignore)) 503(or (fboundp 'unlock-buffer) 504 (defalias 'unlock-buffer 'ignore)) 505(or (fboundp 'file-locked-p) 506 (defalias 'file-locked-p 'ignore)) 507 508(defcustom view-read-only nil 509 "Non-nil means buffers visiting files read-only do so in view mode. 510In fact, this means that all read-only buffers normally have 511View mode enabled, including buffers that are read-only because 512you visit a file you cannot alter, and buffers you make read-only 513using \\[toggle-read-only]." 514 :type 'boolean 515 :group 'view) 516 517(defvar file-name-history nil 518 "History list of file names entered in the minibuffer.") 519 520(put 'ange-ftp-completion-hook-function 'safe-magic t) 521(defun ange-ftp-completion-hook-function (op &rest args) 522 "Provides support for ange-ftp host name completion. 523Runs the usual ange-ftp hook, but only for completion operations." 524 ;; Having this here avoids the need to load ange-ftp when it's not 525 ;; really in use. 526 (if (memq op '(file-name-completion file-name-all-completions)) 527 (apply 'ange-ftp-hook-function op args) 528 (let ((inhibit-file-name-handlers 529 (cons 'ange-ftp-completion-hook-function 530 (and (eq inhibit-file-name-operation op) 531 inhibit-file-name-handlers))) 532 (inhibit-file-name-operation op)) 533 (apply op args)))) 534 535(defun convert-standard-filename (filename) 536 "Convert a standard file's name to something suitable for the OS. 537This means to guarantee valid names and perhaps to canonicalize 538certain patterns. 539 540FILENAME should be an absolute file name since the conversion rules 541sometimes vary depending on the position in the file name. E.g. c:/foo 542is a valid DOS file name, but c:/bar/c:/foo is not. 543 544This function's standard definition is trivial; it just returns 545the argument. However, on Windows and DOS, replace invalid 546characters. On DOS, make sure to obey the 8.3 limitations. 547In the native Windows build, turn Cygwin names into native names, 548and also turn slashes into backslashes if the shell requires it (see 549`w32-shell-dos-semantics'). 550 551See Info node `(elisp)Standard File Names' for more details." 552 (if (eq system-type 'cygwin) 553 (let ((name (copy-sequence filename)) 554 (start 0)) 555 ;; Replace invalid filename characters with ! 556 (while (string-match "[?*:<>|\"\000-\037]" name start) 557 (aset name (match-beginning 0) ?!) 558 (setq start (match-end 0))) 559 name) 560 filename)) 561 562(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) 563 "Read directory name, prompting with PROMPT and completing in directory DIR. 564Value is not expanded---you must call `expand-file-name' yourself. 565Default name to DEFAULT-DIRNAME if user exits with the same 566non-empty string that was inserted by this function. 567 (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used, 568 or just DIR if INITIAL is nil.) 569If the user exits with an empty minibuffer, this function returns 570an empty string. (This can only happen if the user erased the 571pre-inserted contents or if `insert-default-directory' is nil.) 572Fourth arg MUSTMATCH non-nil means require existing directory's name. 573 Non-nil and non-t means also require confirmation after completion. 574Fifth arg INITIAL specifies text to start with. 575DIR should be an absolute directory name. It defaults to 576the value of `default-directory'." 577 (unless dir 578 (setq dir default-directory)) 579 (read-file-name prompt dir (or default-dirname 580 (if initial (expand-file-name initial dir) 581 dir)) 582 mustmatch initial 583 'file-directory-p)) 584 585 586(defun pwd () 587 "Show the current default directory." 588 (interactive nil) 589 (message "Directory %s" default-directory)) 590 591(defvar cd-path nil 592 "Value of the CDPATH environment variable, as a list. 593Not actually set up until the first time you use it.") 594 595(defun parse-colon-path (cd-path) 596 "Explode a search path into a list of directory names. 597Directories are separated by occurrences of `path-separator' 598\(which is colon in GNU and GNU-like systems)." 599 ;; We could use split-string here. 600 (and cd-path 601 (let (cd-list (cd-start 0) cd-colon) 602 (setq cd-path (concat cd-path path-separator)) 603 (while (setq cd-colon (string-match path-separator cd-path cd-start)) 604 (setq cd-list 605 (nconc cd-list 606 (list (if (= cd-start cd-colon) 607 nil 608 (substitute-in-file-name 609 (file-name-as-directory 610 (substring cd-path cd-start cd-colon))))))) 611 (setq cd-start (+ cd-colon 1))) 612 cd-list))) 613 614(defun cd-absolute (dir) 615 "Change current directory to given absolute file name DIR." 616 ;; Put the name into directory syntax now, 617 ;; because otherwise expand-file-name may give some bad results. 618 (if (not (eq system-type 'vax-vms)) 619 (setq dir (file-name-as-directory dir))) 620 (setq dir (abbreviate-file-name (expand-file-name dir))) 621 (if (not (file-directory-p dir)) 622 (if (file-exists-p dir) 623 (error "%s is not a directory" dir) 624 (error "%s: no such directory" dir)) 625 (if (file-executable-p dir) 626 (setq default-directory dir) 627 (error "Cannot cd to %s: Permission denied" dir)))) 628 629(defun cd (dir) 630 "Make DIR become the current buffer's default directory. 631If your environment includes a `CDPATH' variable, try each one of 632that list of directories (separated by occurrences of 633`path-separator') when resolving a relative directory name. 634The path separator is colon in GNU and GNU-like systems." 635 (interactive 636 (list (read-directory-name "Change default directory: " 637 default-directory default-directory 638 (and (member cd-path '(nil ("./"))) 639 (null (getenv "CDPATH")))))) 640 (if (file-name-absolute-p dir) 641 (cd-absolute (expand-file-name dir)) 642 (if (null cd-path) 643 (let ((trypath (parse-colon-path (getenv "CDPATH")))) 644 (setq cd-path (or trypath (list "./"))))) 645 (if (not (catch 'found 646 (mapcar 647 (function (lambda (x) 648 (let ((f (expand-file-name (concat x dir)))) 649 (if (file-directory-p f) 650 (progn 651 (cd-absolute f) 652 (throw 'found t)))))) 653 cd-path) 654 nil)) 655 (error "No such directory found via CDPATH environment variable")))) 656 657(defun load-file (file) 658 "Load the Lisp file named FILE." 659 ;; This is a case where .elc makes a lot of sense. 660 (interactive (list (let ((completion-ignored-extensions 661 (remove ".elc" completion-ignored-extensions))) 662 (read-file-name "Load file: ")))) 663 (load (expand-file-name file) nil nil t)) 664 665(defun locate-file (filename path &optional suffixes predicate) 666 "Search for FILENAME through PATH. 667If found, return the absolute file name of FILENAME, with its suffixes; 668otherwise return nil. 669PATH should be a list of directories to look in, like the lists in 670`exec-path' or `load-path'. 671If SUFFIXES is non-nil, it should be a list of suffixes to append to 672file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\"). 673Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES. 674If non-nil, PREDICATE is used instead of `file-readable-p'. 675PREDICATE can also be an integer to pass to the `access' system call, 676in which case file-name handlers are ignored. This usage is deprecated. 677 678For compatibility, PREDICATE can also be one of the symbols 679`executable', `readable', `writable', or `exists', or a list of 680one or more of those symbols." 681 (if (and predicate (symbolp predicate) (not (functionp predicate))) 682 (setq predicate (list predicate))) 683 (when (and (consp predicate) (not (functionp predicate))) 684 (setq predicate 685 (logior (if (memq 'executable predicate) 1 0) 686 (if (memq 'writable predicate) 2 0) 687 (if (memq 'readable predicate) 4 0)))) 688 (locate-file-internal filename path suffixes predicate)) 689 690(defun locate-file-completion (string path-and-suffixes action) 691 "Do completion for file names passed to `locate-file'. 692PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." 693 (if (file-name-absolute-p string) 694 (read-file-name-internal string nil action) 695 (let ((names nil) 696 (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'")) 697 (string-dir (file-name-directory string))) 698 (dolist (dir (car path-and-suffixes)) 699 (unless dir 700 (setq dir default-directory)) 701 (if string-dir (setq dir (expand-file-name string-dir dir))) 702 (when (file-directory-p dir) 703 (dolist (file (file-name-all-completions 704 (file-name-nondirectory string) dir)) 705 (add-to-list 'names (if string-dir (concat string-dir file) file)) 706 (when (string-match suffix file) 707 (setq file (substring file 0 (match-beginning 0))) 708 (push (if string-dir (concat string-dir file) file) names))))) 709 (cond 710 ((eq action t) (all-completions string names)) 711 ((null action) (try-completion string names)) 712 (t (test-completion string names)))))) 713 714(defun executable-find (command) 715 "Search for COMMAND in `exec-path' and return the absolute file name. 716Return nil if COMMAND is not found anywhere in `exec-path'." 717 ;; Use 1 rather than file-executable-p to better match the behavior of 718 ;; call-process. 719 (locate-file command exec-path exec-suffixes 1)) 720 721(defun load-library (library) 722 "Load the library named LIBRARY. 723This is an interface to the function `load'." 724 (interactive 725 (list (completing-read "Load library: " 726 'locate-file-completion 727 (cons load-path (get-load-suffixes))))) 728 (load library)) 729 730(defun file-remote-p (file) 731 "Test whether FILE specifies a location on a remote system. 732Return an identification of the system if the location is indeed 733remote. The identification of the system may comprise a method 734to access the system and its hostname, amongst other things. 735 736For example, the filename \"/user@host:/foo\" specifies a location 737on the system \"/user@host:\"." 738 (let ((handler (find-file-name-handler file 'file-remote-p))) 739 (if handler 740 (funcall handler 'file-remote-p file) 741 nil))) 742 743(defun file-local-copy (file) 744 "Copy the file FILE into a temporary file on this machine. 745Returns the name of the local copy, or nil, if FILE is directly 746accessible." 747 ;; This formerly had an optional BUFFER argument that wasn't used by 748 ;; anything. 749 (let ((handler (find-file-name-handler file 'file-local-copy))) 750 (if handler 751 (funcall handler 'file-local-copy file) 752 nil))) 753 754(defun file-truename (filename &optional counter prev-dirs) 755 "Return the truename of FILENAME, which should be absolute. 756The truename of a file name is found by chasing symbolic links 757both at the level of the file and at the level of the directories 758containing it, until no links are left at any level. 759 760\(fn FILENAME)" ;; Don't document the optional arguments. 761 ;; COUNTER and PREV-DIRS are only used in recursive calls. 762 ;; COUNTER can be a cons cell whose car is the count of how many 763 ;; more links to chase before getting an error. 764 ;; PREV-DIRS can be a cons cell whose car is an alist 765 ;; of truenames we've just recently computed. 766 (cond ((or (string= filename "") (string= filename "~")) 767 (setq filename (expand-file-name filename)) 768 (if (string= filename "") 769 (setq filename "/"))) 770 ((and (string= (substring filename 0 1) "~") 771 (string-match "~[^/]*/?" filename)) 772 (let ((first-part 773 (substring filename 0 (match-end 0))) 774 (rest (substring filename (match-end 0)))) 775 (setq filename (concat (expand-file-name first-part) rest))))) 776 777 (or counter (setq counter (list 100))) 778 (let (done 779 ;; For speed, remove the ange-ftp completion handler from the list. 780 ;; We know it's not needed here. 781 ;; For even more speed, do this only on the outermost call. 782 (file-name-handler-alist 783 (if prev-dirs file-name-handler-alist 784 (let ((tem (copy-sequence file-name-handler-alist))) 785 (delq (rassq 'ange-ftp-completion-hook-function tem) tem))))) 786 (or prev-dirs (setq prev-dirs (list nil))) 787 788 ;; andrewi@harlequin.co.uk - none of the following code (except for 789 ;; invoking the file-name handler) currently applies on Windows 790 ;; (ie. there are no native symlinks), but there is an issue with 791 ;; case differences being ignored by the OS, and short "8.3 DOS" 792 ;; name aliases existing for all files. (The short names are not 793 ;; reported by directory-files, but can be used to refer to files.) 794 ;; It seems appropriate for file-truename to resolve these issues in 795 ;; the most natural way, which on Windows is to call the function 796 ;; `w32-long-file-name' - this returns the exact name of a file as 797 ;; it is stored on disk (expanding short name aliases with the full 798 ;; name in the process). 799 (if (eq system-type 'windows-nt) 800 (let ((handler (find-file-name-handler filename 'file-truename))) 801 ;; For file name that has a special handler, call handler. 802 ;; This is so that ange-ftp can save time by doing a no-op. 803 (if handler 804 (setq filename (funcall handler 'file-truename filename)) 805 ;; If filename contains a wildcard, newname will be the old name. 806 (unless (string-match "[[*?]" filename) 807 ;; If filename exists, use the long name 808 (setq filename (or (w32-long-file-name filename) filename)))) 809 (setq done t))) 810 811 ;; If this file directly leads to a link, process that iteratively 812 ;; so that we don't use lots of stack. 813 (while (not done) 814 (setcar counter (1- (car counter))) 815 (if (< (car counter) 0) 816 (error "Apparent cycle of symbolic links for %s" filename)) 817 (let ((handler (find-file-name-handler filename 'file-truename))) 818 ;; For file name that has a special handler, call handler. 819 ;; This is so that ange-ftp can save time by doing a no-op. 820 (if handler 821 (setq filename (funcall handler 'file-truename filename) 822 done t) 823 (let ((dir (or (file-name-directory filename) default-directory)) 824 target dirfile) 825 ;; Get the truename of the directory. 826 (setq dirfile (directory-file-name dir)) 827 ;; If these are equal, we have the (or a) root directory. 828 (or (string= dir dirfile) 829 ;; If this is the same dir we last got the truename for, 830 ;; save time--don't recalculate. 831 (if (assoc dir (car prev-dirs)) 832 (setq dir (cdr (assoc dir (car prev-dirs)))) 833 (let ((old dir) 834 (new (file-name-as-directory (file-truename dirfile counter prev-dirs)))) 835 (setcar prev-dirs (cons (cons old new) (car prev-dirs))) 836 (setq dir new)))) 837 (if (equal ".." (file-name-nondirectory filename)) 838 (setq filename 839 (directory-file-name (file-name-directory (directory-file-name dir))) 840 done t) 841 (if (equal "." (file-name-nondirectory filename)) 842 (setq filename (directory-file-name dir) 843 done t) 844 ;; Put it back on the file name. 845 (setq filename (concat dir (file-name-nondirectory filename))) 846 ;; Is the file name the name of a link? 847 (setq target (file-symlink-p filename)) 848 (if target 849 ;; Yes => chase that link, then start all over 850 ;; since the link may point to a directory name that uses links. 851 ;; We can't safely use expand-file-name here 852 ;; since target might look like foo/../bar where foo 853 ;; is itself a link. Instead, we handle . and .. above. 854 (setq filename 855 (if (file-name-absolute-p target) 856 target 857 (concat dir target)) 858 done nil) 859 ;; No, we are done! 860 (setq done t)))))))) 861 filename)) 862 863(defun file-chase-links (filename &optional limit) 864 "Chase links in FILENAME until a name that is not a link. 865Unlike `file-truename', this does not check whether a parent 866directory name is a symbolic link. 867If the optional argument LIMIT is a number, 868it means chase no more than that many links and then stop." 869 (let (tem (newname filename) 870 (count 0)) 871 (while (and (or (null limit) (< count limit)) 872 (setq tem (file-symlink-p newname))) 873 (save-match-data 874 (if (and (null limit) (= count 100)) 875 (error "Apparent cycle of symbolic links for %s" filename)) 876 ;; In the context of a link, `//' doesn't mean what Emacs thinks. 877 (while (string-match "//+" tem) 878 (setq tem (replace-match "/" nil nil tem))) 879 ;; Handle `..' by hand, since it needs to work in the 880 ;; target of any directory symlink. 881 ;; This code is not quite complete; it does not handle 882 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. 883 (while (string-match "\\`\\.\\./" tem) 884 (setq tem (substring tem 3)) 885 (setq newname (expand-file-name newname)) 886 ;; Chase links in the default dir of the symlink. 887 (setq newname 888 (file-chase-links 889 (directory-file-name (file-name-directory newname)))) 890 ;; Now find the parent of that dir. 891 (setq newname (file-name-directory newname))) 892 (setq newname (expand-file-name tem (file-name-directory newname))) 893 (setq count (1+ count)))) 894 newname)) 895 896(defun make-temp-file (prefix &optional dir-flag suffix) 897 "Create a temporary file. 898The returned file name (created by appending some random characters at the end 899of PREFIX, and expanding against `temporary-file-directory' if necessary), 900is guaranteed to point to a newly created empty file. 901You can then use `write-region' to write new data into the file. 902 903If DIR-FLAG is non-nil, create a new empty directory instead of a file. 904 905If SUFFIX is non-nil, add that at the end of the file name." 906 (let ((umask (default-file-modes)) 907 file) 908 (unwind-protect 909 (progn 910 ;; Create temp files with strict access rights. It's easy to 911 ;; loosen them later, whereas it's impossible to close the 912 ;; time-window of loose permissions otherwise. 913 (set-default-file-modes ?\700) 914 (while (condition-case () 915 (progn 916 (setq file 917 (make-temp-name 918 (expand-file-name prefix temporary-file-directory))) 919 (if suffix 920 (setq file (concat file suffix))) 921 (if dir-flag 922 (make-directory file) 923 (write-region "" nil file nil 'silent nil 'excl)) 924 nil) 925 (file-already-exists t)) 926 ;; the file was somehow created by someone else between 927 ;; `make-temp-name' and `write-region', let's try again. 928 nil) 929 file) 930 ;; Reset the umask. 931 (set-default-file-modes umask)))) 932 933(defun recode-file-name (file coding new-coding &optional ok-if-already-exists) 934 "Change the encoding of FILE's name from CODING to NEW-CODING. 935The value is a new name of FILE. 936Signals a `file-already-exists' error if a file of the new name 937already exists unless optional fourth argument OK-IF-ALREADY-EXISTS 938is non-nil. A number as fourth arg means request confirmation if 939the new name already exists. This is what happens in interactive 940use with M-x." 941 (interactive 942 (let ((default-coding (or file-name-coding-system 943 default-file-name-coding-system)) 944 (filename (read-file-name "Recode filename: " nil nil t)) 945 from-coding to-coding) 946 (if (and default-coding 947 ;; We provide the default coding only when it seems that 948 ;; the filename is correctly decoded by the default 949 ;; coding. 950 (let ((charsets (find-charset-string filename))) 951 (and (not (memq 'eight-bit-control charsets)) 952 (not (memq 'eight-bit-graphic charsets))))) 953 (setq from-coding (read-coding-system 954 (format "Recode filename %s from (default %s): " 955 filename default-coding) 956 default-coding)) 957 (setq from-coding (read-coding-system 958 (format "Recode filename %s from: " filename)))) 959 960 ;; We provide the default coding only when a user is going to 961 ;; change the encoding not from the default coding. 962 (if (eq from-coding default-coding) 963 (setq to-coding (read-coding-system 964 (format "Recode filename %s from %s to: " 965 filename from-coding))) 966 (setq to-coding (read-coding-system 967 (format "Recode filename %s from %s to (default %s): " 968 filename from-coding default-coding) 969 default-coding))) 970 (list filename from-coding to-coding))) 971 972 (let* ((default-coding (or file-name-coding-system 973 default-file-name-coding-system)) 974 ;; FILE should have been decoded by DEFAULT-CODING. 975 (encoded (encode-coding-string file default-coding)) 976 (newname (decode-coding-string encoded coding)) 977 (new-encoded (encode-coding-string newname new-coding)) 978 ;; Suppress further encoding. 979 (file-name-coding-system nil) 980 (default-file-name-coding-system nil) 981 (locale-coding-system nil)) 982 (rename-file encoded new-encoded ok-if-already-exists) 983 newname)) 984 985(defun switch-to-buffer-other-window (buffer &optional norecord) 986 "Select buffer BUFFER in another window. 987If BUFFER does not identify an existing buffer, then this function 988creates a buffer with that name. 989 990When called from Lisp, BUFFER can be a buffer, a string \(a buffer name), 991or nil. If BUFFER is nil, then this function chooses a buffer 992using `other-buffer'. 993Optional second arg NORECORD non-nil means 994do not put this buffer at the front of the list of recently selected ones. 995This function returns the buffer it switched to. 996 997This uses the function `display-buffer' as a subroutine; see its 998documentation for additional customization information." 999 (interactive "BSwitch to buffer in other window: ") 1000 (let ((pop-up-windows t) 1001 ;; Don't let these interfere. 1002 same-window-buffer-names same-window-regexps) 1003 (pop-to-buffer buffer t norecord))) 1004 1005(defun switch-to-buffer-other-frame (buffer &optional norecord) 1006 "Switch to buffer BUFFER in another frame. 1007Optional second arg NORECORD non-nil means 1008do not put this buffer at the front of the list of recently selected ones. 1009 1010This uses the function `display-buffer' as a subroutine; see its 1011documentation for additional customization information." 1012 (interactive "BSwitch to buffer in other frame: ") 1013 (let ((pop-up-frames t) 1014 same-window-buffer-names same-window-regexps) 1015 (pop-to-buffer buffer t norecord) 1016 (raise-frame (window-frame (selected-window))))) 1017 1018(defun display-buffer-other-frame (buffer) 1019 "Switch to buffer BUFFER in another frame. 1020This uses the function `display-buffer' as a subroutine; see its 1021documentation for additional customization information." 1022 (interactive "BDisplay buffer in other frame: ") 1023 (let ((pop-up-frames t) 1024 same-window-buffer-names same-window-regexps 1025 (old-window (selected-window)) 1026 new-window) 1027 (setq new-window (display-buffer buffer t)) 1028 (lower-frame (window-frame new-window)) 1029 (make-frame-invisible (window-frame old-window)) 1030 (make-frame-visible (window-frame old-window)))) 1031 1032(defvar find-file-default nil 1033 "Used within `find-file-read-args'.") 1034 1035(defmacro minibuffer-with-setup-hook (fun &rest body) 1036 "Add FUN to `minibuffer-setup-hook' while executing BODY. 1037BODY should use the minibuffer at most once. 1038Recursive uses of the minibuffer will not be affected." 1039 (declare (indent 1) (debug t)) 1040 (let ((hook (make-symbol "setup-hook"))) 1041 `(let (,hook) 1042 (setq ,hook 1043 (lambda () 1044 ;; Clear out this hook so it does not interfere 1045 ;; with any recursive minibuffer usage. 1046 (remove-hook 'minibuffer-setup-hook ,hook) 1047 (,fun))) 1048 (unwind-protect 1049 (progn 1050 (add-hook 'minibuffer-setup-hook ,hook) 1051 ,@body) 1052 (remove-hook 'minibuffer-setup-hook ,hook))))) 1053 1054(defun find-file-read-args (prompt mustmatch) 1055 (list (let ((find-file-default 1056 (and buffer-file-name 1057 (abbreviate-file-name buffer-file-name)))) 1058 (minibuffer-with-setup-hook 1059 (lambda () (setq minibuffer-default find-file-default)) 1060 (read-file-name prompt nil default-directory mustmatch))) 1061 t)) 1062 1063(defun find-file (filename &optional wildcards) 1064 "Edit file FILENAME. 1065Switch to a buffer visiting file FILENAME, 1066creating one if none already exists. 1067Interactively, the default if you just type RET is the current directory, 1068but the visited file name is available through the minibuffer history: 1069type M-n to pull it into the minibuffer. 1070 1071Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1072expand wildcards (if any) and visit multiple files. You can 1073suppress wildcard expansion by setting `find-file-wildcards' to nil. 1074 1075To visit a file without any kind of conversion and without 1076automatically choosing a major mode, use \\[find-file-literally]." 1077 (interactive (find-file-read-args "Find file: " nil)) 1078 (let ((value (find-file-noselect filename nil nil wildcards))) 1079 (if (listp value) 1080 (mapcar 'switch-to-buffer (nreverse value)) 1081 (switch-to-buffer value)))) 1082 1083(defun find-file-other-window (filename &optional wildcards) 1084 "Edit file FILENAME, in another window. 1085May create a new window, or reuse an existing one. 1086See the function `display-buffer'. 1087 1088Interactively, the default if you just type RET is the current directory, 1089but the visited file name is available through the minibuffer history: 1090type M-n to pull it into the minibuffer. 1091 1092Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1093expand wildcards (if any) and visit multiple files." 1094 (interactive (find-file-read-args "Find file in other window: " nil)) 1095 (let ((value (find-file-noselect filename nil nil wildcards))) 1096 (if (listp value) 1097 (progn 1098 (setq value (nreverse value)) 1099 (cons (switch-to-buffer-other-window (car value)) 1100 (mapcar 'switch-to-buffer (cdr value)))) 1101 (switch-to-buffer-other-window value)))) 1102 1103(defun find-file-other-frame (filename &optional wildcards) 1104 "Edit file FILENAME, in another frame. 1105May create a new frame, or reuse an existing one. 1106See the function `display-buffer'. 1107 1108Interactively, the default if you just type RET is the current directory, 1109but the visited file name is available through the minibuffer history: 1110type M-n to pull it into the minibuffer. 1111 1112Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1113expand wildcards (if any) and visit multiple files." 1114 (interactive (find-file-read-args "Find file in other frame: " nil)) 1115 (let ((value (find-file-noselect filename nil nil wildcards))) 1116 (if (listp value) 1117 (progn 1118 (setq value (nreverse value)) 1119 (cons (switch-to-buffer-other-frame (car value)) 1120 (mapcar 'switch-to-buffer (cdr value)))) 1121 (switch-to-buffer-other-frame value)))) 1122 1123(defun find-file-existing (filename) 1124 "Edit the existing file FILENAME. 1125Like \\[find-file] but only allow a file that exists, and do not allow 1126file names with wildcards." 1127 (interactive (nbutlast (find-file-read-args "Find existing file: " t))) 1128 (if (and (not (interactive-p)) (not (file-exists-p filename))) 1129 (error "%s does not exist" filename) 1130 (find-file filename) 1131 (current-buffer))) 1132 1133(defun find-file-read-only (filename &optional wildcards) 1134 "Edit file FILENAME but don't allow changes. 1135Like \\[find-file] but marks buffer as read-only. 1136Use \\[toggle-read-only] to permit editing." 1137 (interactive (find-file-read-args "Find file read-only: " nil)) 1138 (unless (or (and wildcards find-file-wildcards 1139 (not (string-match "\\`/:" filename)) 1140 (string-match "[[*?]" filename)) 1141 (file-exists-p filename)) 1142 (error "%s does not exist" filename)) 1143 (let ((value (find-file filename wildcards))) 1144 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1145 (if (listp value) value (list value))) 1146 value)) 1147 1148(defun find-file-read-only-other-window (filename &optional wildcards) 1149 "Edit file FILENAME in another window but don't allow changes. 1150Like \\[find-file-other-window] but marks buffer as read-only. 1151Use \\[toggle-read-only] to permit editing." 1152 (interactive (find-file-read-args "Find file read-only other window: " nil)) 1153 (unless (or (and wildcards find-file-wildcards 1154 (not (string-match "\\`/:" filename)) 1155 (string-match "[[*?]" filename)) 1156 (file-exists-p filename)) 1157 (error "%s does not exist" filename)) 1158 (let ((value (find-file-other-window filename wildcards))) 1159 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1160 (if (listp value) value (list value))) 1161 value)) 1162 1163(defun find-file-read-only-other-frame (filename &optional wildcards) 1164 "Edit file FILENAME in another frame but don't allow changes. 1165Like \\[find-file-other-frame] but marks buffer as read-only. 1166Use \\[toggle-read-only] to permit editing." 1167 (interactive (find-file-read-args "Find file read-only other frame: " nil)) 1168 (unless (or (and wildcards find-file-wildcards 1169 (not (string-match "\\`/:" filename)) 1170 (string-match "[[*?]" filename)) 1171 (file-exists-p filename)) 1172 (error "%s does not exist" filename)) 1173 (let ((value (find-file-other-frame filename wildcards))) 1174 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1175 (if (listp value) value (list value))) 1176 value)) 1177 1178(defun find-alternate-file-other-window (filename &optional wildcards) 1179 "Find file FILENAME as a replacement for the file in the next window. 1180This command does not select that window. 1181 1182Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1183expand wildcards (if any) and replace the file with multiple files." 1184 (interactive 1185 (save-selected-window 1186 (other-window 1) 1187 (let ((file buffer-file-name) 1188 (file-name nil) 1189 (file-dir nil)) 1190 (and file 1191 (setq file-name (file-name-nondirectory file) 1192 file-dir (file-name-directory file))) 1193 (list (read-file-name 1194 "Find alternate file: " file-dir nil nil file-name) 1195 t)))) 1196 (if (one-window-p) 1197 (find-file-other-window filename wildcards) 1198 (save-selected-window 1199 (other-window 1) 1200 (find-alternate-file filename wildcards)))) 1201 1202(defun find-alternate-file (filename &optional wildcards) 1203 "Find file FILENAME, select its buffer, kill previous buffer. 1204If the current buffer now contains an empty file that you just visited 1205\(presumably by mistake), use this command to visit the file you really want. 1206 1207Interactively, or if WILDCARDS is non-nil in a call from Lisp, 1208expand wildcards (if any) and replace the file with multiple files. 1209 1210If the current buffer is an indirect buffer, or the base buffer 1211for one or more indirect buffers, the other buffer(s) are not 1212killed." 1213 (interactive 1214 (let ((file buffer-file-name) 1215 (file-name nil) 1216 (file-dir nil)) 1217 (and file 1218 (setq file-name (file-name-nondirectory file) 1219 file-dir (file-name-directory file))) 1220 (list (read-file-name 1221 "Find alternate file: " file-dir nil nil file-name) 1222 t))) 1223 (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) 1224 (error "Aborted")) 1225 (when (and (buffer-modified-p) (buffer-file-name)) 1226 (if (yes-or-no-p (format "Buffer %s is modified; kill anyway? " 1227 (buffer-name))) 1228 (unless (yes-or-no-p "Kill and replace the buffer without saving it? ") 1229 (error "Aborted")) 1230 (save-buffer))) 1231 (let ((obuf (current-buffer)) 1232 (ofile buffer-file-name) 1233 (onum buffer-file-number) 1234 (odir dired-directory) 1235 (otrue buffer-file-truename) 1236 (oname (buffer-name))) 1237 (if (get-buffer " **lose**") 1238 (kill-buffer " **lose**")) 1239 (rename-buffer " **lose**") 1240 (unwind-protect 1241 (progn 1242 (unlock-buffer) 1243 ;; This prevents us from finding the same buffer 1244 ;; if we specified the same file again. 1245 (setq buffer-file-name nil) 1246 (setq buffer-file-number nil) 1247 (setq buffer-file-truename nil) 1248 ;; Likewise for dired buffers. 1249 (setq dired-directory nil) 1250 (find-file filename wildcards)) 1251 (when (eq obuf (current-buffer)) 1252 ;; This executes if find-file gets an error 1253 ;; and does not really find anything. 1254 ;; We put things back as they were. 1255 ;; If find-file actually finds something, we kill obuf below. 1256 (setq buffer-file-name ofile) 1257 (setq buffer-file-number onum) 1258 (setq buffer-file-truename otrue) 1259 (setq dired-directory odir) 1260 (lock-buffer) 1261 (rename-buffer oname))) 1262 (unless (eq (current-buffer) obuf) 1263 (with-current-buffer obuf 1264 ;; We already asked; don't ask again. 1265 (let ((kill-buffer-query-functions)) 1266 (kill-buffer obuf)))))) 1267 1268(defun create-file-buffer (filename) 1269 "Create a suitably named buffer for visiting FILENAME, and return it. 1270FILENAME (sans directory) is used unchanged if that name is free; 1271otherwise a string <2> or <3> or ... is appended to get an unused name." 1272 (let ((lastname (file-name-nondirectory filename))) 1273 (if (string= lastname "") 1274 (setq lastname filename)) 1275 (generate-new-buffer lastname))) 1276 1277(defun generate-new-buffer (name) 1278 "Create and return a buffer with a name based on NAME. 1279Choose the buffer's name using `generate-new-buffer-name'." 1280 (get-buffer-create (generate-new-buffer-name name))) 1281 1282(defcustom automount-dir-prefix "^/tmp_mnt/" 1283 "Regexp to match the automounter prefix in a directory name." 1284 :group 'files 1285 :type 'regexp) 1286 1287(defvar abbreviated-home-dir nil 1288 "The user's homedir abbreviated according to `directory-abbrev-alist'.") 1289 1290(defun abbreviate-file-name (filename) 1291 "Return a version of FILENAME shortened using `directory-abbrev-alist'. 1292This also substitutes \"~\" for the user's home directory (unless the 1293home directory is a root directory) and removes automounter prefixes 1294\(see the variable `automount-dir-prefix')." 1295 ;; Get rid of the prefixes added by the automounter. 1296 (save-match-data 1297 (if (and automount-dir-prefix 1298 (string-match automount-dir-prefix filename) 1299 (file-exists-p (file-name-directory 1300 (substring filename (1- (match-end 0)))))) 1301 (setq filename (substring filename (1- (match-end 0))))) 1302 (let ((tail directory-abbrev-alist)) 1303 ;; If any elt of directory-abbrev-alist matches this name, 1304 ;; abbreviate accordingly. 1305 (while tail 1306 (if (string-match (car (car tail)) filename) 1307 (setq filename 1308 (concat (cdr (car tail)) (substring filename (match-end 0))))) 1309 (setq tail (cdr tail))) 1310 ;; Compute and save the abbreviated homedir name. 1311 ;; We defer computing this until the first time it's needed, to 1312 ;; give time for directory-abbrev-alist to be set properly. 1313 ;; We include a slash at the end, to avoid spurious matches 1314 ;; such as `/usr/foobar' when the home dir is `/usr/foo'. 1315 (or abbreviated-home-dir 1316 (setq abbreviated-home-dir 1317 (let ((abbreviated-home-dir "$foo")) 1318 (concat "^" (abbreviate-file-name (expand-file-name "~")) 1319 "\\(/\\|\\'\\)")))) 1320 1321 ;; If FILENAME starts with the abbreviated homedir, 1322 ;; make it start with `~' instead. 1323 (if (and (string-match abbreviated-home-dir filename) 1324 ;; If the home dir is just /, don't change it. 1325 (not (and (= (match-end 0) 1) 1326 (= (aref filename 0) ?/))) 1327 ;; MS-DOS root directories can come with a drive letter; 1328 ;; Novell Netware allows drive letters beyond `Z:'. 1329 (not (and (or (eq system-type 'ms-dos) 1330 (eq system-type 'cygwin) 1331 (eq system-type 'windows-nt)) 1332 (save-match-data 1333 (string-match "^[a-zA-`]:/$" filename))))) 1334 (setq filename 1335 (concat "~" 1336 (match-string 1 filename) 1337 (substring filename (match-end 0))))) 1338 filename))) 1339 1340(defcustom find-file-not-true-dirname-list nil 1341 "List of logical names for which visiting shouldn't save the true dirname. 1342On VMS, when you visit a file using a logical name that searches a path, 1343you may or may not want the visited file name to record the specific 1344directory where the file was found. If you *do not* want that, add the logical 1345name to this list as a string." 1346 :type '(repeat (string :tag "Name")) 1347 :group 'find-file) 1348 1349(defun find-buffer-visiting (filename &optional predicate) 1350 "Return the buffer visiting file FILENAME (a string). 1351This is like `get-file-buffer', except that it checks for any buffer 1352visiting the same file, possibly under a different name. 1353If PREDICATE is non-nil, only buffers satisfying it are eligible, 1354and others are ignored. 1355If there is no such live buffer, return nil." 1356 (let ((predicate (or predicate #'identity)) 1357 (truename (abbreviate-file-name (file-truename filename)))) 1358 (or (let ((buf (get-file-buffer filename))) 1359 (when (and buf (funcall predicate buf)) buf)) 1360 (let ((list (buffer-list)) found) 1361 (while (and (not found) list) 1362 (save-excursion 1363 (set-buffer (car list)) 1364 (if (and buffer-file-name 1365 (string= buffer-file-truename truename) 1366 (funcall predicate (current-buffer))) 1367 (setq found (car list)))) 1368 (setq list (cdr list))) 1369 found) 1370 (let* ((attributes (file-attributes truename)) 1371 (number (nthcdr 10 attributes)) 1372 (list (buffer-list)) found) 1373 (and buffer-file-numbers-unique 1374 (car-safe number) ;Make sure the inode is not just nil. 1375 (while (and (not found) list) 1376 (with-current-buffer (car list) 1377 (if (and buffer-file-name 1378 (equal buffer-file-number number) 1379 ;; Verify this buffer's file number 1380 ;; still belongs to its file. 1381 (file-exists-p buffer-file-name) 1382 (equal (file-attributes buffer-file-truename) 1383 attributes) 1384 (funcall predicate (current-buffer))) 1385 (setq found (car list)))) 1386 (setq list (cdr list)))) 1387 found)))) 1388 1389(defcustom find-file-wildcards t 1390 "Non-nil means file-visiting commands should handle wildcards. 1391For example, if you specify `*.c', that would visit all the files 1392whose names match the pattern." 1393 :group 'files 1394 :version "20.4" 1395 :type 'boolean) 1396 1397(defcustom find-file-suppress-same-file-warnings nil 1398 "Non-nil means suppress warning messages for symlinked files. 1399When nil, Emacs prints a warning when visiting a file that is already 1400visited, but with a different name. Setting this option to t 1401suppresses this warning." 1402 :group 'files 1403 :version "21.1" 1404 :type 'boolean) 1405 1406(defcustom large-file-warning-threshold 10000000 1407 "Maximum size of file above which a confirmation is requested. 1408When nil, never request confirmation." 1409 :group 'files 1410 :group 'find-file 1411 :version "22.1" 1412 :type '(choice integer (const :tag "Never request confirmation" nil))) 1413 1414(defun find-file-noselect (filename &optional nowarn rawfile wildcards) 1415 "Read file FILENAME into a buffer and return the buffer. 1416If a buffer exists visiting FILENAME, return that one, but 1417verify that the file has not changed since visited or saved. 1418The buffer is not selected, just returned to the caller. 1419Optional second arg NOWARN non-nil means suppress any warning messages. 1420Optional third arg RAWFILE non-nil means the file is read literally. 1421Optional fourth arg WILDCARDS non-nil means do wildcard processing 1422and visit all the matching files. When wildcards are actually 1423used and expanded, return a list of buffers that are visiting 1424the various files." 1425 (setq filename 1426 (abbreviate-file-name 1427 (expand-file-name filename))) 1428 (if (file-directory-p filename) 1429 (or (and find-file-run-dired 1430 (run-hook-with-args-until-success 1431 'find-directory-functions 1432 (if find-file-visit-truename 1433 (abbreviate-file-name (file-truename filename)) 1434 filename))) 1435 (error "%s is a directory" filename)) 1436 (if (and wildcards 1437 find-file-wildcards 1438 (not (string-match "\\`/:" filename)) 1439 (string-match "[[*?]" filename)) 1440 (let ((files (condition-case nil 1441 (file-expand-wildcards filename t) 1442 (error (list filename)))) 1443 (find-file-wildcards nil)) 1444 (if (null files) 1445 (find-file-noselect filename) 1446 (mapcar #'find-file-noselect files))) 1447 (let* ((buf (get-file-buffer filename)) 1448 (truename (abbreviate-file-name (file-truename filename))) 1449 (attributes (file-attributes truename)) 1450 (number (nthcdr 10 attributes)) 1451 ;; Find any buffer for a file which has same truename. 1452 (other (and (not buf) (find-buffer-visiting filename)))) 1453 ;; Let user know if there is a buffer with the same truename. 1454 (if other 1455 (progn 1456 (or nowarn 1457 find-file-suppress-same-file-warnings 1458 (string-equal filename (buffer-file-name other)) 1459 (message "%s and %s are the same file" 1460 filename (buffer-file-name other))) 1461 ;; Optionally also find that buffer. 1462 (if (or find-file-existing-other-name find-file-visit-truename) 1463 (setq buf other)))) 1464 ;; Check to see if the file looks uncommonly large. 1465 (when (and large-file-warning-threshold (nth 7 attributes) 1466 ;; Don't ask again if we already have the file or 1467 ;; if we're asked to be quiet. 1468 (not (or buf nowarn)) 1469 (> (nth 7 attributes) large-file-warning-threshold) 1470 (not (y-or-n-p 1471 (format "File %s is large (%dMB), really open? " 1472 (file-name-nondirectory filename) 1473 (/ (nth 7 attributes) 1048576))))) 1474 (error "Aborted")) 1475 (if buf 1476 ;; We are using an existing buffer. 1477 (let (nonexistent) 1478 (or nowarn 1479 (verify-visited-file-modtime buf) 1480 (cond ((not (file-exists-p filename)) 1481 (setq nonexistent t) 1482 (message "File %s no longer exists!" filename)) 1483 ;; Certain files should be reverted automatically 1484 ;; if they have changed on disk and not in the buffer. 1485 ((and (not (buffer-modified-p buf)) 1486 (let ((tail revert-without-query) 1487 (found nil)) 1488 (while tail 1489 (if (string-match (car tail) filename) 1490 (setq found t)) 1491 (setq tail (cdr tail))) 1492 found)) 1493 (with-current-buffer buf 1494 (message "Reverting file %s..." filename) 1495 (revert-buffer t t) 1496 (message "Reverting file %s...done" filename))) 1497 ((yes-or-no-p 1498 (if (string= (file-name-nondirectory filename) 1499 (buffer-name buf)) 1500 (format 1501 (if (buffer-modified-p buf) 1502 "File %s changed on disk. Discard your edits? " 1503 "File %s changed on disk. Reread from disk? ") 1504 (file-name-nondirectory filename)) 1505 (format 1506 (if (buffer-modified-p buf) 1507 "File %s changed on disk. Discard your edits in %s? " 1508 "File %s changed on disk. Reread from disk into %s? ") 1509 (file-name-nondirectory filename) 1510 (buffer-name buf)))) 1511 (with-current-buffer buf 1512 (revert-buffer t t))))) 1513 (with-current-buffer buf 1514 1515 ;; Check if a formerly read-only file has become 1516 ;; writable and vice versa, but if the buffer agrees 1517 ;; with the new state of the file, that is ok too. 1518 (let ((read-only (not (file-writable-p buffer-file-name)))) 1519 (unless (or nonexistent 1520 (eq read-only buffer-file-read-only) 1521 (eq read-only buffer-read-only)) 1522 (when (or nowarn 1523 (let ((question 1524 (format "File %s is %s on disk. Change buffer mode? " 1525 buffer-file-name 1526 (if read-only "read-only" "writable")))) 1527 (y-or-n-p question))) 1528 (setq buffer-read-only read-only))) 1529 (setq buffer-file-read-only read-only)) 1530 1531 (when (and (not (eq (not (null rawfile)) 1532 (not (null find-file-literally)))) 1533 (not nonexistent) 1534 ;; It is confusing to ask whether to visit 1535 ;; non-literally if they have the file in 1536 ;; hexl-mode. 1537 (not (eq major-mode 'hexl-mode))) 1538 (if (buffer-modified-p) 1539 (if (y-or-n-p 1540 (format 1541 (if rawfile 1542 "The file %s is already visited normally, 1543and you have edited the buffer. Now you have asked to visit it literally, 1544meaning no coding system handling, format conversion, or local variables. 1545Emacs can only visit a file in one way at a time. 1546 1547Do you want to save the file, and visit it literally instead? " 1548 "The file %s is already visited literally, 1549meaning no coding system handling, format conversion, or local variables. 1550You have edited the buffer. Now you have asked to visit the file normally, 1551but Emacs can only visit a file in one way at a time. 1552 1553Do you want to save the file, and visit it normally instead? ") 1554 (file-name-nondirectory filename))) 1555 (progn 1556 (save-buffer) 1557 (find-file-noselect-1 buf filename nowarn 1558 rawfile truename number)) 1559 (if (y-or-n-p 1560 (format 1561 (if rawfile 1562 "\ 1563Do you want to discard your changes, and visit the file literally now? " 1564 "\ 1565Do you want to discard your changes, and visit the file normally now? "))) 1566 (find-file-noselect-1 buf filename nowarn 1567 rawfile truename number) 1568 (error (if rawfile "File already visited non-literally" 1569 "File already visited literally")))) 1570 (if (y-or-n-p 1571 (format 1572 (if rawfile 1573 "The file %s is already visited normally. 1574You have asked to visit it literally, 1575meaning no coding system decoding, format conversion, or local variables. 1576But Emacs can only visit a file in one way at a time. 1577 1578Do you want to revisit the file literally now? " 1579 "The file %s is already visited literally, 1580meaning no coding system decoding, format conversion, or local variables. 1581You have asked to visit it normally, 1582but Emacs can only visit a file in one way at a time. 1583 1584Do you want to revisit the file normally now? ") 1585 (file-name-nondirectory filename))) 1586 (find-file-noselect-1 buf filename nowarn 1587 rawfile truename number) 1588 (error (if rawfile "File already visited non-literally" 1589 "File already visited literally")))))) 1590 ;; Return the buffer we are using. 1591 buf) 1592 ;; Create a new buffer. 1593 (setq buf (create-file-buffer filename)) 1594 ;; find-file-noselect-1 may use a different buffer. 1595 (find-file-noselect-1 buf filename nowarn 1596 rawfile truename number)))))) 1597 1598(defun find-file-noselect-1 (buf filename nowarn rawfile truename number) 1599 (let (error) 1600 (with-current-buffer buf 1601 (kill-local-variable 'find-file-literally) 1602 ;; Needed in case we are re-visiting the file with a different 1603 ;; text representation. 1604 (kill-local-variable 'buffer-file-coding-system) 1605 (kill-local-variable 'cursor-type) 1606 (let ((inhibit-read-only t)) 1607 (erase-buffer)) 1608 (and (default-value 'enable-multibyte-characters) 1609 (not rawfile) 1610 (set-buffer-multibyte t)) 1611 (if rawfile 1612 (condition-case () 1613 (let ((inhibit-read-only t)) 1614 (insert-file-contents-literally filename t)) 1615 (file-error 1616 (when (and (file-exists-p filename) 1617 (not (file-readable-p filename))) 1618 (kill-buffer buf) 1619 (signal 'file-error (list "File is not readable" 1620 filename))) 1621 ;; Unconditionally set error 1622 (setq error t))) 1623 (condition-case () 1624 (let ((inhibit-read-only t)) 1625 (insert-file-contents filename t)) 1626 (file-error 1627 (when (and (file-exists-p filename) 1628 (not (file-readable-p filename))) 1629 (kill-buffer buf) 1630 (signal 'file-error (list "File is not readable" 1631 filename))) 1632 ;; Run find-file-not-found-functions until one returns non-nil. 1633 (or (run-hook-with-args-until-success 'find-file-not-found-functions) 1634 ;; If they fail too, set error. 1635 (setq error t))))) 1636 ;; Record the file's truename, and maybe use that as visited name. 1637 (if (equal filename buffer-file-name) 1638 (setq buffer-file-truename truename) 1639 (setq buffer-file-truename 1640 (abbreviate-file-name (file-truename buffer-file-name)))) 1641 (setq buffer-file-number number) 1642 ;; On VMS, we may want to remember which directory in a search list 1643 ;; the file was found in. 1644 (and (eq system-type 'vax-vms) 1645 (let (logical) 1646 (if (string-match ":" (file-name-directory filename)) 1647 (setq logical (substring (file-name-directory filename) 1648 0 (match-beginning 0)))) 1649 (not (member logical find-file-not-true-dirname-list))) 1650 (setq buffer-file-name buffer-file-truename)) 1651 (if find-file-visit-truename 1652 (setq buffer-file-name (expand-file-name buffer-file-truename))) 1653 ;; Set buffer's default directory to that of the file. 1654 (setq default-directory (file-name-directory buffer-file-name)) 1655 ;; Turn off backup files for certain file names. Since 1656 ;; this is a permanent local, the major mode won't eliminate it. 1657 (and backup-enable-predicate 1658 (not (funcall backup-enable-predicate buffer-file-name)) 1659 (progn 1660 (make-local-variable 'backup-inhibited) 1661 (setq backup-inhibited t))) 1662 (if rawfile 1663 (progn 1664 (set-buffer-multibyte nil) 1665 (setq buffer-file-coding-system 'no-conversion) 1666 (set-buffer-major-mode buf) 1667 (make-local-variable 'find-file-literally) 1668 (setq find-file-literally t)) 1669 (after-find-file error (not nowarn))) 1670 (current-buffer)))) 1671 1672(defun insert-file-contents-literally (filename &optional visit beg end replace) 1673 "Like `insert-file-contents', but only reads in the file literally. 1674A buffer may be modified in several ways after reading into the buffer, 1675to Emacs features such as format decoding, character code 1676conversion, `find-file-hook', automatic uncompression, etc. 1677 1678This function ensures that none of these modifications will take place." 1679 (let ((format-alist nil) 1680 (after-insert-file-functions nil) 1681 (coding-system-for-read 'no-conversion) 1682 (coding-system-for-write 'no-conversion) 1683 (find-buffer-file-type-function 1684 (if (fboundp 'find-buffer-file-type) 1685 (symbol-function 'find-buffer-file-type) 1686 nil)) 1687 (inhibit-file-name-handlers 1688 (append '(jka-compr-handler image-file-handler) 1689 inhibit-file-name-handlers)) 1690 (inhibit-file-name-operation 'insert-file-contents)) 1691 (unwind-protect 1692 (progn 1693 (fset 'find-buffer-file-type (lambda (filename) t)) 1694 (insert-file-contents filename visit beg end replace)) 1695 (if find-buffer-file-type-function 1696 (fset 'find-buffer-file-type find-buffer-file-type-function) 1697 (fmakunbound 'find-buffer-file-type))))) 1698 1699(defun insert-file-1 (filename insert-func) 1700 (if (file-directory-p filename) 1701 (signal 'file-error (list "Opening input file" "file is a directory" 1702 filename))) 1703 (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename)) 1704 #'buffer-modified-p)) 1705 (tem (funcall insert-func filename))) 1706 (push-mark (+ (point) (car (cdr tem)))) 1707 (when buffer 1708 (message "File %s already visited and modified in buffer %s" 1709 filename (buffer-name buffer))))) 1710 1711(defun insert-file-literally (filename) 1712 "Insert contents of file FILENAME into buffer after point with no conversion. 1713 1714This function is meant for the user to run interactively. 1715Don't call it from programs! Use `insert-file-contents-literally' instead. 1716\(Its calling sequence is different; see its documentation)." 1717 (interactive "*fInsert file literally: ") 1718 (insert-file-1 filename #'insert-file-contents-literally)) 1719 1720(defvar find-file-literally nil 1721 "Non-nil if this buffer was made by `find-file-literally' or equivalent. 1722This is a permanent local.") 1723(put 'find-file-literally 'permanent-local t) 1724 1725(defun find-file-literally (filename) 1726 "Visit file FILENAME with no conversion of any kind. 1727Format conversion and character code conversion are both disabled, 1728and multibyte characters are disabled in the resulting buffer. 1729The major mode used is Fundamental mode regardless of the file name, 1730and local variable specifications in the file are ignored. 1731Automatic uncompression and adding a newline at the end of the 1732file due to `require-final-newline' is also disabled. 1733 1734You cannot absolutely rely on this function to result in 1735visiting the file literally. If Emacs already has a buffer 1736which is visiting the file, you get the existing buffer, 1737regardless of whether it was created literally or not. 1738 1739In a Lisp program, if you want to be sure of accessing a file's 1740contents literally, you should create a temporary buffer and then read 1741the file contents into it using `insert-file-contents-literally'." 1742 (interactive "FFind file literally: ") 1743 (switch-to-buffer (find-file-noselect filename nil t))) 1744 1745(defvar after-find-file-from-revert-buffer nil) 1746 1747(defun after-find-file (&optional error warn noauto 1748 after-find-file-from-revert-buffer 1749 nomodes) 1750 "Called after finding a file and by the default revert function. 1751Sets buffer mode, parses local variables. 1752Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an 1753error in reading the file. WARN non-nil means warn if there 1754exists an auto-save file more recent than the visited file. 1755NOAUTO means don't mess with auto-save mode. 1756Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil 1757 means this call was from `revert-buffer'. 1758Fifth arg NOMODES non-nil means don't alter the file's modes. 1759Finishes by calling the functions in `find-file-hook' 1760unless NOMODES is non-nil." 1761 (setq buffer-read-only (not (file-writable-p buffer-file-name))) 1762 (if noninteractive 1763 nil 1764 (let* (not-serious 1765 (msg 1766 (cond 1767 ((not warn) nil) 1768 ((and error (file-attributes buffer-file-name)) 1769 (setq buffer-read-only t) 1770 "File exists, but cannot be read") 1771 ((not buffer-read-only) 1772 (if (and warn 1773 ;; No need to warn if buffer is auto-saved 1774 ;; under the name of the visited file. 1775 (not (and buffer-file-name 1776 auto-save-visited-file-name)) 1777 (file-newer-than-file-p (or buffer-auto-save-file-name 1778 (make-auto-save-file-name)) 1779 buffer-file-name)) 1780 (format "%s has auto save data; consider M-x recover-this-file" 1781 (file-name-nondirectory buffer-file-name)) 1782 (setq not-serious t) 1783 (if error "(New file)" nil))) 1784 ((not error) 1785 (setq not-serious t) 1786 "Note: file is write protected") 1787 ((file-attributes (directory-file-name default-directory)) 1788 "File not found and directory write-protected") 1789 ((file-exists-p (file-name-directory buffer-file-name)) 1790 (setq buffer-read-only nil)) 1791 (t 1792 (setq buffer-read-only nil) 1793 "Use M-x make-directory RET RET to create the directory and its parents")))) 1794 (when msg 1795 (message "%s" msg) 1796 (or not-serious (sit-for 1 t)))) 1797 (when (and auto-save-default (not noauto)) 1798 (auto-save-mode t))) 1799 ;; Make people do a little extra work (C-x C-q) 1800 ;; before altering a backup file. 1801 (when (backup-file-name-p buffer-file-name) 1802 (setq buffer-read-only t)) 1803 ;; When a file is marked read-only, 1804 ;; make the buffer read-only even if root is looking at it. 1805 (when (and (file-modes (buffer-file-name)) 1806 (zerop (logand (file-modes (buffer-file-name)) #o222))) 1807 (setq buffer-read-only t)) 1808 (unless nomodes 1809 (when (and view-read-only view-mode) 1810 (view-mode-disable)) 1811 (normal-mode t) 1812 ;; If requested, add a newline at the end of the file. 1813 (and (memq require-final-newline '(visit visit-save)) 1814 (> (point-max) (point-min)) 1815 (/= (char-after (1- (point-max))) ?\n) 1816 (not (and (eq selective-display t) 1817 (= (char-after (1- (point-max))) ?\r))) 1818 (save-excursion 1819 (goto-char (point-max)) 1820 (insert "\n"))) 1821 (when (and buffer-read-only 1822 view-read-only 1823 (not (eq (get major-mode 'mode-class) 'special))) 1824 (view-mode-enter)) 1825 (run-hooks 'find-file-hook))) 1826 1827(defmacro report-errors (format &rest body) 1828 "Eval BODY and turn any error into a FORMAT message. 1829FORMAT can have a %s escape which will be replaced with the actual error. 1830If `debug-on-error' is set, errors are not caught, so that you can 1831debug them. 1832Avoid using a large BODY since it is duplicated." 1833 (declare (debug t) (indent 1)) 1834 `(if debug-on-error 1835 (progn . ,body) 1836 (condition-case err 1837 (progn . ,body) 1838 (error (message ,format (prin1-to-string err)))))) 1839 1840(defun normal-mode (&optional find-file) 1841 "Choose the major mode for this buffer automatically. 1842Also sets up any specified local variables of the file. 1843Uses the visited file name, the -*- line, and the local variables spec. 1844 1845This function is called automatically from `find-file'. In that case, 1846we may set up the file-specified mode and local variables, 1847depending on the value of `enable-local-variables'. 1848In addition, if `local-enable-local-variables' is nil, we do 1849not set local variables (though we do notice a mode specified with -*-.) 1850 1851`enable-local-variables' is ignored if you run `normal-mode' interactively, 1852or from Lisp without specifying the optional argument FIND-FILE; 1853in that case, this function acts as if `enable-local-variables' were t." 1854 (interactive) 1855 (funcall (or default-major-mode 'fundamental-mode)) 1856 (let ((enable-local-variables (or (not find-file) enable-local-variables))) 1857 (report-errors "File mode specification error: %s" 1858 (set-auto-mode)) 1859 (report-errors "File local-variables error: %s" 1860 (hack-local-variables))) 1861 ;; Turn font lock off and on, to make sure it takes account of 1862 ;; whatever file local variables are relevant to it. 1863 (when (and font-lock-mode 1864 ;; Font-lock-mode (now in font-core.el) can be ON when 1865 ;; font-lock.el still hasn't been loaded. 1866 (boundp 'font-lock-keywords) 1867 (eq (car font-lock-keywords) t)) 1868 (setq font-lock-keywords (cadr font-lock-keywords)) 1869 (font-lock-mode 1)) 1870 1871 (if (fboundp 'ucs-set-table-for-input) ; don't lose when building 1872 (ucs-set-table-for-input))) 1873 1874(defcustom auto-mode-case-fold nil 1875 "Non-nil means to try second pass through `auto-mode-alist'. 1876This means that if the first case-sensitive search through the alist fails 1877to find a matching major mode, a second case-insensitive search is made. 1878On systems with case-insensitive file names, this variable is ignored, 1879since only a single case-insensitive search through the alist is made." 1880 :group 'files 1881 :version "22.1" 1882 :type 'boolean) 1883 1884(defvar auto-mode-alist 1885 ;; Note: The entries for the modes defined in cc-mode.el (c-mode, 1886 ;; c++-mode, java-mode and more) are added through autoload 1887 ;; directives in that file. That way is discouraged since it 1888 ;; spreads out the definition of the initial value. 1889 (mapc 1890 (lambda (elt) 1891 (cons (purecopy (car elt)) (cdr elt))) 1892 `(;; do this first, so that .html.pl is Polish html, not Perl 1893 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) 1894 ("\\.te?xt\\'" . text-mode) 1895 ("\\.[tT]e[xX]\\'" . tex-mode) 1896 ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. 1897 ("\\.ltx\\'" . latex-mode) 1898 ("\\.dtx\\'" . doctex-mode) 1899 ("\\.el\\'" . emacs-lisp-mode) 1900 ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) 1901 ("\\.l\\'" . lisp-mode) 1902 ("\\.li?sp\\'" . lisp-mode) 1903 ("\\.[fF]\\'" . fortran-mode) 1904 ("\\.for\\'" . fortran-mode) 1905 ("\\.p\\'" . pascal-mode) 1906 ("\\.pas\\'" . pascal-mode) 1907 ("\\.ad[abs]\\'" . ada-mode) 1908 ("\\.ad[bs].dg\\'" . ada-mode) 1909 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) 1910 ("Imakefile\\'" . makefile-imake-mode) 1911 ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk 1912 ("\\.makepp\\'" . makefile-makepp-mode) 1913 ,@(if (memq system-type '(berkeley-unix next-mach darwin)) 1914 '(("\\.mk\\'" . makefile-bsdmake-mode) 1915 ("GNUmakefile\\'" . makefile-gmake-mode) 1916 ("[Mm]akefile\\'" . makefile-bsdmake-mode)) 1917 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage 1918 ("[Mm]akefile\\'" . makefile-gmake-mode))) 1919 ("\\.am\\'" . makefile-automake-mode) 1920 ;; Less common extensions come here 1921 ;; so more common ones above are found faster. 1922 ("\\.texinfo\\'" . texinfo-mode) 1923 ("\\.te?xi\\'" . texinfo-mode) 1924 ("\\.[sS]\\'" . asm-mode) 1925 ("\\.asm\\'" . asm-mode) 1926 ("[cC]hange\\.?[lL]og?\\'" . change-log-mode) 1927 ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) 1928 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) 1929 ("\\.scm\\.[0-9]*\\'" . scheme-mode) 1930 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) 1931 ("\\.bash\\'" . sh-mode) 1932 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) 1933 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) 1934 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) 1935 ("\\.m?spec\\'" . sh-mode) 1936 ("\\.m[mes]\\'" . nroff-mode) 1937 ("\\.man\\'" . nroff-mode) 1938 ("\\.sty\\'" . latex-mode) 1939 ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option 1940 ("\\.bbl\\'" . latex-mode) 1941 ("\\.bib\\'" . bibtex-mode) 1942 ("\\.sql\\'" . sql-mode) 1943 ("\\.m[4c]\\'" . m4-mode) 1944 ("\\.mf\\'" . metafont-mode) 1945 ("\\.mp\\'" . metapost-mode) 1946 ("\\.vhdl?\\'" . vhdl-mode) 1947 ("\\.article\\'" . text-mode) 1948 ("\\.letter\\'" . text-mode) 1949 ("\\.i?tcl\\'" . tcl-mode) 1950 ("\\.exp\\'" . tcl-mode) 1951 ("\\.itk\\'" . tcl-mode) 1952 ("\\.icn\\'" . icon-mode) 1953 ("\\.sim\\'" . simula-mode) 1954 ("\\.mss\\'" . scribe-mode) 1955 ("\\.f9[05]\\'" . f90-mode) 1956 ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode 1957 ("\\.pro\\'" . idlwave-mode) 1958 ("\\.prolog\\'" . prolog-mode) 1959 ("\\.tar\\'" . tar-mode) 1960 ;; The list of archive file extensions should be in sync with 1961 ;; `auto-coding-alist' with `no-conversion' coding system. 1962 ("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode) 1963 ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode) 1964 ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org 1965 ;; Mailer puts message to be edited in 1966 ;; /tmp/Re.... or Message 1967 ("\\`/tmp/Re" . text-mode) 1968 ("/Message[0-9]*\\'" . text-mode) 1969 ("\\.zone\\'" . zone-mode) 1970 ;; some news reader is reported to use this 1971 ("\\`/tmp/fol/" . text-mode) 1972 ("\\.oak\\'" . scheme-mode) 1973 ("\\.sgml?\\'" . sgml-mode) 1974 ("\\.x[ms]l\\'" . xml-mode) 1975 ("\\.dtd\\'" . sgml-mode) 1976 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) 1977 ("\\.js\\'" . java-mode) ; javascript-mode would be better 1978 ("\\.x[bp]m\\'" . c-mode) 1979 ;; .emacs or .gnus or .viper following a directory delimiter in 1980 ;; Unix, MSDOG or VMS syntax. 1981 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) 1982 ("\\`\\..*emacs\\'" . emacs-lisp-mode) 1983 ;; _emacs following a directory delimiter 1984 ;; in MsDos syntax 1985 ("[:/]_emacs\\'" . emacs-lisp-mode) 1986 ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) 1987 ("\\.ml\\'" . lisp-mode) 1988 ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) 1989 ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode) 1990 ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) 1991 ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG 1992 ("\\.[eE]?[pP][sS]\\'" . ps-mode) 1993 ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) 1994 ("BROWSE\\'" . ebrowse-tree-mode) 1995 ("\\.ebrowse\\'" . ebrowse-tree-mode) 1996 ("#\\*mail\\*" . mail-mode) 1997 ("\\.g\\'" . antlr-mode) 1998 ("\\.ses\\'" . ses-mode) 1999 ("\\.\\(soa\\|zone\\)\\'" . dns-mode) 2000 ("\\.docbook\\'" . sgml-mode) 2001 ("\\.com\\'" . dcl-mode) 2002 ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) 2003 ;; Windows candidates may be opened case sensitively on Unix 2004 ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) 2005 ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode) 2006 ("\\.ppd\\'" . conf-ppd-mode) 2007 ("java.+\\.conf\\'" . conf-javaprop-mode) 2008 ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) 2009 ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config 2010 ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode) 2011 ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) 2012 ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) 2013 ;; either user's dot-files or under /etc or some such 2014 ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode) 2015 ;; alas not all ~/.*rc files are like this 2016 ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) 2017 ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) 2018 ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) 2019 ("/X11.+app-defaults/" . conf-xdefaults-mode) 2020 ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) 2021 ;; this contains everything twice, with space and with colon :-( 2022 ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) 2023 ;; Get rid of any trailing .n.m and try again. 2024 ;; This is for files saved by cvs-merge that look like .#<file>.<rev> 2025 ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~. 2026 ;; Using mode nil rather than `ignore' would let the search continue 2027 ;; through this list (with the shortened name) rather than start over. 2028 ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t) 2029 ;; The following should come after the ChangeLog pattern 2030 ;; for the sake of ChangeLog.1, etc. 2031 ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too. 2032 ("\\.[1-9]\\'" . nroff-mode) 2033 ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t))) 2034 "Alist of filename patterns vs corresponding major mode functions. 2035Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). 2036\(NON-NIL stands for anything that is not nil; the value does not matter.) 2037Visiting a file whose name matches REGEXP specifies FUNCTION as the 2038mode function to use. FUNCTION will be called, unless it is nil. 2039 2040If the element has the form (REGEXP FUNCTION NON-NIL), then after 2041calling FUNCTION (if it's not nil), we delete the suffix that matched 2042REGEXP and search the list again for another match. 2043 2044If the file name matches `inhibit-first-line-modes-regexps', 2045then `auto-mode-alist' is not processed. 2046 2047The extensions whose FUNCTION is `archive-mode' should also 2048appear in `auto-coding-alist' with `no-conversion' coding system. 2049 2050See also `interpreter-mode-alist', which detects executable script modes 2051based on the interpreters they specify to run, 2052and `magic-mode-alist', which determines modes based on file contents.") 2053 2054(defvar interpreter-mode-alist 2055 ;; Note: The entries for the modes defined in cc-mode.el (awk-mode 2056 ;; and pike-mode) are added through autoload directives in that 2057 ;; file. That way is discouraged since it spreads out the 2058 ;; definition of the initial value. 2059 (mapc 2060 (lambda (l) 2061 (cons (purecopy (car l)) (cdr l))) 2062 '(("perl" . perl-mode) 2063 ("perl5" . perl-mode) 2064 ("miniperl" . perl-mode) 2065 ("wish" . tcl-mode) 2066 ("wishx" . tcl-mode) 2067 ("tcl" . tcl-mode) 2068 ("tclsh" . tcl-mode) 2069 ("scm" . scheme-mode) 2070 ("ash" . sh-mode) 2071 ("bash" . sh-mode) 2072 ("bash2" . sh-mode) 2073 ("csh" . sh-mode) 2074 ("dtksh" . sh-mode) 2075 ("es" . sh-mode) 2076 ("itcsh" . sh-mode) 2077 ("jsh" . sh-mode) 2078 ("ksh" . sh-mode) 2079 ("oash" . sh-mode) 2080 ("pdksh" . sh-mode) 2081 ("rc" . sh-mode) 2082 ("rpm" . sh-mode) 2083 ("sh" . sh-mode) 2084 ("sh5" . sh-mode) 2085 ("tcsh" . sh-mode) 2086 ("wksh" . sh-mode) 2087 ("wsh" . sh-mode) 2088 ("zsh" . sh-mode) 2089 ("tail" . text-mode) 2090 ("more" . text-mode) 2091 ("less" . text-mode) 2092 ("pg" . text-mode) 2093 ("make" . makefile-gmake-mode) ; Debian uses this 2094 ("guile" . scheme-mode) 2095 ("clisp" . lisp-mode))) 2096 "Alist mapping interpreter names to major modes. 2097This is used for files whose first lines match `auto-mode-interpreter-regexp'. 2098Each element looks like (INTERPRETER . MODE). 2099If INTERPRETER matches the name of the interpreter specified in the first line 2100of a script, mode MODE is enabled. 2101 2102See also `auto-mode-alist'.") 2103 2104(defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'") 2105 "List of regexps; if one matches a file name, don't look for `-*-'.") 2106 2107(defvar inhibit-first-line-modes-suffixes nil 2108 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. 2109When checking `inhibit-first-line-modes-regexps', we first discard 2110from the end of the file name anything that matches one of these regexps.") 2111 2112(defvar auto-mode-interpreter-regexp 2113 "#![ \t]?\\([^ \t\n]*\ 2114/bin/env[ \t]\\)?\\([^ \t\n]+\\)" 2115 "Regexp matching interpreters, for file mode determination. 2116This regular expression is matched against the first line of a file 2117to determine the file's mode in `set-auto-mode'. If it matches, the file 2118is assumed to be interpreted by the interpreter matched by the second group 2119of the regular expression. The mode is then determined as the mode 2120associated with that interpreter in `interpreter-mode-alist'.") 2121 2122(defvar magic-mode-alist 2123 `((image-type-auto-detected-p . image-mode)) 2124 "Alist of buffer beginnings vs. corresponding major mode functions. 2125Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION). 2126After visiting a file, if REGEXP matches the text at the beginning of the 2127buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will 2128call FUNCTION rather than allowing `auto-mode-alist' to decide the buffer's 2129major mode. 2130 2131If FUNCTION is nil, then it is not called. (That is a way of saying 2132\"allow `auto-mode-alist' to decide for these files.\")") 2133(put 'magic-mode-alist 'risky-local-variable t) 2134 2135(defvar magic-fallback-mode-alist 2136 `(;; The < comes before the groups (but the first) to reduce backtracking. 2137 ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff. 2138 ;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely. 2139 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") 2140 (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) 2141 (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" 2142 comment-re "*" 2143 "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?" 2144 "[Hh][Tt][Mm][Ll]")) 2145 . html-mode) 2146 ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . html-mode) 2147 ;; These two must come after html, because they are more general: 2148 ("<\\?xml " . xml-mode) 2149 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") 2150 (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) 2151 (concat "[ \t\r\n]*<" comment-re "*!DOCTYPE ")) 2152 . sgml-mode) 2153 ("%!PS" . ps-mode) 2154 ("# xmcd " . conf-unix-mode)) 2155 "Like `magic-mode-alist' but has lower priority than `auto-mode-alist'. 2156Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION). 2157After visiting a file, if REGEXP matches the text at the beginning of the 2158buffer, or calling MATCH-FUNCTION returns non-nil, `normal-mode' will 2159call FUNCTION, provided that `magic-mode-alist' and `auto-mode-alist' 2160have not specified a mode for this file. 2161 2162If FUNCTION is nil, then it is not called.") 2163(put 'magic-fallback-mode-alist 'risky-local-variable t) 2164 2165(defvar magic-mode-regexp-match-limit 4000 2166 "Upper limit on `magic-mode-alist' regexp matches. 2167Also applies to `magic-fallback-mode-alist'.") 2168 2169(defun set-auto-mode (&optional keep-mode-if-same) 2170 "Select major mode appropriate for current buffer. 2171 2172To find the right major mode, this function checks for a -*- mode tag, 2173checks if it uses an interpreter listed in `interpreter-mode-alist', 2174matches the buffer beginning against `magic-mode-alist', 2175compares the filename against the entries in `auto-mode-alist', 2176then matches the buffer beginning against `magic-fallback-mode-alist'. 2177 2178It does not check for the `mode:' local variable in the 2179Local Variables section of the file; for that, use `hack-local-variables'. 2180 2181If `enable-local-variables' is nil, this function does not check for a 2182-*- mode tag. 2183 2184If the optional argument KEEP-MODE-IF-SAME is non-nil, then we 2185set the major mode only if that would change it. In other words 2186we don't actually set it to the same mode the buffer already has." 2187 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- 2188 (let (end done mode modes) 2189 ;; Find a -*- mode tag 2190 (save-excursion 2191 (goto-char (point-min)) 2192 (skip-chars-forward " \t\n") 2193 (and enable-local-variables 2194 (setq end (set-auto-mode-1)) 2195 (if (save-excursion (search-forward ":" end t)) 2196 ;; Find all specifications for the `mode:' variable 2197 ;; and execute them left to right. 2198 (while (let ((case-fold-search t)) 2199 (or (and (looking-at "mode:") 2200 (goto-char (match-end 0))) 2201 (re-search-forward "[ \t;]mode:" end t))) 2202 (skip-chars-forward " \t") 2203 (let ((beg (point))) 2204 (if (search-forward ";" end t) 2205 (forward-char -1) 2206 (goto-char end)) 2207 (skip-chars-backward " \t") 2208 (push (intern (concat (downcase (buffer-substring beg (point))) "-mode")) 2209 modes))) 2210 ;; Simple -*-MODE-*- case. 2211 (push (intern (concat (downcase (buffer-substring (point) end)) 2212 "-mode")) 2213 modes)))) 2214 ;; If we found modes to use, invoke them now, outside the save-excursion. 2215 (if modes 2216 (catch 'nop 2217 (dolist (mode (nreverse modes)) 2218 (if (not (functionp mode)) 2219 (message "Ignoring unknown mode `%s'" mode) 2220 (setq done t) 2221 (or (set-auto-mode-0 mode keep-mode-if-same) 2222 ;; continuing would call minor modes again, toggling them off 2223 (throw 'nop nil)))))) 2224 ;; If we didn't, look for an interpreter specified in the first line. 2225 ;; As a special case, allow for things like "#!/bin/env perl", which 2226 ;; finds the interpreter anywhere in $PATH. 2227 (unless done 2228 (setq mode (save-excursion 2229 (goto-char (point-min)) 2230 (if (looking-at auto-mode-interpreter-regexp) 2231 (match-string 2) 2232 "")) 2233 ;; Map interpreter name to a mode, signalling we're done at the 2234 ;; same time. 2235 done (assoc (file-name-nondirectory mode) 2236 interpreter-mode-alist)) 2237 ;; If we found an interpreter mode to use, invoke it now. 2238 (if done 2239 (set-auto-mode-0 (cdr done) keep-mode-if-same))) 2240 ;; Next try matching the buffer beginning against magic-mode-alist. 2241 (unless done 2242 (if (setq done (save-excursion 2243 (goto-char (point-min)) 2244 (save-restriction 2245 (narrow-to-region (point-min) 2246 (min (point-max) 2247 (+ (point-min) magic-mode-regexp-match-limit))) 2248 (assoc-default nil magic-mode-alist 2249 (lambda (re dummy) 2250 (if (functionp re) 2251 (funcall re) 2252 (looking-at re))))))) 2253 (set-auto-mode-0 done keep-mode-if-same))) 2254 ;; Next compare the filename against the entries in auto-mode-alist. 2255 (unless done 2256 (if buffer-file-name 2257 (let ((name buffer-file-name)) 2258 ;; Remove backup-suffixes from file name. 2259 (setq name (file-name-sans-versions name)) 2260 (while name 2261 ;; Find first matching alist entry. 2262 (setq mode 2263 (if (memq system-type '(vax-vms windows-nt cygwin)) 2264 ;; System is case-insensitive. 2265 (let ((case-fold-search t)) 2266 (assoc-default name auto-mode-alist 2267 'string-match)) 2268 ;; System is case-sensitive. 2269 (or 2270 ;; First match case-sensitively. 2271 (let ((case-fold-search nil)) 2272 (assoc-default name auto-mode-alist 2273 'string-match)) 2274 ;; Fallback to case-insensitive match. 2275 (and auto-mode-case-fold 2276 (let ((case-fold-search t)) 2277 (assoc-default name auto-mode-alist 2278 'string-match)))))) 2279 (if (and mode 2280 (consp mode) 2281 (cadr mode)) 2282 (setq mode (car mode) 2283 name (substring name 0 (match-beginning 0))) 2284 (setq name)) 2285 (when mode 2286 (set-auto-mode-0 mode keep-mode-if-same) 2287 (setq done t)))))) 2288 ;; Next try matching the buffer beginning against magic-fallback-mode-alist. 2289 (unless done 2290 (if (setq done (save-excursion 2291 (goto-char (point-min)) 2292 (save-restriction 2293 (narrow-to-region (point-min) 2294 (min (point-max) 2295 (+ (point-min) magic-mode-regexp-match-limit))) 2296 (assoc-default nil magic-fallback-mode-alist 2297 (lambda (re dummy) 2298 (if (functionp re) 2299 (funcall re) 2300 (looking-at re))))))) 2301 (set-auto-mode-0 done keep-mode-if-same))))) 2302 2303;; When `keep-mode-if-same' is set, we are working on behalf of 2304;; set-visited-file-name. In that case, if the major mode specified is the 2305;; same one we already have, don't actually reset it. We don't want to lose 2306;; minor modes such as Font Lock. 2307(defun set-auto-mode-0 (mode &optional keep-mode-if-same) 2308 "Apply MODE and return it. 2309If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of 2310any aliases and compared to current major mode. If they are the 2311same, do nothing and return nil." 2312 (unless (and keep-mode-if-same 2313 (eq (indirect-function mode) 2314 (indirect-function major-mode))) 2315 (when mode 2316 (funcall mode) 2317 mode))) 2318 2319(defun set-auto-mode-1 () 2320 "Find the -*- spec in the buffer. 2321Call with point at the place to start searching from. 2322If one is found, set point to the beginning 2323and return the position of the end. 2324Otherwise, return nil; point may be changed." 2325 (let (beg end) 2326 (and 2327 ;; Don't look for -*- if this file name matches any 2328 ;; of the regexps in inhibit-first-line-modes-regexps. 2329 (let ((temp inhibit-first-line-modes-regexps) 2330 (name (if buffer-file-name 2331 (file-name-sans-versions buffer-file-name) 2332 (buffer-name)))) 2333 (while (let ((sufs inhibit-first-line-modes-suffixes)) 2334 (while (and sufs (not (string-match (car sufs) name))) 2335 (setq sufs (cdr sufs))) 2336 sufs) 2337 (setq name (substring name 0 (match-beginning 0)))) 2338 (while (and temp 2339 (not (string-match (car temp) name))) 2340 (setq temp (cdr temp))) 2341 (not temp)) 2342 2343 (search-forward "-*-" (line-end-position 2344 ;; If the file begins with "#!" 2345 ;; (exec interpreter magic), look 2346 ;; for mode frobs in the first two 2347 ;; lines. You cannot necessarily 2348 ;; put them in the first line of 2349 ;; such a file without screwing up 2350 ;; the interpreter invocation. 2351 (and (looking-at "^#!") 2)) t) 2352 (progn 2353 (skip-chars-forward " \t") 2354 (setq beg (point)) 2355 (search-forward "-*-" (line-end-position) t)) 2356 (progn 2357 (forward-char -3) 2358 (skip-chars-backward " \t") 2359 (setq end (point)) 2360 (goto-char beg) 2361 end)))) 2362 2363;;; Handling file local variables 2364 2365(defvar ignored-local-variables 2366 '(ignored-local-variables safe-local-variable-values) 2367 "Variables to be ignored in a file's local variable spec.") 2368 2369(defvar hack-local-variables-hook nil 2370 "Normal hook run after processing a file's local variables specs. 2371Major modes can use this to examine user-specified local variables 2372in order to initialize other data structure based on them.") 2373 2374(defcustom safe-local-variable-values nil 2375 "List variable-value pairs that are considered safe. 2376Each element is a cons cell (VAR . VAL), where VAR is a variable 2377symbol and VAL is a value that is considered safe." 2378 :group 'find-file 2379 :type 'alist) 2380 2381(defcustom safe-local-eval-forms nil 2382 "Expressions that are considered safe in an `eval:' local variable. 2383Add expressions to this list if you want Emacs to evaluate them, when 2384they appear in an `eval' local variable specification, without first 2385asking you for confirmation." 2386 :group 'find-file 2387 :version "22.1" 2388 :type '(repeat sexp)) 2389 2390;; Risky local variables: 2391(mapc (lambda (var) (put var 'risky-local-variable t)) 2392 '(after-load-alist 2393 auto-mode-alist 2394 buffer-auto-save-file-name 2395 buffer-file-name 2396 buffer-file-truename 2397 buffer-undo-list 2398 dabbrev-case-fold-search 2399 dabbrev-case-replace 2400 debugger 2401 default-text-properties 2402 display-time-string 2403 enable-local-eval 2404 enable-local-variables 2405 eval 2406 exec-directory 2407 exec-path 2408 file-name-handler-alist 2409 font-lock-defaults 2410 format-alist 2411 frame-title-format 2412 global-mode-string 2413 header-line-format 2414 icon-title-format 2415 ignored-local-variables 2416 imenu--index-alist 2417 imenu-generic-expression 2418 inhibit-quit 2419 input-method-alist 2420 load-path 2421 max-lisp-eval-depth 2422 max-specpdl-size 2423 minor-mode-alist 2424 minor-mode-map-alist 2425 minor-mode-overriding-map-alist 2426 mode-line-buffer-identification 2427 mode-line-format 2428 mode-line-modes 2429 mode-line-modified 2430 mode-line-mule-info 2431 mode-line-position 2432 mode-line-process 2433 mode-name 2434 outline-level 2435 overriding-local-map 2436 overriding-terminal-local-map 2437 parse-time-rules 2438 process-environment 2439 rmail-output-file-alist 2440 safe-local-variable-values 2441 safe-local-eval-forms 2442 save-some-buffers-action-alist 2443 special-display-buffer-names 2444 standard-input 2445 standard-output 2446 unread-command-events 2447 vc-mode)) 2448 2449;; Safe local variables: 2450;; 2451;; For variables defined by major modes, the safety declarations can go into 2452;; the major mode's file, since that will be loaded before file variables are 2453;; processed. 2454;; 2455;; For variables defined by minor modes, put the safety declarations in the 2456;; file defining the minor mode after the defcustom/defvar using an autoload 2457;; cookie, e.g.: 2458;; 2459;; ;;;###autoload(put 'variable 'safe-local-variable 'stringp) 2460;; 2461;; Otherwise, when Emacs visits a file specifying that local variable, the 2462;; minor mode file may not be loaded yet. 2463;; 2464;; For variables defined in the C source code the declaration should go here: 2465 2466(mapc (lambda (pair) 2467 (put (car pair) 'safe-local-variable (cdr pair))) 2468 '((buffer-read-only . booleanp) ;; C source code 2469 (default-directory . stringp) ;; C source code 2470 (fill-column . integerp) ;; C source code 2471 (indent-tabs-mode . booleanp) ;; C source code 2472 (left-margin . integerp) ;; C source code 2473 (no-update-autoloads . booleanp) 2474 (tab-width . integerp) ;; C source code 2475 (truncate-lines . booleanp))) ;; C source code 2476 2477(put 'c-set-style 'safe-local-eval-function t) 2478 2479(defun hack-local-variables-confirm (vars unsafe-vars risky-vars) 2480 (if noninteractive 2481 nil 2482 (let ((name (if buffer-file-name 2483 (file-name-nondirectory buffer-file-name) 2484 (concat "buffer " (buffer-name)))) 2485 (offer-save (and (eq enable-local-variables t) unsafe-vars)) 2486 prompt char) 2487 (save-window-excursion 2488 (let ((buf (get-buffer-create "*Local Variables*"))) 2489 (pop-to-buffer buf) 2490 (set (make-local-variable 'cursor-type) nil) 2491 (erase-buffer) 2492 (if unsafe-vars 2493 (insert "The local variables list in " name 2494 "\ncontains values that may not be safe (*)" 2495 (if risky-vars 2496 ", and variables that are risky (**)." 2497 ".")) 2498 (if risky-vars 2499 (insert "The local variables list in " name 2500 "\ncontains variables that are risky (**).") 2501 (insert "A local variables list is specified in " name "."))) 2502 (insert "\n\nDo you want to apply it? You can type 2503y -- to apply the local variables list. 2504n -- to ignore the local variables list.") 2505 (if offer-save 2506 (insert " 2507! -- to apply the local variables list, and permanently mark these 2508 values (*) as safe (in the future, they will be set automatically.)\n\n") 2509 (insert "\n\n")) 2510 (dolist (elt vars) 2511 (cond ((member elt unsafe-vars) 2512 (insert " * ")) 2513 ((member elt risky-vars) 2514 (insert " ** ")) 2515 (t 2516 (insert " "))) 2517 (princ (car elt) buf) 2518 (insert " : ") 2519 ;; Make strings with embedded whitespace easier to read. 2520 (let ((print-escape-newlines t)) 2521 (prin1 (cdr elt) buf)) 2522 (insert "\n")) 2523 (setq prompt 2524 (format "Please type %s%s: " 2525 (if offer-save "y, n, or !" "y or n") 2526 (if (< (line-number-at-pos) (window-body-height)) 2527 "" 2528 ", or C-v to scroll"))) 2529 (goto-char (point-min)) 2530 (let ((cursor-in-echo-area t) 2531 (executing-kbd-macro executing-kbd-macro) 2532 (exit-chars 2533 (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g))) 2534 done) 2535 (while (not done) 2536 (message prompt) 2537 (setq char (read-event)) 2538 (if (numberp char) 2539 (cond ((eq char ?\C-v) 2540 (condition-case nil 2541 (scroll-up) 2542 (error (goto-char (point-min))))) 2543 ;; read-event returns -1 if we are in a kbd 2544 ;; macro and there are no more events in the 2545 ;; macro. In that case, attempt to get an 2546 ;; event interactively. 2547 ((and executing-kbd-macro (= char -1)) 2548 (setq executing-kbd-macro nil)) 2549 (t (setq done (memq (downcase char) exit-chars))))))) 2550 (setq char (downcase char)) 2551 (when (and offer-save (= char ?!) unsafe-vars) 2552 (dolist (elt unsafe-vars) 2553 (add-to-list 'safe-local-variable-values elt)) 2554 ;; When this is called from desktop-restore-file-buffer, 2555 ;; coding-system-for-read may be non-nil. Reset it before 2556 ;; writing to .emacs. 2557 (if (or custom-file user-init-file) 2558 (let ((coding-system-for-read nil)) 2559 (customize-save-variable 2560 'safe-local-variable-values 2561 safe-local-variable-values)))) 2562 (kill-buffer buf) 2563 (or (= char ?!) 2564 (= char ?\s) 2565 (= char ?y))))))) 2566 2567(defun hack-local-variables-prop-line (&optional mode-only) 2568 "Return local variables specified in the -*- line. 2569Ignore any specification for `mode:' and `coding:'; 2570`set-auto-mode' should already have handled `mode:', 2571`set-auto-coding' should already have handled `coding:'. 2572 2573If MODE-ONLY is non-nil, all we do is check whether the major 2574mode is specified, returning t if it is specified. Otherwise, 2575return an alist of elements (VAR . VAL), where VAR is a variable 2576and VAL is the specified value." 2577 (save-excursion 2578 (goto-char (point-min)) 2579 (let ((end (set-auto-mode-1)) 2580 result mode-specified) 2581 ;; Parse the -*- line into the RESULT alist. 2582 ;; Also set MODE-SPECIFIED if we see a spec or `mode'. 2583 (cond ((not end) 2584 nil) 2585 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") 2586 ;; Simple form: "-*- MODENAME -*-". Already handled. 2587 (setq mode-specified t) 2588 nil) 2589 (t 2590 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' 2591 ;; (last ";" is optional). 2592 (while (< (point) end) 2593 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") 2594 (error "Malformed -*- line")) 2595 (goto-char (match-end 0)) 2596 ;; There used to be a downcase here, 2597 ;; but the manual didn't say so, 2598 ;; and people want to set var names that aren't all lc. 2599 (let ((key (intern (match-string 1))) 2600 (val (save-restriction 2601 (narrow-to-region (point) end) 2602 (read (current-buffer))))) 2603 ;; It is traditional to ignore 2604 ;; case when checking for `mode' in set-auto-mode, 2605 ;; so we must do that here as well. 2606 ;; That is inconsistent, but we're stuck with it. 2607 ;; The same can be said for `coding' in set-auto-coding. 2608 (or (and (equal (downcase (symbol-name key)) "mode") 2609 (setq mode-specified t)) 2610 (equal (downcase (symbol-name key)) "coding") 2611 (condition-case nil 2612 (push (cons (if (eq key 'eval) 2613 'eval 2614 (indirect-variable key)) 2615 val) result) 2616 (error nil))) 2617 (skip-chars-forward " \t;"))))) 2618 2619 (if mode-only 2620 mode-specified 2621 result)))) 2622 2623(defun hack-local-variables (&optional mode-only) 2624 "Parse and put into effect this buffer's local variables spec. 2625If MODE-ONLY is non-nil, all we do is check whether the major mode 2626is specified, returning t if it is specified." 2627 (let ((enable-local-variables 2628 (and local-enable-local-variables enable-local-variables)) 2629 result) 2630 (when (or mode-only enable-local-variables) 2631 (setq result (hack-local-variables-prop-line mode-only)) 2632 ;; Look for "Local variables:" line in last page. 2633 (save-excursion 2634 (goto-char (point-max)) 2635 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 2636 'move) 2637 (when (let ((case-fold-search t)) 2638 (search-forward "Local Variables:" nil t)) 2639 (skip-chars-forward " \t") 2640 ;; suffix is what comes after "local variables:" in its line. 2641 ;; prefix is what comes before "local variables:" in its line. 2642 (let ((suffix 2643 (concat 2644 (regexp-quote (buffer-substring (point) 2645 (line-end-position))) 2646 "$")) 2647 (prefix 2648 (concat "^" (regexp-quote 2649 (buffer-substring (line-beginning-position) 2650 (match-beginning 0))))) 2651 beg) 2652 2653 (forward-line 1) 2654 (let ((startpos (point)) 2655 endpos 2656 (thisbuf (current-buffer))) 2657 (save-excursion 2658 (unless (let ((case-fold-search t)) 2659 (re-search-forward 2660 (concat prefix "[ \t]*End:[ \t]*" suffix) 2661 nil t)) 2662 (error "Local variables list is not properly terminated")) 2663 (beginning-of-line) 2664 (setq endpos (point))) 2665 2666 (with-temp-buffer 2667 (insert-buffer-substring thisbuf startpos endpos) 2668 (goto-char (point-min)) 2669 (subst-char-in-region (point) (point-max) ?\^m ?\n) 2670 (while (not (eobp)) 2671 ;; Discard the prefix. 2672 (if (looking-at prefix) 2673 (delete-region (point) (match-end 0)) 2674 (error "Local variables entry is missing the prefix")) 2675 (end-of-line) 2676 ;; Discard the suffix. 2677 (if (looking-back suffix) 2678 (delete-region (match-beginning 0) (point)) 2679 (error "Local variables entry is missing the suffix")) 2680 (forward-line 1)) 2681 (goto-char (point-min)) 2682 2683 (while (not (eobp)) 2684 ;; Find the variable name; strip whitespace. 2685 (skip-chars-forward " \t") 2686 (setq beg (point)) 2687 (skip-chars-forward "^:\n") 2688 (if (eolp) (error "Missing colon in local variables entry")) 2689 (skip-chars-backward " \t") 2690 (let* ((str (buffer-substring beg (point))) 2691 (var (read str)) 2692 val) 2693 ;; Read the variable value. 2694 (skip-chars-forward "^:") 2695 (forward-char 1) 2696 (setq val (read (current-buffer))) 2697 (if mode-only 2698 (if (eq var 'mode) 2699 (setq result t)) 2700 (unless (eq var 'coding) 2701 (condition-case nil 2702 (push (cons (if (eq var 'eval) 2703 'eval 2704 (indirect-variable var)) 2705 val) result) 2706 (error nil))))) 2707 (forward-line 1))))))) 2708 2709 ;; We've read all the local variables. Now, return whether the 2710 ;; mode is specified (if MODE-ONLY is non-nil), or set the 2711 ;; variables (if MODE-ONLY is nil.) 2712 (if mode-only 2713 result 2714 (dolist (ignored ignored-local-variables) 2715 (setq result (assq-delete-all ignored result))) 2716 (if (null enable-local-eval) 2717 (setq result (assq-delete-all 'eval result))) 2718 (when result 2719 (setq result (nreverse result)) 2720 ;; Find those variables that we may want to save to 2721 ;; `safe-local-variable-values'. 2722 (let (risky-vars unsafe-vars) 2723 (dolist (elt result) 2724 (let ((var (car elt)) 2725 (val (cdr elt))) 2726 (or (eq var 'mode) 2727 (and (eq var 'eval) 2728 (or (eq enable-local-eval t) 2729 (hack-one-local-variable-eval-safep 2730 (eval (quote val))))) 2731 (safe-local-variable-p var val) 2732 (and (risky-local-variable-p var val) 2733 (push elt risky-vars)) 2734 (push elt unsafe-vars)))) 2735 (if (eq enable-local-variables :safe) 2736 ;; If caller wants only the safe variables, 2737 ;; install only them. 2738 (dolist (elt result) 2739 (unless (or (member elt unsafe-vars) 2740 (member elt risky-vars)) 2741 (hack-one-local-variable (car elt) (cdr elt)))) 2742 ;; Query, except in the case where all are known safe 2743 ;; if the user wants no quuery in that case. 2744 (if (or (and (eq enable-local-variables t) 2745 (null unsafe-vars) 2746 (null risky-vars)) 2747 (eq enable-local-variables :all) 2748 (hack-local-variables-confirm 2749 result unsafe-vars risky-vars)) 2750 (dolist (elt result) 2751 (hack-one-local-variable (car elt) (cdr elt))))))) 2752 (run-hooks 'hack-local-variables-hook))))) 2753 2754(defun safe-local-variable-p (sym val) 2755 "Non-nil if SYM is safe as a file-local variable with value VAL. 2756It is safe if any of these conditions are met: 2757 2758 * There is a matching entry (SYM . VAL) in the 2759 `safe-local-variable-values' user option. 2760 2761 * The `safe-local-variable' property of SYM is a function that 2762 evaluates to a non-nil value with VAL as an argument." 2763 (or (member (cons sym val) safe-local-variable-values) 2764 (let ((safep (get sym 'safe-local-variable))) 2765 (and (functionp safep) (funcall safep val))))) 2766 2767(defun risky-local-variable-p (sym &optional ignored) 2768 "Non-nil if SYM could be dangerous as a file-local variable. 2769It is dangerous if either of these conditions are met: 2770 2771 * Its `risky-local-variable' property is non-nil. 2772 2773 * Its name ends with \"hook(s)\", \"function(s)\", \"form(s)\", \"map\", 2774 \"program\", \"command(s)\", \"predicate(s)\", \"frame-alist\", 2775 \"mode-alist\", \"font-lock-(syntactic-)keyword*\", 2776 \"map-alist\", or \"bindat-spec\"." 2777 ;; If this is an alias, check the base name. 2778 (condition-case nil 2779 (setq sym (indirect-variable sym)) 2780 (error nil)) 2781 (or (get sym 'risky-local-variable) 2782 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|\ 2783-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords\ 2784-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|\ 2785-map$\\|-map-alist$\\|-bindat-spec$" (symbol-name sym)))) 2786 2787(defun hack-one-local-variable-quotep (exp) 2788 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) 2789 2790(defun hack-one-local-variable-constantp (exp) 2791 (or (and (not (symbolp exp)) (not (consp exp))) 2792 (memq exp '(t nil)) 2793 (keywordp exp) 2794 (hack-one-local-variable-quotep exp))) 2795 2796(defun hack-one-local-variable-eval-safep (exp) 2797 "Return t if it is safe to eval EXP when it is found in a file." 2798 (or (not (consp exp)) 2799 ;; Detect certain `put' expressions. 2800 (and (eq (car exp) 'put) 2801 (hack-one-local-variable-quotep (nth 1 exp)) 2802 (hack-one-local-variable-quotep (nth 2 exp)) 2803 (let ((prop (nth 1 (nth 2 exp))) (val (nth 3 exp))) 2804 (cond ((eq prop 'lisp-indent-hook) 2805 ;; Only allow safe values of lisp-indent-hook; 2806 ;; not functions. 2807 (or (numberp val) (equal val ''defun))) 2808 ((eq prop 'edebug-form-spec) 2809 ;; Only allow indirect form specs. 2810 ;; During bootstrapping, edebug-basic-spec might not be 2811 ;; defined yet. 2812 (and (fboundp 'edebug-basic-spec) 2813 (hack-one-local-variable-quotep val) 2814 (edebug-basic-spec (nth 1 val))))))) 2815 ;; Allow expressions that the user requested. 2816 (member exp safe-local-eval-forms) 2817 ;; Certain functions can be allowed with safe arguments 2818 ;; or can specify verification functions to try. 2819 (and (symbolp (car exp)) 2820 (let ((prop (get (car exp) 'safe-local-eval-function))) 2821 (cond ((eq prop t) 2822 (let ((ok t)) 2823 (dolist (arg (cdr exp)) 2824 (unless (hack-one-local-variable-constantp arg) 2825 (setq ok nil))) 2826 ok)) 2827 ((functionp prop) 2828 (funcall prop exp)) 2829 ((listp prop) 2830 (let ((ok nil)) 2831 (dolist (function prop) 2832 (if (funcall function exp) 2833 (setq ok t))) 2834 ok))))))) 2835 2836(defun hack-one-local-variable (var val) 2837 "Set local variable VAR with value VAL. 2838If VAR is `mode', call `VAL-mode' as a function unless it's 2839already the major mode." 2840 (cond ((eq var 'mode) 2841 (let ((mode (intern (concat (downcase (symbol-name val)) 2842 "-mode")))) 2843 (unless (eq (indirect-function mode) 2844 (indirect-function major-mode)) 2845 (funcall mode)))) 2846 ((eq var 'eval) 2847 (save-excursion (eval val))) 2848 (t 2849 ;; Make sure the string has no text properties. 2850 ;; Some text properties can get evaluated in various ways, 2851 ;; so it is risky to put them on with a local variable list. 2852 (if (stringp val) 2853 (set-text-properties 0 (length val) nil val)) 2854 (set (make-local-variable var) val)))) 2855 2856 2857(defcustom change-major-mode-with-file-name t 2858 "Non-nil means \\[write-file] should set the major mode from the file name. 2859However, the mode will not be changed if 2860\(1) a local variables list or the `-*-' line specifies a major mode, or 2861\(2) the current major mode is a \"special\" mode, 2862\ not suitable for ordinary files, or 2863\(3) the new file name does not particularly specify any mode." 2864 :type 'boolean 2865 :group 'editing-basics) 2866 2867(defun set-visited-file-name (filename &optional no-query along-with-file) 2868 "Change name of file visited in current buffer to FILENAME. 2869This also renames the buffer to correspond to the new file. 2870The next time the buffer is saved it will go in the newly specified file. 2871FILENAME nil or an empty string means mark buffer as not visiting any file. 2872Remember to delete the initial contents of the minibuffer 2873if you wish to pass an empty string as the argument. 2874 2875The optional second argument NO-QUERY, if non-nil, inhibits asking for 2876confirmation in the case where another buffer is already visiting FILENAME. 2877 2878The optional third argument ALONG-WITH-FILE, if non-nil, means that 2879the old visited file has been renamed to the new name FILENAME." 2880 (interactive "FSet visited file name: ") 2881 (if (buffer-base-buffer) 2882 (error "An indirect buffer cannot visit a file")) 2883 (let (truename) 2884 (if filename 2885 (setq filename 2886 (if (string-equal filename "") 2887 nil 2888 (expand-file-name filename)))) 2889 (if filename 2890 (progn 2891 (setq truename (file-truename filename)) 2892 (if find-file-visit-truename 2893 (setq filename truename)))) 2894 (if filename 2895 (let ((new-name (file-name-nondirectory filename))) 2896 (if (string= new-name "") 2897 (error "Empty file name")))) 2898 (let ((buffer (and filename (find-buffer-visiting filename)))) 2899 (and buffer (not (eq buffer (current-buffer))) 2900 (not no-query) 2901 (not (y-or-n-p (format "A buffer is visiting %s; proceed? " 2902 filename))) 2903 (error "Aborted"))) 2904 (or (equal filename buffer-file-name) 2905 (progn 2906 (and filename (lock-buffer filename)) 2907 (unlock-buffer))) 2908 (setq buffer-file-name filename) 2909 (if filename ; make buffer name reflect filename. 2910 (let ((new-name (file-name-nondirectory buffer-file-name))) 2911 (if (eq system-type 'vax-vms) 2912 (setq new-name (downcase new-name))) 2913 (setq default-directory (file-name-directory buffer-file-name)) 2914 ;; If new-name == old-name, renaming would add a spurious <2> 2915 ;; and it's considered as a feature in rename-buffer. 2916 (or (string= new-name (buffer-name)) 2917 (rename-buffer new-name t)))) 2918 (setq buffer-backed-up nil) 2919 (or along-with-file 2920 (clear-visited-file-modtime)) 2921 ;; Abbreviate the file names of the buffer. 2922 (if truename 2923 (progn 2924 (setq buffer-file-truename (abbreviate-file-name truename)) 2925 (if find-file-visit-truename 2926 (setq buffer-file-name truename)))) 2927 (setq buffer-file-number 2928 (if filename 2929 (nthcdr 10 (file-attributes buffer-file-name)) 2930 nil))) 2931 ;; write-file-functions is normally used for things like ftp-find-file 2932 ;; that visit things that are not local files as if they were files. 2933 ;; Changing to visit an ordinary local file instead should flush the hook. 2934 (kill-local-variable 'write-file-functions) 2935 (kill-local-variable 'local-write-file-hooks) 2936 (kill-local-variable 'revert-buffer-function) 2937 (kill-local-variable 'backup-inhibited) 2938 ;; If buffer was read-only because of version control, 2939 ;; that reason is gone now, so make it writable. 2940 (if vc-mode 2941 (setq buffer-read-only nil)) 2942 (kill-local-variable 'vc-mode) 2943 ;; Turn off backup files for certain file names. 2944 ;; Since this is a permanent local, the major mode won't eliminate it. 2945 (and buffer-file-name 2946 backup-enable-predicate 2947 (not (funcall backup-enable-predicate buffer-file-name)) 2948 (progn 2949 (make-local-variable 'backup-inhibited) 2950 (setq backup-inhibited t))) 2951 (let ((oauto buffer-auto-save-file-name)) 2952 ;; If auto-save was not already on, turn it on if appropriate. 2953 (if (not buffer-auto-save-file-name) 2954 (and buffer-file-name auto-save-default 2955 (auto-save-mode t)) 2956 ;; If auto save is on, start using a new name. 2957 ;; We deliberately don't rename or delete the old auto save 2958 ;; for the old visited file name. This is because perhaps 2959 ;; the user wants to save the new state and then compare with the 2960 ;; previous state from the auto save file. 2961 (setq buffer-auto-save-file-name 2962 (make-auto-save-file-name))) 2963 ;; Rename the old auto save file if any. 2964 (and oauto buffer-auto-save-file-name 2965 (file-exists-p oauto) 2966 (rename-file oauto buffer-auto-save-file-name t))) 2967 (and buffer-file-name 2968 (not along-with-file) 2969 (set-buffer-modified-p t)) 2970 ;; Update the major mode, if the file name determines it. 2971 (condition-case nil 2972 ;; Don't change the mode if it is special. 2973 (or (not change-major-mode-with-file-name) 2974 (get major-mode 'mode-class) 2975 ;; Don't change the mode if the local variable list specifies it. 2976 (hack-local-variables t) 2977 (set-auto-mode t)) 2978 (error nil))) 2979 2980(defun write-file (filename &optional confirm) 2981 "Write current buffer into file FILENAME. 2982This makes the buffer visit that file, and marks it as not modified. 2983 2984If you specify just a directory name as FILENAME, that means to use 2985the default file name but in that directory. You can also yank 2986the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element]. 2987 2988If the buffer is not already visiting a file, the default file name 2989for the output file is the buffer name. 2990 2991If optional second arg CONFIRM is non-nil, this function 2992asks for confirmation before overwriting an existing file. 2993Interactively, confirmation is required unless you supply a prefix argument." 2994;; (interactive "FWrite file: ") 2995 (interactive 2996 (list (if buffer-file-name 2997 (read-file-name "Write file: " 2998 nil nil nil nil) 2999 (read-file-name "Write file: " default-directory 3000 (expand-file-name 3001 (file-name-nondirectory (buffer-name)) 3002 default-directory) 3003 nil nil)) 3004 (not current-prefix-arg))) 3005 (or (null filename) (string-equal filename "") 3006 (progn 3007 ;; If arg is just a directory, 3008 ;; use the default file name, but in that directory. 3009 (if (file-directory-p filename) 3010 (setq filename (concat (file-name-as-directory filename) 3011 (file-name-nondirectory 3012 (or buffer-file-name (buffer-name)))))) 3013 (and confirm 3014 (file-exists-p filename) 3015 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) 3016 (error "Canceled"))) 3017 (set-visited-file-name filename (not confirm)))) 3018 (set-buffer-modified-p t) 3019 ;; Make buffer writable if file is writable. 3020 (and buffer-file-name 3021 (file-writable-p buffer-file-name) 3022 (setq buffer-read-only nil)) 3023 (save-buffer) 3024 ;; It's likely that the VC status at the new location is different from 3025 ;; the one at the old location. 3026 (vc-find-file-hook)) 3027 3028(defun backup-buffer () 3029 "Make a backup of the disk file visited by the current buffer, if appropriate. 3030This is normally done before saving the buffer the first time. 3031 3032A backup may be done by renaming or by copying; see documentation of 3033variable `make-backup-files'. If it's done by renaming, then the file is 3034no longer accessible under its old name. 3035 3036The value is non-nil after a backup was made by renaming. 3037It has the form (MODES . BACKUPNAME). 3038MODES is the result of `file-modes' on the original 3039file; this means that the caller, after saving the buffer, should change 3040the modes of the new file to agree with the old modes. 3041BACKUPNAME is the backup file name, which is the old file renamed." 3042 (if (and make-backup-files (not backup-inhibited) 3043 (not buffer-backed-up) 3044 (file-exists-p buffer-file-name) 3045 (memq (aref (elt (file-attributes buffer-file-name) 8) 0) 3046 '(?- ?l))) 3047 (let ((real-file-name buffer-file-name) 3048 backup-info backupname targets setmodes) 3049 ;; If specified name is a symbolic link, chase it to the target. 3050 ;; Thus we make the backups in the directory where the real file is. 3051 (setq real-file-name (file-chase-links real-file-name)) 3052 (setq backup-info (find-backup-file-name real-file-name) 3053 backupname (car backup-info) 3054 targets (cdr backup-info)) 3055 ;; (if (file-directory-p buffer-file-name) 3056 ;; (error "Cannot save buffer in directory %s" buffer-file-name)) 3057 (if backup-info 3058 (condition-case () 3059 (let ((delete-old-versions 3060 ;; If have old versions to maybe delete, 3061 ;; ask the user to confirm now, before doing anything. 3062 ;; But don't actually delete til later. 3063 (and targets 3064 (or (eq delete-old-versions t) (eq delete-old-versions nil)) 3065 (or delete-old-versions 3066 (y-or-n-p (format "Delete excess backup versions of %s? " 3067 real-file-name))))) 3068 (modes (file-modes buffer-file-name))) 3069 ;; Actually write the back up file. 3070 (condition-case () 3071 (if (or file-precious-flag 3072 ; (file-symlink-p buffer-file-name) 3073 backup-by-copying 3074 ;; Don't rename a suid or sgid file. 3075 (and modes (< 0 (logand modes #o6000))) 3076 (not (file-writable-p (file-name-directory real-file-name))) 3077 (and backup-by-copying-when-linked 3078 (> (file-nlinks real-file-name) 1)) 3079 (and (or backup-by-copying-when-mismatch 3080 (integerp backup-by-copying-when-privileged-mismatch)) 3081 (let ((attr (file-attributes real-file-name))) 3082 (and (or backup-by-copying-when-mismatch 3083 (and (integerp (nth 2 attr)) 3084 (integerp backup-by-copying-when-privileged-mismatch) 3085 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) 3086 (or (nth 9 attr) 3087 (not (file-ownership-preserved-p real-file-name))))))) 3088 (backup-buffer-copy real-file-name backupname modes) 3089 ;; rename-file should delete old backup. 3090 (rename-file real-file-name backupname t) 3091 (setq setmodes (cons modes backupname))) 3092 (file-error 3093 ;; If trouble writing the backup, write it in ~. 3094 (setq backupname (expand-file-name 3095 (convert-standard-filename 3096 "~/%backup%~"))) 3097 (message "Cannot write backup file; backing up in %s" 3098 backupname) 3099 (sleep-for 1) 3100 (backup-buffer-copy real-file-name backupname modes))) 3101 (setq buffer-backed-up t) 3102 ;; Now delete the old versions, if desired. 3103 (if delete-old-versions 3104 (while targets 3105 (condition-case () 3106 (delete-file (car targets)) 3107 (file-error nil)) 3108 (setq targets (cdr targets)))) 3109 setmodes) 3110 (file-error nil)))))) 3111 3112(defun backup-buffer-copy (from-name to-name modes) 3113 (let ((umask (default-file-modes))) 3114 (unwind-protect 3115 (progn 3116 ;; Create temp files with strict access rights. It's easy to 3117 ;; loosen them later, whereas it's impossible to close the 3118 ;; time-window of loose permissions otherwise. 3119 (set-default-file-modes ?\700) 3120 (while (condition-case () 3121 (progn 3122 (condition-case nil 3123 (delete-file to-name) 3124 (file-error nil)) 3125 (copy-file from-name to-name nil t) 3126 nil) 3127 (file-already-exists t)) 3128 ;; The file was somehow created by someone else between 3129 ;; `delete-file' and `copy-file', so let's try again. 3130 nil)) 3131 ;; Reset the umask. 3132 (set-default-file-modes umask))) 3133 (and modes 3134 (set-file-modes to-name (logand modes #o1777)))) 3135 3136(defun file-name-sans-versions (name &optional keep-backup-version) 3137 "Return file NAME sans backup versions or strings. 3138This is a separate procedure so your site-init or startup file can 3139redefine it. 3140If the optional argument KEEP-BACKUP-VERSION is non-nil, 3141we do not remove backup version numbers, only true file version numbers." 3142 (let ((handler (find-file-name-handler name 'file-name-sans-versions))) 3143 (if handler 3144 (funcall handler 'file-name-sans-versions name keep-backup-version) 3145 (substring name 0 3146 (if (eq system-type 'vax-vms) 3147 ;; VMS version number is (a) semicolon, optional 3148 ;; sign, zero or more digits or (b) period, option 3149 ;; sign, zero or more digits, provided this is the 3150 ;; second period encountered outside of the 3151 ;; device/directory part of the file name. 3152 (or (string-match ";[-+]?[0-9]*\\'" name) 3153 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'" 3154 name) 3155 (match-beginning 1)) 3156 (length name)) 3157 (if keep-backup-version 3158 (length name) 3159 (or (string-match "\\.~[0-9.]+~\\'" name) 3160 (string-match "~\\'" name) 3161 (length name)))))))) 3162 3163(defun file-ownership-preserved-p (file) 3164 "Return t if deleting FILE and rewriting it would preserve the owner." 3165 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) 3166 (if handler 3167 (funcall handler 'file-ownership-preserved-p file) 3168 (let ((attributes (file-attributes file))) 3169 ;; Return t if the file doesn't exist, since it's true that no 3170 ;; information would be lost by an (attempted) delete and create. 3171 (or (null attributes) 3172 (= (nth 2 attributes) (user-uid))))))) 3173 3174(defun file-name-sans-extension (filename) 3175 "Return FILENAME sans final \"extension\". 3176The extension, in a file name, is the part that follows the last `.', 3177except that a leading `.', if any, doesn't count." 3178 (save-match-data 3179 (let ((file (file-name-sans-versions (file-name-nondirectory filename))) 3180 directory) 3181 (if (and (string-match "\\.[^.]*\\'" file) 3182 (not (eq 0 (match-beginning 0)))) 3183 (if (setq directory (file-name-directory filename)) 3184 ;; Don't use expand-file-name here; if DIRECTORY is relative, 3185 ;; we don't want to expand it. 3186 (concat directory (substring file 0 (match-beginning 0))) 3187 (substring file 0 (match-beginning 0))) 3188 filename)))) 3189 3190(defun file-name-extension (filename &optional period) 3191 "Return FILENAME's final \"extension\". 3192The extension, in a file name, is the part that follows the last `.', 3193excluding version numbers and backup suffixes, 3194except that a leading `.', if any, doesn't count. 3195Return nil for extensionless file names such as `foo'. 3196Return the empty string for file names such as `foo.'. 3197 3198If PERIOD is non-nil, then the returned value includes the period 3199that delimits the extension, and if FILENAME has no extension, 3200the value is \"\"." 3201 (save-match-data 3202 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))) 3203 (if (and (string-match "\\.[^.]*\\'" file) 3204 (not (eq 0 (match-beginning 0)))) 3205 (substring file (+ (match-beginning 0) (if period 0 1))) 3206 (if period 3207 ""))))) 3208 3209(defcustom make-backup-file-name-function nil 3210 "A function to use instead of the default `make-backup-file-name'. 3211A value of nil gives the default `make-backup-file-name' behavior. 3212 3213This could be buffer-local to do something special for specific 3214files. If you define it, you may need to change `backup-file-name-p' 3215and `file-name-sans-versions' too. 3216 3217See also `backup-directory-alist'." 3218 :group 'backup 3219 :type '(choice (const :tag "Default" nil) 3220 (function :tag "Your function"))) 3221 3222(defcustom backup-directory-alist nil 3223 "Alist of filename patterns and backup directory names. 3224Each element looks like (REGEXP . DIRECTORY). Backups of files with 3225names matching REGEXP will be made in DIRECTORY. DIRECTORY may be 3226relative or absolute. If it is absolute, so that all matching files 3227are backed up into the same directory, the file names in this 3228directory will be the full name of the file backed up with all 3229directory separators changed to `!' to prevent clashes. This will not 3230work correctly if your filesystem truncates the resulting name. 3231 3232For the common case of all backups going into one directory, the alist 3233should contain a single element pairing \".\" with the appropriate 3234directory name. 3235 3236If this variable is nil, or it fails to match a filename, the backup 3237is made in the original file's directory. 3238 3239On MS-DOS filesystems without long names this variable is always 3240ignored." 3241 :group 'backup 3242 :type '(repeat (cons (regexp :tag "Regexp matching filename") 3243 (directory :tag "Backup directory name")))) 3244 3245(defun normal-backup-enable-predicate (name) 3246 "Default `backup-enable-predicate' function. 3247Checks for files in `temporary-file-directory', 3248`small-temporary-file-directory', and /tmp." 3249 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil 3250 name 0 nil))) 3251 ;; Directory is under temporary-file-directory. 3252 (and (not (eq comp t)) 3253 (< comp (- (length temporary-file-directory))))) 3254 (let ((comp (compare-strings "/tmp" 0 nil 3255 name 0 nil))) 3256 ;; Directory is under /tmp. 3257 (and (not (eq comp t)) 3258 (< comp (- (length "/tmp"))))) 3259 (if small-temporary-file-directory 3260 (let ((comp (compare-strings small-temporary-file-directory 3261 0 nil 3262 name 0 nil))) 3263 ;; Directory is under small-temporary-file-directory. 3264 (and (not (eq comp t)) 3265 (< comp (- (length small-temporary-file-directory))))))))) 3266 3267(defun make-backup-file-name (file) 3268 "Create the non-numeric backup file name for FILE. 3269Normally this will just be the file's name with `~' appended. 3270Customization hooks are provided as follows. 3271 3272If the variable `make-backup-file-name-function' is non-nil, its value 3273should be a function which will be called with FILE as its argument; 3274the resulting name is used. 3275 3276Otherwise a match for FILE is sought in `backup-directory-alist'; see 3277the documentation of that variable. If the directory for the backup 3278doesn't exist, it is created." 3279 (if make-backup-file-name-function 3280 (funcall make-backup-file-name-function file) 3281 (if (and (eq system-type 'ms-dos) 3282 (not (msdos-long-file-names))) 3283 (let ((fn (file-name-nondirectory file))) 3284 (concat (file-name-directory file) 3285 (or (and (string-match "\\`[^.]+\\'" fn) 3286 (concat (match-string 0 fn) ".~")) 3287 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) 3288 (concat (match-string 0 fn) "~"))))) 3289 (concat (make-backup-file-name-1 file) "~")))) 3290 3291(defun make-backup-file-name-1 (file) 3292 "Subroutine of `make-backup-file-name' and `find-backup-file-name'." 3293 (let ((alist backup-directory-alist) 3294 elt backup-directory abs-backup-directory) 3295 (while alist 3296 (setq elt (pop alist)) 3297 (if (string-match (car elt) file) 3298 (setq backup-directory (cdr elt) 3299 alist nil))) 3300 ;; If backup-directory is relative, it should be relative to the 3301 ;; file's directory. By expanding explicitly here, we avoid 3302 ;; depending on default-directory. 3303 (if backup-directory 3304 (setq abs-backup-directory 3305 (expand-file-name backup-directory 3306 (file-name-directory file)))) 3307 (if (and abs-backup-directory (not (file-exists-p abs-backup-directory))) 3308 (condition-case nil 3309 (make-directory abs-backup-directory 'parents) 3310 (file-error (setq backup-directory nil 3311 abs-backup-directory nil)))) 3312 (if (null backup-directory) 3313 file 3314 (if (file-name-absolute-p backup-directory) 3315 (progn 3316 (when (memq system-type '(windows-nt ms-dos cygwin)) 3317 ;; Normalize DOSish file names: downcase the drive 3318 ;; letter, if any, and replace the leading "x:" with 3319 ;; "/drive_x". 3320 (or (file-name-absolute-p file) 3321 (setq file (expand-file-name file))) ; make defaults explicit 3322 ;; Replace any invalid file-name characters (for the 3323 ;; case of backing up remote files). 3324 (setq file (expand-file-name (convert-standard-filename file))) 3325 (if (eq (aref file 1) ?:) 3326 (setq file (concat "/" 3327 "drive_" 3328 (char-to-string (downcase (aref file 0))) 3329 (if (eq (aref file 2) ?/) 3330 "" 3331 "/") 3332 (substring file 2))))) 3333 ;; Make the name unique by substituting directory 3334 ;; separators. It may not really be worth bothering about 3335 ;; doubling `!'s in the original name... 3336 (expand-file-name 3337 (subst-char-in-string 3338 ?/ ?! 3339 (replace-regexp-in-string "!" "!!" file)) 3340 backup-directory)) 3341 (expand-file-name (file-name-nondirectory file) 3342 (file-name-as-directory abs-backup-directory)))))) 3343 3344(defun backup-file-name-p (file) 3345 "Return non-nil if FILE is a backup file name (numeric or not). 3346This is a separate function so you can redefine it for customization. 3347You may need to redefine `file-name-sans-versions' as well." 3348 (string-match "~\\'" file)) 3349 3350(defvar backup-extract-version-start) 3351 3352;; This is used in various files. 3353;; The usage of backup-extract-version-start is not very clean, 3354;; but I can't see a good alternative, so as of now I am leaving it alone. 3355(defun backup-extract-version (fn) 3356 "Given the name of a numeric backup file, FN, return the backup number. 3357Uses the free variable `backup-extract-version-start', whose value should be 3358the index in the name where the version number begins." 3359 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start) 3360 (= (match-beginning 0) backup-extract-version-start)) 3361 (string-to-number (substring fn backup-extract-version-start -1)) 3362 0)) 3363 3364;; I believe there is no need to alter this behavior for VMS; 3365;; since backup files are not made on VMS, it should not get called. 3366(defun find-backup-file-name (fn) 3367 "Find a file name for a backup file FN, and suggestions for deletions. 3368Value is a list whose car is the name for the backup file 3369and whose cdr is a list of old versions to consider deleting now. 3370If the value is nil, don't make a backup. 3371Uses `backup-directory-alist' in the same way as does 3372`make-backup-file-name'." 3373 (let ((handler (find-file-name-handler fn 'find-backup-file-name))) 3374 ;; Run a handler for this function so that ange-ftp can refuse to do it. 3375 (if handler 3376 (funcall handler 'find-backup-file-name fn) 3377 (if (or (eq version-control 'never) 3378 ;; We don't support numbered backups on plain MS-DOS 3379 ;; when long file names are unavailable. 3380 (and (eq system-type 'ms-dos) 3381 (not (msdos-long-file-names)))) 3382 (list (make-backup-file-name fn)) 3383 (let* ((basic-name (make-backup-file-name-1 fn)) 3384 (base-versions (concat (file-name-nondirectory basic-name) 3385 ".~")) 3386 (backup-extract-version-start (length base-versions)) 3387 (high-water-mark 0) 3388 (number-to-delete 0) 3389 possibilities deserve-versions-p versions) 3390 (condition-case () 3391 (setq possibilities (file-name-all-completions 3392 base-versions 3393 (file-name-directory basic-name)) 3394 versions (sort (mapcar #'backup-extract-version 3395 possibilities) 3396 #'<) 3397 high-water-mark (apply 'max 0 versions) 3398 deserve-versions-p (or version-control 3399 (> high-water-mark 0)) 3400 number-to-delete (- (length versions) 3401 kept-old-versions 3402 kept-new-versions 3403 -1)) 3404 (file-error (setq possibilities nil))) 3405 (if (not deserve-versions-p) 3406 (list (make-backup-file-name fn)) 3407 (cons (format "%s.~%d~" basic-name (1+ high-water-mark)) 3408 (if (and (> number-to-delete 0) 3409 ;; Delete nothing if there is overflow 3410 ;; in the number of versions to keep. 3411 (>= (+ kept-new-versions kept-old-versions -1) 0)) 3412 (mapcar (lambda (n) 3413 (format "%s.~%d~" basic-name n)) 3414 (let ((v (nthcdr kept-old-versions versions))) 3415 (rplacd (nthcdr (1- number-to-delete) v) ()) 3416 v)))))))))) 3417 3418(defun file-nlinks (filename) 3419 "Return number of names file FILENAME has." 3420 (car (cdr (file-attributes filename)))) 3421 3422;; (defun file-relative-name (filename &optional directory) 3423;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). 3424;; This function returns a relative file name which is equivalent to FILENAME 3425;; when used with that default directory as the default. 3426;; If this is impossible (which can happen on MSDOS and Windows 3427;; when the file name and directory use different drive names) 3428;; then it returns FILENAME." 3429;; (save-match-data 3430;; (let ((fname (expand-file-name filename))) 3431;; (setq directory (file-name-as-directory 3432;; (expand-file-name (or directory default-directory)))) 3433;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different 3434;; ;; drive names, they can't be relative, so return the absolute name. 3435;; (if (and (or (eq system-type 'ms-dos) 3436;; (eq system-type 'cygwin) 3437;; (eq system-type 'windows-nt)) 3438;; (not (string-equal (substring fname 0 2) 3439;; (substring directory 0 2)))) 3440;; filename 3441;; (let ((ancestor ".") 3442;; (fname-dir (file-name-as-directory fname))) 3443;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir)) 3444;; (not (string-match (concat "^" (regexp-quote directory)) fname))) 3445;; (setq directory (file-name-directory (substring directory 0 -1)) 3446;; ancestor (if (equal ancestor ".") 3447;; ".." 3448;; (concat "../" ancestor)))) 3449;; ;; Now ancestor is empty, or .., or ../.., etc. 3450;; (if (string-match (concat "^" (regexp-quote directory)) fname) 3451;; ;; We matched within FNAME's directory part. 3452;; ;; Add the rest of FNAME onto ANCESTOR. 3453;; (let ((rest (substring fname (match-end 0)))) 3454;; (if (and (equal ancestor ".") 3455;; (not (equal rest ""))) 3456;; ;; But don't bother with ANCESTOR if it would give us `./'. 3457;; rest 3458;; (concat (file-name-as-directory ancestor) rest))) 3459;; ;; We matched FNAME's directory equivalent. 3460;; ancestor)))))) 3461 3462(defun file-relative-name (filename &optional directory) 3463 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). 3464This function returns a relative file name which is equivalent to FILENAME 3465when used with that default directory as the default. 3466If FILENAME and DIRECTORY lie on different machines or on different drives 3467on a DOS/Windows machine, it returns FILENAME in expanded form." 3468 (save-match-data 3469 (setq directory 3470 (file-name-as-directory (expand-file-name (or directory 3471 default-directory)))) 3472 (setq filename (expand-file-name filename)) 3473 (let ((fremote (file-remote-p filename)) 3474 (dremote (file-remote-p directory))) 3475 (if ;; Conditions for separate trees 3476 (or 3477 ;; Test for different drives on DOS/Windows 3478 (and 3479 ;; Should `cygwin' really be included here? --stef 3480 (memq system-type '(ms-dos cygwin windows-nt)) 3481 (not (eq t (compare-strings filename 0 2 directory 0 2)))) 3482 ;; Test for different remote file system identification 3483 (not (equal fremote dremote))) 3484 filename 3485 (let ((ancestor ".") 3486 (filename-dir (file-name-as-directory filename))) 3487 (while (not 3488 (or 3489 (eq t (compare-strings filename-dir nil (length directory) 3490 directory nil nil case-fold-search)) 3491 (eq t (compare-strings filename nil (length directory) 3492 directory nil nil case-fold-search)))) 3493 (setq directory (file-name-directory (substring directory 0 -1)) 3494 ancestor (if (equal ancestor ".") 3495 ".." 3496 (concat "../" ancestor)))) 3497 ;; Now ancestor is empty, or .., or ../.., etc. 3498 (if (eq t (compare-strings filename nil (length directory) 3499 directory nil nil case-fold-search)) 3500 ;; We matched within FILENAME's directory part. 3501 ;; Add the rest of FILENAME onto ANCESTOR. 3502 (let ((rest (substring filename (length directory)))) 3503 (if (and (equal ancestor ".") (not (equal rest ""))) 3504 ;; But don't bother with ANCESTOR if it would give us `./'. 3505 rest 3506 (concat (file-name-as-directory ancestor) rest))) 3507 ;; We matched FILENAME's directory equivalent. 3508 ancestor)))))) 3509 3510(defun save-buffer (&optional args) 3511 "Save current buffer in visited file if modified. 3512Variations are described below. 3513 3514By default, makes the previous version into a backup file 3515 if previously requested or if this is the first save. 3516Prefixed with one \\[universal-argument], marks this version 3517 to become a backup when the next save is done. 3518Prefixed with two \\[universal-argument]'s, 3519 unconditionally makes the previous version into a backup file. 3520Prefixed with three \\[universal-argument]'s, marks this version 3521 to become a backup when the next save is done, 3522 and unconditionally makes the previous version into a backup file. 3523 3524With a numeric argument of 0, never make the previous version 3525into a backup file. 3526 3527If a file's name is FOO, the names of its numbered backup versions are 3528 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. 3529Numeric backups (rather than FOO~) will be made if value of 3530 `version-control' is not the atom `never' and either there are already 3531 numeric versions of the file being backed up, or `version-control' is 3532 non-nil. 3533We don't want excessive versions piling up, so there are variables 3534 `kept-old-versions', which tells Emacs how many oldest versions to keep, 3535 and `kept-new-versions', which tells how many newest versions to keep. 3536 Defaults are 2 old versions and 2 new. 3537`dired-kept-versions' controls dired's clean-directory (.) command. 3538If `delete-old-versions' is nil, system will query user 3539 before trimming versions. Otherwise it does it silently. 3540 3541If `vc-make-backup-files' is nil, which is the default, 3542 no backup files are made for files managed by version control. 3543 (This is because the version control system itself records previous versions.) 3544 3545See the subroutine `basic-save-buffer' for more information." 3546 (interactive "p") 3547 (let ((modp (buffer-modified-p)) 3548 (large (> (buffer-size) 50000)) 3549 (make-backup-files (or (and make-backup-files (not (eq args 0))) 3550 (memq args '(16 64))))) 3551 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) 3552 (if (and modp large (buffer-file-name)) 3553 (message "Saving file %s..." (buffer-file-name))) 3554 (basic-save-buffer) 3555 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) 3556 3557(defun delete-auto-save-file-if-necessary (&optional force) 3558 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. 3559Normally delete only if the file was written by this Emacs since 3560the last real save, but optional arg FORCE non-nil means delete anyway." 3561 (and buffer-auto-save-file-name delete-auto-save-files 3562 (not (string= buffer-file-name buffer-auto-save-file-name)) 3563 (or force (recent-auto-save-p)) 3564 (progn 3565 (condition-case () 3566 (delete-file buffer-auto-save-file-name) 3567 (file-error nil)) 3568 (set-buffer-auto-saved)))) 3569 3570(defvar auto-save-hook nil 3571 "Normal hook run just before auto-saving.") 3572 3573(defcustom before-save-hook nil 3574 "Normal hook that is run before a buffer is saved to its file." 3575 :options '(copyright-update time-stamp) 3576 :type 'hook 3577 :group 'files) 3578 3579(defcustom after-save-hook nil 3580 "Normal hook that is run after a buffer is saved to its file." 3581 :options '(executable-make-buffer-file-executable-if-script-p) 3582 :type 'hook 3583 :group 'files) 3584 3585(defvar save-buffer-coding-system nil 3586 "If non-nil, use this coding system for saving the buffer. 3587More precisely, use this coding system in place of the 3588value of `buffer-file-coding-system', when saving the buffer. 3589Calling `write-region' for any purpose other than saving the buffer 3590will still use `buffer-file-coding-system'; this variable has no effect 3591in such cases.") 3592 3593(make-variable-buffer-local 'save-buffer-coding-system) 3594(put 'save-buffer-coding-system 'permanent-local t) 3595 3596(defun basic-save-buffer () 3597 "Save the current buffer in its visited file, if it has been modified. 3598The hooks `write-contents-functions' and `write-file-functions' get a chance 3599to do the job of saving; if they do not, then the buffer is saved in 3600the visited file in the usual way. 3601Before and after saving the buffer, this function runs 3602`before-save-hook' and `after-save-hook', respectively." 3603 (interactive) 3604 (save-current-buffer 3605 ;; In an indirect buffer, save its base buffer instead. 3606 (if (buffer-base-buffer) 3607 (set-buffer (buffer-base-buffer))) 3608 (if (buffer-modified-p) 3609 (let ((recent-save (recent-auto-save-p)) 3610 setmodes) 3611 ;; On VMS, rename file and buffer to get rid of version number. 3612 (if (and (eq system-type 'vax-vms) 3613 (not (string= buffer-file-name 3614 (file-name-sans-versions buffer-file-name)))) 3615 (let (buffer-new-name) 3616 ;; Strip VMS version number before save. 3617 (setq buffer-file-name 3618 (file-name-sans-versions buffer-file-name)) 3619 ;; Construct a (unique) buffer name to correspond. 3620 (let ((buf (create-file-buffer (downcase buffer-file-name)))) 3621 (setq buffer-new-name (buffer-name buf)) 3622 (kill-buffer buf)) 3623 (rename-buffer buffer-new-name))) 3624 ;; If buffer has no file name, ask user for one. 3625 (or buffer-file-name 3626 (let ((filename 3627 (expand-file-name 3628 (read-file-name "File to save in: ") nil))) 3629 (if (file-exists-p filename) 3630 (if (file-directory-p filename) 3631 ;; Signal an error if the user specified the name of an 3632 ;; existing directory. 3633 (error "%s is a directory" filename) 3634 (unless (y-or-n-p (format "File `%s' exists; overwrite? " 3635 filename)) 3636 (error "Canceled"))) 3637 ;; Signal an error if the specified name refers to a 3638 ;; non-existing directory. 3639 (let ((dir (file-name-directory filename))) 3640 (unless (file-directory-p dir) 3641 (if (file-exists-p dir) 3642 (error "%s is not a directory" dir) 3643 (error "%s: no such directory" dir))))) 3644 (set-visited-file-name filename))) 3645 (or (verify-visited-file-modtime (current-buffer)) 3646 (not (file-exists-p buffer-file-name)) 3647 (yes-or-no-p 3648 (format "%s has changed since visited or saved. Save anyway? " 3649 (file-name-nondirectory buffer-file-name))) 3650 (error "Save not confirmed")) 3651 (save-restriction 3652 (widen) 3653 (save-excursion 3654 (and (> (point-max) (point-min)) 3655 (not find-file-literally) 3656 (/= (char-after (1- (point-max))) ?\n) 3657 (not (and (eq selective-display t) 3658 (= (char-after (1- (point-max))) ?\r))) 3659 (or (eq require-final-newline t) 3660 (eq require-final-newline 'visit-save) 3661 (and require-final-newline 3662 (y-or-n-p 3663 (format "Buffer %s does not end in newline. Add one? " 3664 (buffer-name))))) 3665 (save-excursion 3666 (goto-char (point-max)) 3667 (insert ?\n)))) 3668 ;; Support VC version backups. 3669 (vc-before-save) 3670 (run-hooks 'before-save-hook) 3671 (or (run-hook-with-args-until-success 'write-contents-functions) 3672 (run-hook-with-args-until-success 'local-write-file-hooks) 3673 (run-hook-with-args-until-success 'write-file-functions) 3674 ;; If a hook returned t, file is already "written". 3675 ;; Otherwise, write it the usual way now. 3676 (setq setmodes (basic-save-buffer-1))) 3677 ;; Now we have saved the current buffer. Let's make sure 3678 ;; that buffer-file-coding-system is fixed to what 3679 ;; actually used for saving by binding it locally. 3680 (if save-buffer-coding-system 3681 (setq save-buffer-coding-system last-coding-system-used) 3682 (setq buffer-file-coding-system last-coding-system-used)) 3683 (setq buffer-file-number 3684 (nthcdr 10 (file-attributes buffer-file-name))) 3685 (if setmodes 3686 (condition-case () 3687 (set-file-modes buffer-file-name (car setmodes)) 3688 (error nil)))) 3689 ;; If the auto-save file was recent before this command, 3690 ;; delete it now. 3691 (delete-auto-save-file-if-necessary recent-save) 3692 ;; Support VC `implicit' locking. 3693 (vc-after-save) 3694 (run-hooks 'after-save-hook)) 3695 (message "(No changes need to be saved)")))) 3696 3697;; This does the "real job" of writing a buffer into its visited file 3698;; and making a backup file. This is what is normally done 3699;; but inhibited if one of write-file-functions returns non-nil. 3700;; It returns a value (MODES . BACKUPNAME), like backup-buffer. 3701(defun basic-save-buffer-1 () 3702 (prog1 3703 (if save-buffer-coding-system 3704 (let ((coding-system-for-write save-buffer-coding-system)) 3705 (basic-save-buffer-2)) 3706 (basic-save-buffer-2)) 3707 (setq buffer-file-coding-system-explicit last-coding-system-used))) 3708 3709;; This returns a value (MODES . BACKUPNAME), like backup-buffer. 3710(defun basic-save-buffer-2 () 3711 (let (tempsetmodes setmodes) 3712 (if (not (file-writable-p buffer-file-name)) 3713 (let ((dir (file-name-directory buffer-file-name))) 3714 (if (not (file-directory-p dir)) 3715 (if (file-exists-p dir) 3716 (error "%s is not a directory" dir) 3717 (error "%s: no such directory" dir)) 3718 (if (not (file-exists-p buffer-file-name)) 3719 (error "Directory %s write-protected" dir) 3720 (if (yes-or-no-p 3721 (format "File %s is write-protected; try to save anyway? " 3722 (file-name-nondirectory 3723 buffer-file-name))) 3724 (setq tempsetmodes t) 3725 (error "Attempt to save to a file which you aren't allowed to write")))))) 3726 (or buffer-backed-up 3727 (setq setmodes (backup-buffer))) 3728 (let ((dir (file-name-directory buffer-file-name))) 3729 (if (and file-precious-flag 3730 (file-writable-p dir)) 3731 ;; If file is precious, write temp name, then rename it. 3732 ;; This requires write access to the containing dir, 3733 ;; which is why we don't try it if we don't have that access. 3734 (let ((realname buffer-file-name) 3735 tempname succeed 3736 (umask (default-file-modes)) 3737 (old-modtime (visited-file-modtime))) 3738 ;; Create temp files with strict access rights. It's easy to 3739 ;; loosen them later, whereas it's impossible to close the 3740 ;; time-window of loose permissions otherwise. 3741 (unwind-protect 3742 (progn 3743 (clear-visited-file-modtime) 3744 (set-default-file-modes ?\700) 3745 ;; Try various temporary names. 3746 ;; This code follows the example of make-temp-file, 3747 ;; but it calls write-region in the appropriate way 3748 ;; for saving the buffer. 3749 (while (condition-case () 3750 (progn 3751 (setq tempname 3752 (make-temp-name 3753 (expand-file-name "tmp" dir))) 3754 (write-region (point-min) (point-max) 3755 tempname nil realname 3756 buffer-file-truename 'excl) 3757 nil) 3758 (file-already-exists t)) 3759 ;; The file was somehow created by someone else between 3760 ;; `make-temp-name' and `write-region', let's try again. 3761 nil) 3762 (setq succeed t)) 3763 ;; Reset the umask. 3764 (set-default-file-modes umask) 3765 ;; If we failed, restore the buffer's modtime. 3766 (unless succeed 3767 (set-visited-file-modtime old-modtime))) 3768 ;; Since we have created an entirely new file, 3769 ;; make sure it gets the right permission bits set. 3770 (setq setmodes (or setmodes 3771 (cons (or (file-modes buffer-file-name) 3772 (logand ?\666 umask)) 3773 buffer-file-name))) 3774 ;; We succeeded in writing the temp file, 3775 ;; so rename it. 3776 (rename-file tempname buffer-file-name t)) 3777 ;; If file not writable, see if we can make it writable 3778 ;; temporarily while we write it. 3779 ;; But no need to do so if we have just backed it up 3780 ;; (setmodes is set) because that says we're superseding. 3781 (cond ((and tempsetmodes (not setmodes)) 3782 ;; Change the mode back, after writing. 3783 (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name)) 3784 (set-file-modes buffer-file-name (logior (car setmodes) 128)))) 3785 (let (success) 3786 (unwind-protect 3787 (progn 3788 (write-region (point-min) (point-max) 3789 buffer-file-name nil t buffer-file-truename) 3790 (setq success t)) 3791 ;; If we get an error writing the new file, and we made 3792 ;; the backup by renaming, undo the backing-up. 3793 (and setmodes (not success) 3794 (progn 3795 (rename-file (cdr setmodes) buffer-file-name t) 3796 (setq buffer-backed-up nil))))))) 3797 setmodes)) 3798 3799(defun diff-buffer-with-file (&optional buffer) 3800 "View the differences between BUFFER and its associated file. 3801This requires the external program `diff' to be in your `exec-path'." 3802 (interactive "bBuffer: ") 3803 (with-current-buffer (get-buffer (or buffer (current-buffer))) 3804 (if (and buffer-file-name 3805 (file-exists-p buffer-file-name)) 3806 (let ((tempfile (make-temp-file "buffer-content-"))) 3807 (unwind-protect 3808 (save-restriction 3809 (widen) 3810 (write-region (point-min) (point-max) tempfile nil 'nomessage) 3811 (diff buffer-file-name tempfile nil t) 3812 (sit-for 0)) 3813 (when (file-exists-p tempfile) 3814 (delete-file tempfile)))) 3815 (message "Buffer %s has no associated file on disc" (buffer-name)) 3816 ;; Display that message for 1 second so that user can read it 3817 ;; in the minibuffer. 3818 (sit-for 1))) 3819 ;; return always nil, so that save-buffers-kill-emacs will not move 3820 ;; over to the next unsaved buffer when calling `d'. 3821 nil) 3822 3823(defvar save-some-buffers-action-alist 3824 '((?\C-r 3825 (lambda (buf) 3826 (view-buffer buf 3827 (lambda (ignore) 3828 (exit-recursive-edit))) 3829 (recursive-edit) 3830 ;; Return nil to ask about BUF again. 3831 nil) 3832 "view this buffer") 3833 (?d (lambda (buf) 3834 (save-window-excursion 3835 (diff-buffer-with-file buf)) 3836 (view-buffer (get-buffer-create "*Diff*") 3837 (lambda (ignore) (exit-recursive-edit))) 3838 (recursive-edit) 3839 nil) 3840 "view changes in this buffer")) 3841 "ACTION-ALIST argument used in call to `map-y-or-n-p'.") 3842 3843(defvar buffer-save-without-query nil 3844 "Non-nil means `save-some-buffers' should save this buffer without asking.") 3845(make-variable-buffer-local 'buffer-save-without-query) 3846 3847(defun save-some-buffers (&optional arg pred) 3848 "Save some modified file-visiting buffers. Asks user about each one. 3849You can answer `y' to save, `n' not to save, `C-r' to look at the 3850buffer in question with `view-buffer' before deciding or `d' to 3851view the differences using `diff-buffer-with-file'. 3852 3853Optional argument (the prefix) non-nil means save all with no questions. 3854Optional second argument PRED determines which buffers are considered: 3855If PRED is nil, all the file-visiting buffers are considered. 3856If PRED is t, then certain non-file buffers will also be considered. 3857If PRED is a zero-argument function, it indicates for each buffer whether 3858to consider it or not when called with that buffer current. 3859 3860See `save-some-buffers-action-alist' if you want to 3861change the additional actions you can take on files." 3862 (interactive "P") 3863 (save-window-excursion 3864 (let* (queried some-automatic 3865 files-done abbrevs-done) 3866 (dolist (buffer (buffer-list)) 3867 ;; First save any buffers that we're supposed to save unconditionally. 3868 ;; That way the following code won't ask about them. 3869 (with-current-buffer buffer 3870 (when (and buffer-save-without-query (buffer-modified-p)) 3871 (setq some-automatic t) 3872 (save-buffer)))) 3873 ;; Ask about those buffers that merit it, 3874 ;; and record the number thus saved. 3875 (setq files-done 3876 (map-y-or-n-p 3877 (function 3878 (lambda (buffer) 3879 (and (buffer-modified-p buffer) 3880 (not (buffer-base-buffer buffer)) 3881 (or 3882 (buffer-file-name buffer) 3883 (and pred 3884 (progn 3885 (set-buffer buffer) 3886 (and buffer-offer-save (> (buffer-size) 0))))) 3887 (or (not (functionp pred)) 3888 (with-current-buffer buffer (funcall pred))) 3889 (if arg 3890 t 3891 (setq queried t) 3892 (if (buffer-file-name buffer) 3893 (format "Save file %s? " 3894 (buffer-file-name buffer)) 3895 (format "Save buffer %s? " 3896 (buffer-name buffer))))))) 3897 (function 3898 (lambda (buffer) 3899 (set-buffer buffer) 3900 (save-buffer))) 3901 (buffer-list) 3902 '("buffer" "buffers" "save") 3903 save-some-buffers-action-alist)) 3904 ;; Maybe to save abbrevs, and record whether 3905 ;; we either saved them or asked to. 3906 (and save-abbrevs abbrevs-changed 3907 (progn 3908 (if (or arg 3909 (eq save-abbrevs 'silently) 3910 (y-or-n-p (format "Save abbrevs in %s? " 3911 abbrev-file-name))) 3912 (write-abbrev-file nil)) 3913 ;; Don't keep bothering user if he says no. 3914 (setq abbrevs-changed nil) 3915 (setq abbrevs-done t))) 3916 (or queried (> files-done 0) abbrevs-done 3917 (message (if some-automatic 3918 "(Some special files were saved without asking)" 3919 "(No files need saving)")))))) 3920 3921(defun not-modified (&optional arg) 3922 "Mark current buffer as unmodified, not needing to be saved. 3923With prefix arg, mark buffer as modified, so \\[save-buffer] will save. 3924 3925It is not a good idea to use this function in Lisp programs, because it 3926prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." 3927 (interactive "P") 3928 (message (if arg "Modification-flag set" 3929 "Modification-flag cleared")) 3930 (set-buffer-modified-p arg)) 3931 3932(defun toggle-read-only (&optional arg) 3933 "Change whether this buffer is visiting its file read-only. 3934With arg, set read-only iff arg is positive. 3935If visiting file read-only and `view-read-only' is non-nil, enter view mode." 3936 (interactive "P") 3937 (if (and arg 3938 (if (> (prefix-numeric-value arg) 0) buffer-read-only 3939 (not buffer-read-only))) ; If buffer-read-only is set correctly, 3940 nil ; do nothing. 3941 ;; Toggle. 3942 (cond 3943 ((and buffer-read-only view-mode) 3944 (View-exit-and-edit) 3945 (make-local-variable 'view-read-only) 3946 (setq view-read-only t)) ; Must leave view mode. 3947 ((and (not buffer-read-only) view-read-only 3948 ;; If view-mode is already active, `view-mode-enter' is a nop. 3949 (not view-mode) 3950 (not (eq (get major-mode 'mode-class) 'special))) 3951 (view-mode-enter)) 3952 (t (setq buffer-read-only (not buffer-read-only)) 3953 (force-mode-line-update))) 3954 (if (vc-backend buffer-file-name) 3955 (message "%s" (substitute-command-keys 3956 (concat "File is under version-control; " 3957 "use \\[vc-next-action] to check in/out")))))) 3958 3959(defun insert-file (filename) 3960 "Insert contents of file FILENAME into buffer after point. 3961Set mark after the inserted text. 3962 3963This function is meant for the user to run interactively. 3964Don't call it from programs! Use `insert-file-contents' instead. 3965\(Its calling sequence is different; see its documentation)." 3966 (interactive "*fInsert file: ") 3967 (insert-file-1 filename #'insert-file-contents)) 3968 3969(defun append-to-file (start end filename) 3970 "Append the contents of the region to the end of file FILENAME. 3971When called from a function, expects three arguments, 3972START, END and FILENAME. START and END are buffer positions 3973saying what text to write." 3974 (interactive "r\nFAppend to file: ") 3975 (write-region start end filename t)) 3976 3977(defun file-newest-backup (filename) 3978 "Return most recent backup file for FILENAME or nil if no backups exist." 3979 ;; `make-backup-file-name' will get us the right directory for 3980 ;; ordinary or numeric backups. It might create a directory for 3981 ;; backups as a side-effect, according to `backup-directory-alist'. 3982 (let* ((filename (file-name-sans-versions 3983 (make-backup-file-name (expand-file-name filename)))) 3984 (file (file-name-nondirectory filename)) 3985 (dir (file-name-directory filename)) 3986 (comp (file-name-all-completions file dir)) 3987 (newest nil) 3988 tem) 3989 (while comp 3990 (setq tem (pop comp)) 3991 (cond ((and (backup-file-name-p tem) 3992 (string= (file-name-sans-versions tem) file)) 3993 (setq tem (concat dir tem)) 3994 (if (or (null newest) 3995 (file-newer-than-file-p tem newest)) 3996 (setq newest tem))))) 3997 newest)) 3998 3999(defun rename-uniquely () 4000 "Rename current buffer to a similar name not already taken. 4001This function is useful for creating multiple shell process buffers 4002or multiple mail buffers, etc." 4003 (interactive) 4004 (save-match-data 4005 (let ((base-name (buffer-name))) 4006 (and (string-match "<[0-9]+>\\'" base-name) 4007 (not (and buffer-file-name 4008 (string= base-name 4009 (file-name-nondirectory buffer-file-name)))) 4010 ;; If the existing buffer name has a <NNN>, 4011 ;; which isn't part of the file name (if any), 4012 ;; then get rid of that. 4013 (setq base-name (substring base-name 0 (match-beginning 0)))) 4014 (rename-buffer (generate-new-buffer-name base-name)) 4015 (force-mode-line-update)))) 4016 4017(defun make-directory (dir &optional parents) 4018 "Create the directory DIR and any nonexistent parent dirs. 4019Interactively, the default choice of directory to create 4020is the current default directory for file names. 4021That is useful when you have visited a file in a nonexistent directory. 4022 4023Noninteractively, the second (optional) argument PARENTS says whether 4024to create parent directories if they don't exist. Interactively, 4025this happens by default." 4026 (interactive 4027 (list (read-file-name "Make directory: " default-directory default-directory 4028 nil nil) 4029 t)) 4030 ;; If default-directory is a remote directory, 4031 ;; make sure we find its make-directory handler. 4032 (setq dir (expand-file-name dir)) 4033 (let ((handler (find-file-name-handler dir 'make-directory))) 4034 (if handler 4035 (funcall handler 'make-directory dir parents) 4036 (if (not parents) 4037 (make-directory-internal dir) 4038 (let ((dir (directory-file-name (expand-file-name dir))) 4039 create-list) 4040 (while (not (file-exists-p dir)) 4041 (setq create-list (cons dir create-list) 4042 dir (directory-file-name (file-name-directory dir)))) 4043 (while create-list 4044 (make-directory-internal (car create-list)) 4045 (setq create-list (cdr create-list)))))))) 4046 4047(put 'revert-buffer-function 'permanent-local t) 4048(defvar revert-buffer-function nil 4049 "Function to use to revert this buffer, or nil to do the default. 4050The function receives two arguments IGNORE-AUTO and NOCONFIRM, 4051which are the arguments that `revert-buffer' received.") 4052 4053(put 'revert-buffer-insert-file-contents-function 'permanent-local t) 4054(defvar revert-buffer-insert-file-contents-function nil 4055 "Function to use to insert contents when reverting this buffer. 4056Gets two args, first the nominal file name to use, 4057and second, t if reading the auto-save file. 4058 4059The function you specify is responsible for updating (or preserving) point.") 4060 4061(defvar buffer-stale-function nil 4062 "Function to check whether a non-file buffer needs reverting. 4063This should be a function with one optional argument NOCONFIRM. 4064Auto Revert Mode passes t for NOCONFIRM. The function should return 4065non-nil if the buffer should be reverted. A return value of 4066`fast' means that the need for reverting was not checked, but 4067that reverting the buffer is fast. The buffer is current when 4068this function is called. 4069 4070The idea behind the NOCONFIRM argument is that it should be 4071non-nil if the buffer is going to be reverted without asking the 4072user. In such situations, one has to be careful with potentially 4073time consuming operations. 4074 4075For more information on how this variable is used by Auto Revert mode, 4076see Info node `(emacs)Supporting additional buffers'.") 4077 4078(defvar before-revert-hook nil 4079 "Normal hook for `revert-buffer' to run before reverting. 4080If `revert-buffer-function' is used to override the normal revert 4081mechanism, this hook is not used.") 4082 4083(defvar after-revert-hook nil 4084 "Normal hook for `revert-buffer' to run after reverting. 4085Note that the hook value that it runs is the value that was in effect 4086before reverting; that makes a difference if you have buffer-local 4087hook functions. 4088 4089If `revert-buffer-function' is used to override the normal revert 4090mechanism, this hook is not used.") 4091 4092(defvar revert-buffer-internal-hook) 4093 4094(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) 4095 "Replace current buffer text with the text of the visited file on disk. 4096This undoes all changes since the file was visited or saved. 4097With a prefix argument, offer to revert from latest auto-save file, if 4098that is more recent than the visited file. 4099 4100This command also works for special buffers that contain text which 4101doesn't come from a file, but reflects some other data base instead: 4102for example, Dired buffers and `buffer-list' buffers. In these cases, 4103it reconstructs the buffer contents from the appropriate data base. 4104 4105When called from Lisp, the first argument is IGNORE-AUTO; only offer 4106to revert from the auto-save file when this is nil. Note that the 4107sense of this argument is the reverse of the prefix argument, for the 4108sake of backward compatibility. IGNORE-AUTO is optional, defaulting 4109to nil. 4110 4111Optional second argument NOCONFIRM means don't ask for confirmation at 4112all. \(The variable `revert-without-query' offers another way to 4113revert buffers without querying for confirmation.) 4114 4115Optional third argument PRESERVE-MODES non-nil means don't alter 4116the files modes. Normally we reinitialize them using `normal-mode'. 4117 4118If the value of `revert-buffer-function' is non-nil, it is called to 4119do all the work for this command. Otherwise, the hooks 4120`before-revert-hook' and `after-revert-hook' are run at the beginning 4121and the end, and if `revert-buffer-insert-file-contents-function' is 4122non-nil, it is called instead of rereading visited file contents." 4123 4124 ;; I admit it's odd to reverse the sense of the prefix argument, but 4125 ;; there is a lot of code out there which assumes that the first 4126 ;; argument should be t to avoid consulting the auto-save file, and 4127 ;; there's no straightforward way to encourage authors to notice a 4128 ;; reversal of the argument sense. So I'm just changing the user 4129 ;; interface, but leaving the programmatic interface the same. 4130 (interactive (list (not current-prefix-arg))) 4131 (if revert-buffer-function 4132 (funcall revert-buffer-function ignore-auto noconfirm) 4133 (with-current-buffer (or (buffer-base-buffer (current-buffer)) 4134 (current-buffer)) 4135 (let* ((auto-save-p (and (not ignore-auto) 4136 (recent-auto-save-p) 4137 buffer-auto-save-file-name 4138 (file-readable-p buffer-auto-save-file-name) 4139 (y-or-n-p 4140 "Buffer has been auto-saved recently. Revert from auto-save file? "))) 4141 (file-name (if auto-save-p 4142 buffer-auto-save-file-name 4143 buffer-file-name))) 4144 (cond ((null file-name) 4145 (error "Buffer does not seem to be associated with any file")) 4146 ((or noconfirm 4147 (and (not (buffer-modified-p)) 4148 (catch 'found 4149 (dolist (regexp revert-without-query) 4150 (when (string-match regexp file-name) 4151 (throw 'found t))))) 4152 (yes-or-no-p (format "Revert buffer from file %s? " 4153 file-name))) 4154 (run-hooks 'before-revert-hook) 4155 ;; If file was backed up but has changed since, 4156 ;; we shd make another backup. 4157 (and (not auto-save-p) 4158 (not (verify-visited-file-modtime (current-buffer))) 4159 (setq buffer-backed-up nil)) 4160 ;; Effectively copy the after-revert-hook status, 4161 ;; since after-find-file will clobber it. 4162 (let ((global-hook (default-value 'after-revert-hook)) 4163 (local-hook (when (local-variable-p 'after-revert-hook) 4164 after-revert-hook)) 4165 (inhibit-read-only t)) 4166 (cond 4167 (revert-buffer-insert-file-contents-function 4168 (unless (eq buffer-undo-list t) 4169 ;; Get rid of all undo records for this buffer. 4170 (setq buffer-undo-list nil)) 4171 ;; Don't make undo records for the reversion. 4172 (let ((buffer-undo-list t)) 4173 (funcall revert-buffer-insert-file-contents-function 4174 file-name auto-save-p))) 4175 ((not (file-exists-p file-name)) 4176 (error (if buffer-file-number 4177 "File %s no longer exists!" 4178 "Cannot revert nonexistent file %s") 4179 file-name)) 4180 ((not (file-readable-p file-name)) 4181 (error (if buffer-file-number 4182 "File %s no longer readable!" 4183 "Cannot revert unreadable file %s") 4184 file-name)) 4185 (t 4186 ;; Bind buffer-file-name to nil 4187 ;; so that we don't try to lock the file. 4188 (let ((buffer-file-name nil)) 4189 (or auto-save-p 4190 (unlock-buffer))) 4191 (widen) 4192 (let ((coding-system-for-read 4193 ;; Auto-saved file should be read by Emacs' 4194 ;; internal coding. 4195 (if auto-save-p 'auto-save-coding 4196 (or coding-system-for-read 4197 buffer-file-coding-system-explicit)))) 4198 (if (and (not enable-multibyte-characters) 4199 coding-system-for-read 4200 (not (memq (coding-system-base 4201 coding-system-for-read) 4202 '(no-conversion raw-text)))) 4203 ;; As a coding system suitable for multibyte 4204 ;; buffer is specified, make the current 4205 ;; buffer multibyte. 4206 (set-buffer-multibyte t)) 4207 4208 ;; This force after-insert-file-set-coding 4209 ;; (called from insert-file-contents) to set 4210 ;; buffer-file-coding-system to a proper value. 4211 (kill-local-variable 'buffer-file-coding-system) 4212 4213 ;; Note that this preserves point in an intelligent way. 4214 (if preserve-modes 4215 (let ((buffer-file-format buffer-file-format)) 4216 (insert-file-contents file-name (not auto-save-p) 4217 nil nil t)) 4218 (insert-file-contents file-name (not auto-save-p) 4219 nil nil t))))) 4220 ;; Recompute the truename in case changes in symlinks 4221 ;; have changed the truename. 4222 (setq buffer-file-truename 4223 (abbreviate-file-name (file-truename buffer-file-name))) 4224 (after-find-file nil nil t t preserve-modes) 4225 ;; Run after-revert-hook as it was before we reverted. 4226 (setq-default revert-buffer-internal-hook global-hook) 4227 (if local-hook 4228 (set (make-local-variable 'revert-buffer-internal-hook) 4229 local-hook) 4230 (kill-local-variable 'revert-buffer-internal-hook)) 4231 (run-hooks 'revert-buffer-internal-hook)) 4232 t)))))) 4233 4234(defun recover-this-file () 4235 "Recover the visited file--get contents from its last auto-save file." 4236 (interactive) 4237 (recover-file buffer-file-name)) 4238 4239(defun recover-file (file) 4240 "Visit file FILE, but get contents from its last auto-save file." 4241 ;; Actually putting the file name in the minibuffer should be used 4242 ;; only rarely. 4243 ;; Not just because users often use the default. 4244 (interactive "FRecover file: ") 4245 (setq file (expand-file-name file)) 4246 (if (auto-save-file-name-p (file-name-nondirectory file)) 4247 (error "%s is an auto-save file" (abbreviate-file-name file))) 4248 (let ((file-name (let ((buffer-file-name file)) 4249 (make-auto-save-file-name)))) 4250 (cond ((if (file-exists-p file) 4251 (not (file-newer-than-file-p file-name file)) 4252 (not (file-exists-p file-name))) 4253 (error "Auto-save file %s not current" 4254 (abbreviate-file-name file-name))) 4255 ((save-window-excursion 4256 (with-output-to-temp-buffer "*Directory*" 4257 (buffer-disable-undo standard-output) 4258 (save-excursion 4259 (let ((switches dired-listing-switches)) 4260 (if (file-symlink-p file) 4261 (setq switches (concat switches "L"))) 4262 (set-buffer standard-output) 4263 ;; Use insert-directory-safely, not insert-directory, 4264 ;; because these files might not exist. In particular, 4265 ;; FILE might not exist if the auto-save file was for 4266 ;; a buffer that didn't visit a file, such as "*mail*". 4267 ;; The code in v20.x called `ls' directly, so we need 4268 ;; to emulate what `ls' did in that case. 4269 (insert-directory-safely file switches) 4270 (insert-directory-safely file-name switches)))) 4271 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 4272 (switch-to-buffer (find-file-noselect file t)) 4273 (let ((inhibit-read-only t) 4274 ;; Keep the current buffer-file-coding-system. 4275 (coding-system buffer-file-coding-system) 4276 ;; Auto-saved file should be read with special coding. 4277 (coding-system-for-read 'auto-save-coding)) 4278 (erase-buffer) 4279 (insert-file-contents file-name nil) 4280 (set-buffer-file-coding-system coding-system)) 4281 (after-find-file nil nil t)) 4282 (t (error "Recover-file cancelled"))))) 4283 4284(defun recover-session () 4285 "Recover auto save files from a previous Emacs session. 4286This command first displays a Dired buffer showing you the 4287previous sessions that you could recover from. 4288To choose one, move point to the proper line and then type C-c C-c. 4289Then you'll be asked about a number of files to recover." 4290 (interactive) 4291 (if (null auto-save-list-file-prefix) 4292 (error "You set `auto-save-list-file-prefix' to disable making session files")) 4293 (let ((dir (file-name-directory auto-save-list-file-prefix))) 4294 (unless (file-directory-p dir) 4295 (make-directory dir t)) 4296 (unless (directory-files dir nil 4297 (concat "\\`" (regexp-quote 4298 (file-name-nondirectory 4299 auto-save-list-file-prefix))) 4300 t) 4301 (error "No previous sessions to recover"))) 4302 (let ((ls-lisp-support-shell-wildcards t)) 4303 (dired (concat auto-save-list-file-prefix "*") 4304 (concat dired-listing-switches "t"))) 4305 (save-excursion 4306 (goto-char (point-min)) 4307 (or (looking-at " Move to the session you want to recover,") 4308 (let ((inhibit-read-only t)) 4309 ;; Each line starts with a space 4310 ;; so that Font Lock mode won't highlight the first character. 4311 (insert " Move to the session you want to recover,\n" 4312 " then type C-c C-c to select it.\n\n" 4313 " You can also delete some of these files;\n" 4314 " type d on a line to mark that file for deletion.\n\n")))) 4315 (use-local-map (nconc (make-sparse-keymap) (current-local-map))) 4316 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) 4317 4318(defun recover-session-finish () 4319 "Choose one saved session to recover auto-save files from. 4320This command is used in the special Dired buffer created by 4321\\[recover-session]." 4322 (interactive) 4323 ;; Get the name of the session file to recover from. 4324 (let ((file (dired-get-filename)) 4325 files 4326 (buffer (get-buffer-create " *recover*"))) 4327 (dired-unmark 1) 4328 (dired-do-flagged-delete t) 4329 (unwind-protect 4330 (save-excursion 4331 ;; Read in the auto-save-list file. 4332 (set-buffer buffer) 4333 (erase-buffer) 4334 (insert-file-contents file) 4335 ;; Loop thru the text of that file 4336 ;; and get out the names of the files to recover. 4337 (while (not (eobp)) 4338 (let (thisfile autofile) 4339 (if (eolp) 4340 ;; This is a pair of lines for a non-file-visiting buffer. 4341 ;; Get the auto-save file name and manufacture 4342 ;; a "visited file name" from that. 4343 (progn 4344 (forward-line 1) 4345 ;; If there is no auto-save file name, the 4346 ;; auto-save-list file is probably corrupted. 4347 (unless (eolp) 4348 (setq autofile 4349 (buffer-substring-no-properties 4350 (point) 4351 (line-end-position))) 4352 (setq thisfile 4353 (expand-file-name 4354 (substring 4355 (file-name-nondirectory autofile) 4356 1 -1) 4357 (file-name-directory autofile)))) 4358 (forward-line 1)) 4359 ;; This pair of lines is a file-visiting 4360 ;; buffer. Use the visited file name. 4361 (progn 4362 (setq thisfile 4363 (buffer-substring-no-properties 4364 (point) (progn (end-of-line) (point)))) 4365 (forward-line 1) 4366 (setq autofile 4367 (buffer-substring-no-properties 4368 (point) (progn (end-of-line) (point)))) 4369 (forward-line 1))) 4370 ;; Ignore a file if its auto-save file does not exist now. 4371 (if (and autofile (file-exists-p autofile)) 4372 (setq files (cons thisfile files))))) 4373 (setq files (nreverse files)) 4374 ;; The file contains a pair of line for each auto-saved buffer. 4375 ;; The first line of the pair contains the visited file name 4376 ;; or is empty if the buffer was not visiting a file. 4377 ;; The second line is the auto-save file name. 4378 (if files 4379 (map-y-or-n-p "Recover %s? " 4380 (lambda (file) 4381 (condition-case nil 4382 (save-excursion (recover-file file)) 4383 (error 4384 "Failed to recover `%s'" file))) 4385 files 4386 '("file" "files" "recover")) 4387 (message "No files can be recovered from this session now"))) 4388 (kill-buffer buffer)))) 4389 4390(defun kill-some-buffers (&optional list) 4391 "Kill some buffers. Asks the user whether to kill each one of them. 4392Non-interactively, if optional argument LIST is non-nil, it 4393specifies the list of buffers to kill, asking for approval for each one." 4394 (interactive) 4395 (if (null list) 4396 (setq list (buffer-list))) 4397 (while list 4398 (let* ((buffer (car list)) 4399 (name (buffer-name buffer))) 4400 (and name ; Can be nil for an indirect buffer 4401 ; if we killed the base buffer. 4402 (not (string-equal name "")) 4403 (/= (aref name 0) ?\s) 4404 (yes-or-no-p 4405 (format "Buffer %s %s. Kill? " 4406 name 4407 (if (buffer-modified-p buffer) 4408 "HAS BEEN EDITED" "is unmodified"))) 4409 (kill-buffer buffer))) 4410 (setq list (cdr list)))) 4411 4412(defun auto-save-mode (arg) 4413 "Toggle auto-saving of contents of current buffer. 4414With prefix argument ARG, turn auto-saving on if positive, else off." 4415 (interactive "P") 4416 (setq buffer-auto-save-file-name 4417 (and (if (null arg) 4418 (or (not buffer-auto-save-file-name) 4419 ;; If auto-save is off because buffer has shrunk, 4420 ;; then toggling should turn it on. 4421 (< buffer-saved-size 0)) 4422 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) 4423 (if (and buffer-file-name auto-save-visited-file-name 4424 (not buffer-read-only)) 4425 buffer-file-name 4426 (make-auto-save-file-name)))) 4427 ;; If -1 was stored here, to temporarily turn off saving, 4428 ;; turn it back on. 4429 (and (< buffer-saved-size 0) 4430 (setq buffer-saved-size 0)) 4431 (if (interactive-p) 4432 (message "Auto-save %s (in this buffer)" 4433 (if buffer-auto-save-file-name "on" "off"))) 4434 buffer-auto-save-file-name) 4435 4436(defun rename-auto-save-file () 4437 "Adjust current buffer's auto save file name for current conditions. 4438Also rename any existing auto save file, if it was made in this session." 4439 (let ((osave buffer-auto-save-file-name)) 4440 (setq buffer-auto-save-file-name 4441 (make-auto-save-file-name)) 4442 (if (and osave buffer-auto-save-file-name 4443 (not (string= buffer-auto-save-file-name buffer-file-name)) 4444 (not (string= buffer-auto-save-file-name osave)) 4445 (file-exists-p osave) 4446 (recent-auto-save-p)) 4447 (rename-file osave buffer-auto-save-file-name t)))) 4448 4449(defun make-auto-save-file-name () 4450 "Return file name to use for auto-saves of current buffer. 4451Does not consider `auto-save-visited-file-name' as that variable is checked 4452before calling this function. You can redefine this for customization. 4453See also `auto-save-file-name-p'." 4454 (if buffer-file-name 4455 (let ((handler (find-file-name-handler buffer-file-name 4456 'make-auto-save-file-name))) 4457 (if handler 4458 (funcall handler 'make-auto-save-file-name) 4459 (let ((list auto-save-file-name-transforms) 4460 (filename buffer-file-name) 4461 result uniq) 4462 ;; Apply user-specified translations 4463 ;; to the file name. 4464 (while (and list (not result)) 4465 (if (string-match (car (car list)) filename) 4466 (setq result (replace-match (cadr (car list)) t nil 4467 filename) 4468 uniq (car (cddr (car list))))) 4469 (setq list (cdr list))) 4470 (if result 4471 (if uniq 4472 (setq filename (concat 4473 (file-name-directory result) 4474 (subst-char-in-string 4475 ?/ ?! 4476 (replace-regexp-in-string "!" "!!" 4477 filename)))) 4478 (setq filename result))) 4479 (setq result 4480 (if (and (eq system-type 'ms-dos) 4481 (not (msdos-long-file-names))) 4482 ;; We truncate the file name to DOS 8+3 limits 4483 ;; before doing anything else, because the regexp 4484 ;; passed to string-match below cannot handle 4485 ;; extensions longer than 3 characters, multiple 4486 ;; dots, and other atrocities. 4487 (let ((fn (dos-8+3-filename 4488 (file-name-nondirectory buffer-file-name)))) 4489 (string-match 4490 "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" 4491 fn) 4492 (concat (file-name-directory buffer-file-name) 4493 "#" (match-string 1 fn) 4494 "." (match-string 3 fn) "#")) 4495 (concat (file-name-directory filename) 4496 "#" 4497 (file-name-nondirectory filename) 4498 "#"))) 4499 ;; Make sure auto-save file names don't contain characters 4500 ;; invalid for the underlying filesystem. 4501 (if (and (memq system-type '(ms-dos windows-nt cygwin)) 4502 ;; Don't modify remote (ange-ftp) filenames 4503 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) 4504 (convert-standard-filename result) 4505 result)))) 4506 4507 ;; Deal with buffers that don't have any associated files. (Mail 4508 ;; mode tends to create a good number of these.) 4509 4510 (let ((buffer-name (buffer-name)) 4511 (limit 0) 4512 file-name) 4513 ;; Eliminate all slashes and backslashes by 4514 ;; replacing them with sequences that start with %. 4515 ;; Quote % also, to keep distinct names distinct. 4516 (while (string-match "[/\\%]" buffer-name limit) 4517 (let* ((character (aref buffer-name (match-beginning 0))) 4518 (replacement 4519 (cond ((eq character ?%) "%%") 4520 ((eq character ?/) "%+") 4521 ((eq character ?\\) "%-")))) 4522 (setq buffer-name (replace-match replacement t t buffer-name)) 4523 (setq limit (1+ (match-end 0))))) 4524 ;; Generate the file name. 4525 (setq file-name 4526 (make-temp-file 4527 (let ((fname 4528 (expand-file-name 4529 (format "#%s#" buffer-name) 4530 ;; Try a few alternative directories, to get one we can 4531 ;; write it. 4532 (cond 4533 ((file-writable-p default-directory) default-directory) 4534 ((file-writable-p "/var/tmp/") "/var/tmp/") 4535 ("~/"))))) 4536 (if (and (memq system-type '(ms-dos windows-nt cygwin)) 4537 ;; Don't modify remote (ange-ftp) filenames 4538 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname))) 4539 ;; The call to convert-standard-filename is in case 4540 ;; buffer-name includes characters not allowed by the 4541 ;; DOS/Windows filesystems. make-temp-file writes to the 4542 ;; file it creates, so we must fix the file name _before_ 4543 ;; make-temp-file is called. 4544 (convert-standard-filename fname) 4545 fname)) 4546 nil "#")) 4547 ;; make-temp-file creates the file, 4548 ;; but we don't want it to exist until we do an auto-save. 4549 (condition-case () 4550 (delete-file file-name) 4551 (file-error nil)) 4552 file-name))) 4553 4554(defun auto-save-file-name-p (filename) 4555 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. 4556FILENAME should lack slashes. You can redefine this for customization." 4557 (string-match "^#.*#$" filename)) 4558 4559(defun wildcard-to-regexp (wildcard) 4560 "Given a shell file name pattern WILDCARD, return an equivalent regexp. 4561The generated regexp will match a filename iff the filename 4562matches that wildcard according to shell rules. Only wildcards known 4563by `sh' are supported." 4564 (let* ((i (string-match "[[.*+\\^$?]" wildcard)) 4565 ;; Copy the initial run of non-special characters. 4566 (result (substring wildcard 0 i)) 4567 (len (length wildcard))) 4568 ;; If no special characters, we're almost done. 4569 (if i 4570 (while (< i len) 4571 (let ((ch (aref wildcard i)) 4572 j) 4573 (setq 4574 result 4575 (concat result 4576 (cond 4577 ((and (eq ch ?\[) 4578 (< (1+ i) len) 4579 (eq (aref wildcard (1+ i)) ?\])) 4580 "\\[") 4581 ((eq ch ?\[) ; [...] maps to regexp char class 4582 (progn 4583 (setq i (1+ i)) 4584 (concat 4585 (cond 4586 ((eq (aref wildcard i) ?!) ; [!...] -> [^...] 4587 (progn 4588 (setq i (1+ i)) 4589 (if (eq (aref wildcard i) ?\]) 4590 (progn 4591 (setq i (1+ i)) 4592 "[^]") 4593 "[^"))) 4594 ((eq (aref wildcard i) ?^) 4595 ;; Found "[^". Insert a `\0' character 4596 ;; (which cannot happen in a filename) 4597 ;; into the character class, so that `^' 4598 ;; is not the first character after `[', 4599 ;; and thus non-special in a regexp. 4600 (progn 4601 (setq i (1+ i)) 4602 "[\000^")) 4603 ((eq (aref wildcard i) ?\]) 4604 ;; I don't think `]' can appear in a 4605 ;; character class in a wildcard, but 4606 ;; let's be general here. 4607 (progn 4608 (setq i (1+ i)) 4609 "[]")) 4610 (t "[")) 4611 (prog1 ; copy everything upto next `]'. 4612 (substring wildcard 4613 i 4614 (setq j (string-match 4615 "]" wildcard i))) 4616 (setq i (if j (1- j) (1- len))))))) 4617 ((eq ch ?.) "\\.") 4618 ((eq ch ?*) "[^\000]*") 4619 ((eq ch ?+) "\\+") 4620 ((eq ch ?^) "\\^") 4621 ((eq ch ?$) "\\$") 4622 ((eq ch ?\\) "\\\\") ; probably cannot happen... 4623 ((eq ch ??) "[^\000]") 4624 (t (char-to-string ch))))) 4625 (setq i (1+ i))))) 4626 ;; Shell wildcards should match the entire filename, 4627 ;; not its part. Make the regexp say so. 4628 (concat "\\`" result "\\'"))) 4629 4630(defcustom list-directory-brief-switches 4631 (if (eq system-type 'vax-vms) "" "-CF") 4632 "Switches for `list-directory' to pass to `ls' for brief listing." 4633 :type 'string 4634 :group 'dired) 4635 4636(defcustom list-directory-verbose-switches 4637 (if (eq system-type 'vax-vms) 4638 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" 4639 "-l") 4640 "Switches for `list-directory' to pass to `ls' for verbose listing." 4641 :type 'string 4642 :group 'dired) 4643 4644(defun file-expand-wildcards (pattern &optional full) 4645 "Expand wildcard pattern PATTERN. 4646This returns a list of file names which match the pattern. 4647 4648If PATTERN is written as an absolute file name, 4649the values are absolute also. 4650 4651If PATTERN is written as a relative file name, it is interpreted 4652relative to the current default directory, `default-directory'. 4653The file names returned are normally also relative to the current 4654default directory. However, if FULL is non-nil, they are absolute." 4655 (save-match-data 4656 (let* ((nondir (file-name-nondirectory pattern)) 4657 (dirpart (file-name-directory pattern)) 4658 ;; A list of all dirs that DIRPART specifies. 4659 ;; This can be more than one dir 4660 ;; if DIRPART contains wildcards. 4661 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 4662 (mapcar 'file-name-as-directory 4663 (file-expand-wildcards (directory-file-name dirpart))) 4664 (list dirpart))) 4665 contents) 4666 (while dirs 4667 (when (or (null (car dirs)) ; Possible if DIRPART is not wild. 4668 (file-directory-p (directory-file-name (car dirs)))) 4669 (let ((this-dir-contents 4670 ;; Filter out "." and ".." 4671 (delq nil 4672 (mapcar #'(lambda (name) 4673 (unless (string-match "\\`\\.\\.?\\'" 4674 (file-name-nondirectory name)) 4675 name)) 4676 (directory-files (or (car dirs) ".") full 4677 (wildcard-to-regexp nondir)))))) 4678 (setq contents 4679 (nconc 4680 (if (and (car dirs) (not full)) 4681 (mapcar (function (lambda (name) (concat (car dirs) name))) 4682 this-dir-contents) 4683 this-dir-contents) 4684 contents)))) 4685 (setq dirs (cdr dirs))) 4686 contents))) 4687 4688(defun list-directory (dirname &optional verbose) 4689 "Display a list of files in or matching DIRNAME, a la `ls'. 4690DIRNAME is globbed by the shell if necessary. 4691Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. 4692Actions controlled by variables `list-directory-brief-switches' 4693and `list-directory-verbose-switches'." 4694 (interactive (let ((pfx current-prefix-arg)) 4695 (list (read-file-name (if pfx "List directory (verbose): " 4696 "List directory (brief): ") 4697 nil default-directory nil) 4698 pfx))) 4699 (let ((switches (if verbose list-directory-verbose-switches 4700 list-directory-brief-switches)) 4701 buffer) 4702 (or dirname (setq dirname default-directory)) 4703 (setq dirname (expand-file-name dirname)) 4704 (with-output-to-temp-buffer "*Directory*" 4705 (setq buffer standard-output) 4706 (buffer-disable-undo standard-output) 4707 (princ "Directory ") 4708 (princ dirname) 4709 (terpri) 4710 (save-excursion 4711 (set-buffer "*Directory*") 4712 (let ((wildcard (not (file-directory-p dirname)))) 4713 (insert-directory dirname switches wildcard (not wildcard))))) 4714 ;; Finishing with-output-to-temp-buffer seems to clobber default-directory. 4715 (with-current-buffer buffer 4716 (setq default-directory 4717 (if (file-directory-p dirname) 4718 (file-name-as-directory dirname) 4719 (file-name-directory dirname)))))) 4720 4721(defun shell-quote-wildcard-pattern (pattern) 4722 "Quote characters special to the shell in PATTERN, leave wildcards alone. 4723 4724PATTERN is assumed to represent a file-name wildcard suitable for the 4725underlying filesystem. For Unix and GNU/Linux, the characters from the 4726set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all 4727the parts of the pattern which don't include wildcard characters are 4728quoted with double quotes. 4729Existing quote characters in PATTERN are left alone, so you can pass 4730PATTERN that already quotes some of the special characters." 4731 (save-match-data 4732 (cond 4733 ((memq system-type '(ms-dos windows-nt cygwin)) 4734 ;; DOS/Windows don't allow `"' in file names. So if the 4735 ;; argument has quotes, we can safely assume it is already 4736 ;; quoted by the caller. 4737 (if (or (string-match "[\"]" pattern) 4738 ;; We quote [&()#$'] in case their shell is a port of a 4739 ;; Unixy shell. We quote [,=+] because stock DOS and 4740 ;; Windows shells require that in some cases, such as 4741 ;; passing arguments to batch files that use positional 4742 ;; arguments like %1. 4743 (not (string-match "[ \t;&()#$',=+]" pattern))) 4744 pattern 4745 (let ((result "\"") 4746 (beg 0) 4747 end) 4748 (while (string-match "[*?]+" pattern beg) 4749 (setq end (match-beginning 0) 4750 result (concat result (substring pattern beg end) 4751 "\"" 4752 (substring pattern end (match-end 0)) 4753 "\"") 4754 beg (match-end 0))) 4755 (concat result (substring pattern beg) "\"")))) 4756 (t 4757 (let ((beg 0)) 4758 (while (string-match "[ \t\n;<>&|()#$]" pattern beg) 4759 (setq pattern 4760 (concat (substring pattern 0 (match-beginning 0)) 4761 "\\" 4762 (substring pattern (match-beginning 0))) 4763 beg (1+ (match-end 0))))) 4764 pattern)))) 4765 4766 4767(defvar insert-directory-program "ls" 4768 "Absolute or relative name of the `ls' program used by `insert-directory'.") 4769 4770(defcustom directory-free-space-program "df" 4771 "Program to get the amount of free space on a file system. 4772We assume the output has the format of `df'. 4773The value of this variable must be just a command name or file name; 4774if you want to specify options, use `directory-free-space-args'. 4775 4776A value of nil disables this feature. 4777 4778If the function `file-system-info' is defined, it is always used in 4779preference to the program given by this variable." 4780 :type '(choice (string :tag "Program") (const :tag "None" nil)) 4781 :group 'dired) 4782 4783(defcustom directory-free-space-args 4784 (if (eq system-type 'darwin) "-k" "-Pk") 4785 "Options to use when running `directory-free-space-program'." 4786 :type 'string 4787 :group 'dired) 4788 4789(defun get-free-disk-space (dir) 4790 "Return the amount of free space on directory DIR's file system. 4791The result is a string that gives the number of free 1KB blocks, 4792or nil if the system call or the program which retrieve the information 4793fail. It returns also nil when DIR is a remote directory. 4794 4795This function calls `file-system-info' if it is available, or invokes the 4796program specified by `directory-free-space-program' if that is non-nil." 4797 (when (not (file-remote-p dir)) 4798 ;; Try to find the number of free blocks. Non-Posix systems don't 4799 ;; always have df, but might have an equivalent system call. 4800 (if (fboundp 'file-system-info) 4801 (let ((fsinfo (file-system-info dir))) 4802 (if fsinfo 4803 (format "%.0f" (/ (nth 2 fsinfo) 1024)))) 4804 (save-match-data 4805 (with-temp-buffer 4806 (when (and directory-free-space-program 4807 (eq 0 (call-process directory-free-space-program 4808 nil t nil 4809 directory-free-space-args 4810 dir))) 4811 ;; Usual format is a header line followed by a line of 4812 ;; numbers. 4813 (goto-char (point-min)) 4814 (forward-line 1) 4815 (if (not (eobp)) 4816 (progn 4817 ;; Move to the end of the "available blocks" number. 4818 (skip-chars-forward "^ \t") 4819 (forward-word 3) 4820 ;; Copy it into AVAILABLE. 4821 (let ((end (point))) 4822 (forward-word -1) 4823 (buffer-substring (point) end)))))))))) 4824 4825;; The following expression replaces `dired-move-to-filename-regexp'. 4826(defvar directory-listing-before-filename-regexp 4827 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") 4828 (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)") 4829 ;; In some locales, month abbreviations are as short as 2 letters, 4830 ;; and they can be followed by ".". 4831 ;; In Breton, a month name can include a quote character. 4832 (month (concat l-or-quote l-or-quote "+\\.?")) 4833 (s " ") 4834 (yyyy "[0-9][0-9][0-9][0-9]") 4835 (dd "[ 0-3][0-9]") 4836 (HH:MM "[ 0-2][0-9][:.][0-5][0-9]") 4837 (seconds "[0-6][0-9]\\([.,][0-9]+\\)?") 4838 (zone "[-+][0-2][0-9][0-5][0-9]") 4839 (iso-mm-dd "[01][0-9]-[0-3][0-9]") 4840 (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?")) 4841 (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time 4842 "\\|" yyyy "-" iso-mm-dd "\\)")) 4843 (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)" 4844 s "+" 4845 "\\(" HH:MM "\\|" yyyy "\\)")) 4846 (western-comma (concat month s "+" dd "," s "+" yyyy)) 4847 ;; Japanese MS-Windows ls-lisp has one-digit months, and 4848 ;; omits the Kanji characters after month and day-of-month. 4849 ;; On Mac OS X 10.3, the date format in East Asian locales is 4850 ;; day-of-month digits followed by month digits. 4851 (mm "[ 0-1]?[0-9]") 4852 (east-asian 4853 (concat "\\(" mm l "?" s dd l "?" s "+" 4854 "\\|" dd s mm s "+" "\\)" 4855 "\\(" HH:MM "\\|" yyyy l "?" "\\)"))) 4856 ;; The "[0-9]" below requires the previous column to end in a digit. 4857 ;; This avoids recognizing `1 may 1997' as a date in the line: 4858 ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README 4859 4860 ;; The "[BkKMGTPEZY]?" below supports "ls -alh" output. 4861 ;; The ".*" below finds the last match if there are multiple matches. 4862 ;; This avoids recognizing `jservice 10 1024' as a date in the line: 4863 ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host 4864 4865 ;; vc dired listings provide the state or blanks between file 4866 ;; permissions and date. The state is always surrounded by 4867 ;; parantheses: 4868 ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el 4869 ;; This is not supported yet. 4870 (concat ".*[0-9][BkKMGTPEZY]?" s 4871 "\\(" western "\\|" western-comma "\\|" east-asian "\\|" iso "\\)" 4872 s "+")) 4873 "Regular expression to match up to the file name in a directory listing. 4874The default value is designed to recognize dates and times 4875regardless of the language.") 4876 4877(defvar insert-directory-ls-version 'unknown) 4878 4879;; insert-directory 4880;; - must insert _exactly_one_line_ describing FILE if WILDCARD and 4881;; FULL-DIRECTORY-P is nil. 4882;; The single line of output must display FILE's name as it was 4883;; given, namely, an absolute path name. 4884;; - must insert exactly one line for each file if WILDCARD or 4885;; FULL-DIRECTORY-P is t, plus one optional "total" line 4886;; before the file lines, plus optional text after the file lines. 4887;; Lines are delimited by "\n", so filenames containing "\n" are not 4888;; allowed. 4889;; File lines should display the basename. 4890;; - must be consistent with 4891;; - functions dired-move-to-filename, (these two define what a file line is) 4892;; dired-move-to-end-of-filename, 4893;; dired-between-files, (shortcut for (not (dired-move-to-filename))) 4894;; dired-insert-headerline 4895;; dired-after-subdir-garbage (defines what a "total" line is) 4896;; - variable dired-subdir-regexp 4897;; - may be passed "--dired" as the first argument in SWITCHES. 4898;; Filename handlers might have to remove this switch if their 4899;; "ls" command does not support it. 4900(defun insert-directory (file switches &optional wildcard full-directory-p) 4901 "Insert directory listing for FILE, formatted according to SWITCHES. 4902Leaves point after the inserted text. 4903SWITCHES may be a string of options, or a list of strings 4904representing individual options. 4905Optional third arg WILDCARD means treat FILE as shell wildcard. 4906Optional fourth arg FULL-DIRECTORY-P means file is a directory and 4907switches do not contain `d', so that a full listing is expected. 4908 4909This works by running a directory listing program 4910whose name is in the variable `insert-directory-program'. 4911If WILDCARD, it also runs the shell specified by `shell-file-name'. 4912 4913When SWITCHES contains the long `--dired' option, this function 4914treats it specially, for the sake of dired. However, the 4915normally equivalent short `-D' option is just passed on to 4916`insert-directory-program', as any other option." 4917 ;; We need the directory in order to find the right handler. 4918 (let ((handler (find-file-name-handler (expand-file-name file) 4919 'insert-directory))) 4920 (if handler 4921 (funcall handler 'insert-directory file switches 4922 wildcard full-directory-p) 4923 (if (eq system-type 'vax-vms) 4924 (vms-read-directory file switches (current-buffer)) 4925 (let (result (beg (point))) 4926 4927 ;; Read the actual directory using `insert-directory-program'. 4928 ;; RESULT gets the status code. 4929 (let* (;; We at first read by no-conversion, then after 4930 ;; putting text property `dired-filename, decode one 4931 ;; bunch by one to preserve that property. 4932 (coding-system-for-read 'no-conversion) 4933 ;; This is to control encoding the arguments in call-process. 4934 (coding-system-for-write 4935 (and enable-multibyte-characters 4936 (or file-name-coding-system 4937 default-file-name-coding-system)))) 4938 (setq result 4939 (if wildcard 4940 ;; Run ls in the directory part of the file pattern 4941 ;; using the last component as argument. 4942 (let ((default-directory 4943 (if (file-name-absolute-p file) 4944 (file-name-directory file) 4945 (file-name-directory (expand-file-name file)))) 4946 (pattern (file-name-nondirectory file))) 4947 (call-process 4948 shell-file-name nil t nil 4949 "-c" 4950 (concat (if (memq system-type '(ms-dos windows-nt)) 4951 "" 4952 "\\") ; Disregard Unix shell aliases! 4953 insert-directory-program 4954 " -d " 4955 (if (stringp switches) 4956 switches 4957 (mapconcat 'identity switches " ")) 4958 " -- " 4959 ;; Quote some characters that have 4960 ;; special meanings in shells; but 4961 ;; don't quote the wildcards--we want 4962 ;; them to be special. We also 4963 ;; currently don't quote the quoting 4964 ;; characters in case people want to 4965 ;; use them explicitly to quote 4966 ;; wildcard characters. 4967 (shell-quote-wildcard-pattern pattern)))) 4968 ;; SunOS 4.1.3, SVr4 and others need the "." to list the 4969 ;; directory if FILE is a symbolic link. 4970 (apply 'call-process 4971 insert-directory-program nil t nil 4972 (append 4973 (if (listp switches) switches 4974 (unless (equal switches "") 4975 ;; Split the switches at any spaces so we can 4976 ;; pass separate options as separate args. 4977 (split-string switches))) 4978 ;; Avoid lossage if FILE starts with `-'. 4979 '("--") 4980 (progn 4981 (if (string-match "\\`~" file) 4982 (setq file (expand-file-name file))) 4983 (list 4984 (if full-directory-p 4985 (concat (file-name-as-directory file) ".") 4986 file)))))))) 4987 4988 ;; If we got "//DIRED//" in the output, it means we got a real 4989 ;; directory listing, even if `ls' returned nonzero. 4990 ;; So ignore any errors. 4991 (when (if (stringp switches) 4992 (string-match "--dired\\>" switches) 4993 (member "--dired" switches)) 4994 (save-excursion 4995 (forward-line -2) 4996 (when (looking-at "//SUBDIRED//") 4997 (forward-line -1)) 4998 (if (looking-at "//DIRED//") 4999 (setq result 0)))) 5000 5001 (when (and (not (eq 0 result)) 5002 (eq insert-directory-ls-version 'unknown)) 5003 ;; The first time ls returns an error, 5004 ;; find the version numbers of ls, 5005 ;; and set insert-directory-ls-version 5006 ;; to > if it is more than 5.2.1, < if it is less, nil if it 5007 ;; is equal or if the info cannot be obtained. 5008 ;; (That can mean it isn't GNU ls.) 5009 (let ((version-out 5010 (with-temp-buffer 5011 (call-process "ls" nil t nil "--version") 5012 (buffer-string)))) 5013 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) 5014 (let* ((version (match-string 1 version-out)) 5015 (split (split-string version "[.]")) 5016 (numbers (mapcar 'string-to-number split)) 5017 (min '(5 2 1)) 5018 comparison) 5019 (while (and (not comparison) (or numbers min)) 5020 (cond ((null min) 5021 (setq comparison '>)) 5022 ((null numbers) 5023 (setq comparison '<)) 5024 ((> (car numbers) (car min)) 5025 (setq comparison '>)) 5026 ((< (car numbers) (car min)) 5027 (setq comparison '<)) 5028 (t 5029 (setq numbers (cdr numbers) 5030 min (cdr min))))) 5031 (setq insert-directory-ls-version (or comparison '=))) 5032 (setq insert-directory-ls-version nil)))) 5033 5034 ;; For GNU ls versions 5.2.2 and up, ignore minor errors. 5035 (when (and (eq 1 result) (eq insert-directory-ls-version '>)) 5036 (setq result 0)) 5037 5038 ;; If `insert-directory-program' failed, signal an error. 5039 (unless (eq 0 result) 5040 ;; Delete the error message it may have output. 5041 (delete-region beg (point)) 5042 ;; On non-Posix systems, we cannot open a directory, so 5043 ;; don't even try, because that will always result in 5044 ;; the ubiquitous "Access denied". Instead, show the 5045 ;; command line so the user can try to guess what went wrong. 5046 (if (and (file-directory-p file) 5047 (memq system-type '(ms-dos windows-nt))) 5048 (error 5049 "Reading directory: \"%s %s -- %s\" exited with status %s" 5050 insert-directory-program 5051 (if (listp switches) (concat switches) switches) 5052 file result) 5053 ;; Unix. Access the file to get a suitable error. 5054 (access-file file "Reading directory") 5055 (error "Listing directory failed but `access-file' worked"))) 5056 5057 (when (if (stringp switches) 5058 (string-match "--dired\\>" switches) 5059 (member "--dired" switches)) 5060 ;; The following overshoots by one line for an empty 5061 ;; directory listed with "--dired", but without "-a" 5062 ;; switch, where the ls output contains a 5063 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. 5064 ;; We take care of that case later. 5065 (forward-line -2) 5066 (when (looking-at "//SUBDIRED//") 5067 (delete-region (point) (progn (forward-line 1) (point))) 5068 (forward-line -1)) 5069 (if (looking-at "//DIRED//") 5070 (let ((end (line-end-position)) 5071 (linebeg (point)) 5072 error-lines) 5073 ;; Find all the lines that are error messages, 5074 ;; and record the bounds of each one. 5075 (goto-char beg) 5076 (while (< (point) linebeg) 5077 (or (eql (following-char) ?\s) 5078 (push (list (point) (line-end-position)) error-lines)) 5079 (forward-line 1)) 5080 (setq error-lines (nreverse error-lines)) 5081 ;; Now read the numeric positions of file names. 5082 (goto-char linebeg) 5083 (forward-word 1) 5084 (forward-char 3) 5085 (while (< (point) end) 5086 (let ((start (insert-directory-adj-pos 5087 (+ beg (read (current-buffer))) 5088 error-lines)) 5089 (end (insert-directory-adj-pos 5090 (+ beg (read (current-buffer))) 5091 error-lines))) 5092 (if (memq (char-after end) '(?\n ?\s)) 5093 ;; End is followed by \n or by " -> ". 5094 (put-text-property start end 'dired-filename t) 5095 ;; It seems that we can't trust ls's output as to 5096 ;; byte positions of filenames. 5097 (put-text-property beg (point) 'dired-filename nil) 5098 (end-of-line)))) 5099 (goto-char end) 5100 (beginning-of-line) 5101 (delete-region (point) (progn (forward-line 1) (point)))) 5102 ;; Take care of the case where the ls output contains a 5103 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line 5104 ;; and we went one line too far back (see above). 5105 (forward-line 1)) 5106 (if (looking-at "//DIRED-OPTIONS//") 5107 (delete-region (point) (progn (forward-line 1) (point))))) 5108 5109 ;; Now decode what read if necessary. 5110 (let ((coding (or coding-system-for-read 5111 file-name-coding-system 5112 default-file-name-coding-system 5113 'undecided)) 5114 coding-no-eol 5115 val pos) 5116 (when (and enable-multibyte-characters 5117 (not (memq (coding-system-base coding) 5118 '(raw-text no-conversion)))) 5119 ;; If no coding system is specified or detection is 5120 ;; requested, detect the coding. 5121 (if (eq (coding-system-base coding) 'undecided) 5122 (setq coding (detect-coding-region beg (point) t))) 5123 (if (not (eq (coding-system-base coding) 'undecided)) 5124 (save-restriction 5125 (setq coding-no-eol 5126 (coding-system-change-eol-conversion coding 'unix)) 5127 (narrow-to-region beg (point)) 5128 (goto-char (point-min)) 5129 (while (not (eobp)) 5130 (setq pos (point) 5131 val (get-text-property (point) 'dired-filename)) 5132 (goto-char (next-single-property-change 5133 (point) 'dired-filename nil (point-max))) 5134 ;; Force no eol conversion on a file name, so 5135 ;; that CR is preserved. 5136 (decode-coding-region pos (point) 5137 (if val coding-no-eol coding)) 5138 (if val 5139 (put-text-property pos (point) 5140 'dired-filename t))))))) 5141 5142 (if full-directory-p 5143 ;; Try to insert the amount of free space. 5144 (save-excursion 5145 (goto-char beg) 5146 ;; First find the line to put it on. 5147 (when (re-search-forward "^ *\\(total\\)" nil t) 5148 (let ((available (get-free-disk-space "."))) 5149 (when available 5150 ;; Replace "total" with "used", to avoid confusion. 5151 (replace-match "total used in directory" nil nil nil 1) 5152 (end-of-line) 5153 (insert " available " available))))))))))) 5154 5155(defun insert-directory-adj-pos (pos error-lines) 5156 "Convert `ls --dired' file name position value POS to a buffer position. 5157File name position values returned in ls --dired output 5158count only stdout; they don't count the error messages sent to stderr. 5159So this function converts to them to real buffer positions. 5160ERROR-LINES is a list of buffer positions of error message lines, 5161of the form (START END)." 5162 (while (and error-lines (< (caar error-lines) pos)) 5163 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) 5164 (pop error-lines)) 5165 pos) 5166 5167(defun insert-directory-safely (file switches 5168 &optional wildcard full-directory-p) 5169 "Insert directory listing for FILE, formatted according to SWITCHES. 5170 5171Like `insert-directory', but if FILE does not exist, it inserts a 5172message to that effect instead of signaling an error." 5173 (if (file-exists-p file) 5174 (insert-directory file switches wildcard full-directory-p) 5175 ;; Simulate the message printed by `ls'. 5176 (insert (format "%s: No such file or directory\n" file)))) 5177 5178(defvar kill-emacs-query-functions nil 5179 "Functions to call with no arguments to query about killing Emacs. 5180If any of these functions returns nil, killing Emacs is cancelled. 5181`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, 5182but `kill-emacs', the low level primitive, does not. 5183See also `kill-emacs-hook'.") 5184 5185(defcustom confirm-kill-emacs nil 5186 "How to ask for confirmation when leaving Emacs. 5187If nil, the default, don't ask at all. If the value is non-nil, it should 5188be a predicate function such as `yes-or-no-p'." 5189 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p) 5190 (const :tag "Ask with y-or-n-p" y-or-n-p) 5191 (const :tag "Don't confirm" nil)) 5192 :group 'convenience 5193 :version "21.1") 5194 5195(defun save-buffers-kill-emacs (&optional arg) 5196 "Offer to save each buffer, then kill this Emacs process. 5197With prefix arg, silently save all file-visiting buffers, then kill." 5198 (interactive "P") 5199 (save-some-buffers arg t) 5200 (and (or (not (memq t (mapcar (function 5201 (lambda (buf) (and (buffer-file-name buf) 5202 (buffer-modified-p buf)))) 5203 (buffer-list)))) 5204 (yes-or-no-p "Modified buffers exist; exit anyway? ")) 5205 (or (not (fboundp 'process-list)) 5206 ;; process-list is not defined on VMS. 5207 (let ((processes (process-list)) 5208 active) 5209 (while processes 5210 (and (memq (process-status (car processes)) '(run stop open listen)) 5211 (process-query-on-exit-flag (car processes)) 5212 (setq active t)) 5213 (setq processes (cdr processes))) 5214 (or (not active) 5215 (list-processes t) 5216 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) 5217 ;; Query the user for other things, perhaps. 5218 (run-hook-with-args-until-failure 'kill-emacs-query-functions) 5219 (or (null confirm-kill-emacs) 5220 (funcall confirm-kill-emacs "Really exit Emacs? ")) 5221 (kill-emacs))) 5222 5223;; We use /: as a prefix to "quote" a file name 5224;; so that magic file name handlers will not apply to it. 5225 5226(setq file-name-handler-alist 5227 (cons '("\\`/:" . file-name-non-special) 5228 file-name-handler-alist)) 5229 5230;; We depend on being the last handler on the list, 5231;; so that anything else which does need handling 5232;; has been handled already. 5233;; So it is safe for us to inhibit *all* magic file name handlers. 5234 5235(defun file-name-non-special (operation &rest arguments) 5236 (let ((file-name-handler-alist nil) 5237 (default-directory 5238 (if (eq operation 'insert-directory) 5239 (directory-file-name 5240 (expand-file-name 5241 (unhandled-file-name-directory default-directory))) 5242 default-directory)) 5243 ;; Get a list of the indices of the args which are file names. 5244 (file-arg-indices 5245 (cdr (or (assq operation 5246 ;; The first six are special because they 5247 ;; return a file name. We want to include the /: 5248 ;; in the return value. 5249 ;; So just avoid stripping it in the first place. 5250 '((expand-file-name . nil) 5251 (file-name-directory . nil) 5252 (file-name-as-directory . nil) 5253 (directory-file-name . nil) 5254 (file-name-sans-versions . nil) 5255 (find-backup-file-name . nil) 5256 ;; `identity' means just return the first arg 5257 ;; not stripped of its quoting. 5258 (substitute-in-file-name identity) 5259 ;; `add' means add "/:" to the result. 5260 (file-truename add 0) 5261 ;; `quote' means add "/:" to buffer-file-name. 5262 (insert-file-contents quote 0) 5263 ;; `unquote-then-quote' means set buffer-file-name 5264 ;; temporarily to unquoted filename. 5265 (verify-visited-file-modtime unquote-then-quote) 5266 ;; List the arguments which are filenames. 5267 (file-name-completion 1) 5268 (file-name-all-completions 1) 5269 (write-region 2 5) 5270 (rename-file 0 1) 5271 (copy-file 0 1) 5272 (make-symbolic-link 0 1) 5273 (add-name-to-file 0 1))) 5274 ;; For all other operations, treat the first argument only 5275 ;; as the file name. 5276 '(nil 0)))) 5277 method 5278 ;; Copy ARGUMENTS so we can replace elements in it. 5279 (arguments (copy-sequence arguments))) 5280 (if (symbolp (car file-arg-indices)) 5281 (setq method (pop file-arg-indices))) 5282 ;; Strip off the /: from the file names that have it. 5283 (save-match-data 5284 (while (consp file-arg-indices) 5285 (let ((pair (nthcdr (car file-arg-indices) arguments))) 5286 (and (car pair) 5287 (string-match "\\`/:" (car pair)) 5288 (setcar pair 5289 (if (= (length (car pair)) 2) 5290 "/" 5291 (substring (car pair) 2))))) 5292 (setq file-arg-indices (cdr file-arg-indices)))) 5293 (cond ((eq method 'identity) 5294 (car arguments)) 5295 ((eq method 'add) 5296 (concat "/:" (apply operation arguments))) 5297 ((eq method 'quote) 5298 (unwind-protect 5299 (apply operation arguments) 5300 (setq buffer-file-name (concat "/:" buffer-file-name)))) 5301 ((eq method 'unquote-then-quote) 5302 (let (res) 5303 (setq buffer-file-name (substring buffer-file-name 2)) 5304 (setq res (apply operation arguments)) 5305 (setq buffer-file-name (concat "/:" buffer-file-name)) 5306 res)) 5307 (t 5308 (apply operation arguments))))) 5309 5310(define-key ctl-x-map "\C-f" 'find-file) 5311(define-key ctl-x-map "\C-r" 'find-file-read-only) 5312(define-key ctl-x-map "\C-v" 'find-alternate-file) 5313(define-key ctl-x-map "\C-s" 'save-buffer) 5314(define-key ctl-x-map "s" 'save-some-buffers) 5315(define-key ctl-x-map "\C-w" 'write-file) 5316(define-key ctl-x-map "i" 'insert-file) 5317(define-key esc-map "~" 'not-modified) 5318(define-key ctl-x-map "\C-d" 'list-directory) 5319(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) 5320(define-key ctl-x-map "\C-q" 'toggle-read-only) 5321 5322(define-key ctl-x-4-map "f" 'find-file-other-window) 5323(define-key ctl-x-4-map "r" 'find-file-read-only-other-window) 5324(define-key ctl-x-4-map "\C-f" 'find-file-other-window) 5325(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) 5326(define-key ctl-x-4-map "\C-o" 'display-buffer) 5327 5328(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) 5329(define-key ctl-x-5-map "f" 'find-file-other-frame) 5330(define-key ctl-x-5-map "\C-f" 'find-file-other-frame) 5331(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) 5332(define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) 5333 5334;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f 5335;;; files.el ends here 5336