![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to files.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to files.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 ! root 1: ;; File input and output commands for Emacs ! 2: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: (defconst delete-auto-save-files t ! 23: "*Non-nil means delete a buffer's auto-save file ! 24: when the buffer is saved for real.") ! 25: ! 26: ;;; Turn off backup files on VMS since it has version numbers. ! 27: (defconst make-backup-files (not (eq system-type 'vax-vms)) ! 28: "*Create a backup of each file when it is saved for the first time. ! 29: This can be done by renaming the file or by copying. ! 30: ! 31: Renaming means that Emacs renames the existing file so that it is a ! 32: backup file, then writes the buffer into a new file. Any other names ! 33: that the old file had will now refer to the backup file. ! 34: The new file is owned by you and its group is defaulted. ! 35: ! 36: Copying means that Emacs copies the existing file into the backup file, ! 37: then writes the buffer on top of the existing file. Any other names ! 38: that the old file had will now refer to the new (edited) file. ! 39: The file's owner and group are unchanged. ! 40: ! 41: The choice of renaming or copying is controlled by the variables ! 42: backup-by-copying, backup-by-copying-when-linked and ! 43: backup-by-copying-when-mismatch.") ! 44: ! 45: (defconst backup-by-copying nil ! 46: "*Non-nil means always use copying to create backup files. ! 47: See documentation of variable make-backup-files.") ! 48: ! 49: (defconst backup-by-copying-when-linked nil ! 50: "*Non-nil means use copying to create backups for files with multiple names. ! 51: This causes the alternate names to refer to the latest version as edited. ! 52: This variable is relevant only if backup-by-copying is nil.") ! 53: ! 54: (defconst backup-by-copying-when-mismatch nil ! 55: "*Non-nil means create backups by copying if this preserves owner or group. ! 56: Renaming may still be used (subject to control of other variables) ! 57: when it would not result in changing the owner or group of the file; ! 58: that is, for files which are owned by you and whose group matches ! 59: the default for a new file created there by you. ! 60: This variable is relevant only if backup-by-copying is nil.") ! 61: ! 62: (defconst buffer-offer-save nil ! 63: "*Non-nil in a buffer means offer to save the buffer on exit ! 64: even if the buffer is not visiting a file. Automatically local in ! 65: all buffers.") ! 66: (make-variable-buffer-local 'buffer-offer-save) ! 67: ! 68: (defconst file-precious-flag nil ! 69: "*Non-nil means protect against I/O errors while saving files. ! 70: Some modes set this non-nil in particular buffers.") ! 71: ! 72: (defvar version-control nil ! 73: "*Control use of version numbers for backup files. ! 74: t means make numeric backup versions unconditionally. ! 75: nil means make them for files that have some already. ! 76: never means do not make them.") ! 77: ! 78: (defvar dired-kept-versions 2 ! 79: "*When cleaning directory, number of versions to keep.") ! 80: ! 81: (defvar trim-versions-without-asking nil ! 82: "*If true, deletes excess backup versions silently. ! 83: Otherwise asks confirmation.") ! 84: ! 85: (defvar kept-old-versions 2 ! 86: "*Number of oldest versions to keep when a new numbered backup is made.") ! 87: ! 88: (defvar kept-new-versions 2 ! 89: "*Number of newest versions to keep when a new numbered backup is made. ! 90: Includes the new backup. Must be > 0") ! 91: ! 92: (defconst require-final-newline nil ! 93: "*t says silently put a newline at the end whenever a file is saved. ! 94: Non-nil but not t says ask user whether to add a newline in each such case. ! 95: nil means don't add newlines.") ! 96: ! 97: (defconst auto-save-default t ! 98: "*t says by default do auto-saving of every file-visiting buffer.") ! 99: ! 100: (defconst auto-save-visited-file-name nil ! 101: "*t says auto-save a buffer in the file it is visiting, when practical. ! 102: Normally auto-save files are written under other names.") ! 103: ! 104: (defconst save-abbrevs nil ! 105: "*Non-nil means save word abbrevs too when files are saved. ! 106: Loading an abbrev file sets this to t.") ! 107: ! 108: (defconst find-file-run-dired t ! 109: "*Non-nil says run dired if find-file is given the name of a directory.") ! 110: ! 111: (defvar find-file-not-found-hooks nil ! 112: "List of functions to be called for find-file on nonexistent file. ! 113: These functions are called as soon as the error is detected. ! 114: buffer-file-name is already set up. ! 115: The functions are called in the order given, ! 116: until one of them returns non-nil.") ! 117: ! 118: (defvar find-file-hooks nil ! 119: "List of functions to be called after a buffer is loaded from a file. ! 120: The buffer's local variables (if any) will have been processed before the ! 121: functions are called.") ! 122: ! 123: (defvar write-file-hooks nil ! 124: "List of functions to be called before writing out a buffer to a file. ! 125: If one of them returns non-nil, the file is considered already written ! 126: and the rest are not called.") ! 127: ! 128: (defconst inhibit-local-variables nil ! 129: "*Non-nil means query before obeying a file's local-variables list. ! 130: This applies when the local-variables list is scanned automatically ! 131: after you find a file. If you explicitly request such a scan with ! 132: \\[normal-mode], there is no query, regardless of this variable.") ! 133: ! 134: ;; Avoid losing in versions where CLASH_DETECTION is disabled. ! 135: (or (fboundp 'lock-buffer) ! 136: (fset 'lock-buffer 'ignore)) ! 137: (or (fboundp 'unlock-buffer) ! 138: (fset 'unlock-buffer 'ignore)) ! 139: ! 140: (defun pwd () ! 141: "Show the current default directory." ! 142: (interactive nil) ! 143: (message "Directory %s" default-directory)) ! 144: ! 145: (defun cd (dir) ! 146: "Make DIR become the current buffer's default directory." ! 147: (interactive "DChange default directory: ") ! 148: (setq dir (expand-file-name dir)) ! 149: (if (not (eq system-type 'vax-vms)) ! 150: (setq dir (file-name-as-directory dir))) ! 151: (if (not (file-directory-p dir)) ! 152: (error "%s is not a directory" dir) ! 153: (setq default-directory dir)) ! 154: (pwd)) ! 155: ! 156: (defun load-file (file) ! 157: "Load the file FILE of Lisp code." ! 158: (interactive "fLoad file: ") ! 159: (load (expand-file-name file) nil nil t)) ! 160: ! 161: (defun load-library (library) ! 162: "Load the library named LIBRARY. ! 163: This is an interface to the function `load'." ! 164: (interactive "sLoad library: ") ! 165: (load library)) ! 166: ! 167: (defun switch-to-buffer-other-window (buffer) ! 168: "Select buffer BUFFER in another window." ! 169: (interactive "BSwitch to buffer in other window: ") ! 170: (let ((pop-up-windows t)) ! 171: (pop-to-buffer buffer t))) ! 172: ! 173: (defun find-file (filename) ! 174: "Edit file FILENAME. ! 175: Switch to a buffer visiting file FILENAME, ! 176: creating one if none already exists." ! 177: (interactive "FFind file: ") ! 178: (switch-to-buffer (find-file-noselect filename))) ! 179: ! 180: (defun find-file-other-window (filename) ! 181: "Edit file FILENAME, in another window. ! 182: May create a new window, or reuse an existing one; ! 183: see the function display-buffer." ! 184: (interactive "FFind file in other window: ") ! 185: (switch-to-buffer-other-window (find-file-noselect filename))) ! 186: ! 187: (defun find-file-read-only (filename) ! 188: "Edit file FILENAME but don't save without confirmation. ! 189: Like find-file but marks buffer as read-only." ! 190: (interactive "fFind file read-only: ") ! 191: (find-file filename) ! 192: (setq buffer-read-only t)) ! 193: ! 194: (defun find-alternate-file (filename) ! 195: "Find file FILENAME, select its buffer, kill previous buffer. ! 196: If the current buffer now contains an empty file that you just visited ! 197: \(presumably by mistake), use this command to visit the file you really want." ! 198: (interactive "FFind alternate file: ") ! 199: (and (buffer-modified-p) ! 200: (not buffer-read-only) ! 201: (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? " ! 202: (buffer-name)))) ! 203: (error "Aborted")) ! 204: (let ((obuf (current-buffer)) ! 205: (ofile buffer-file-name) ! 206: (oname (buffer-name))) ! 207: (rename-buffer " **lose**") ! 208: (setq buffer-file-name nil) ! 209: (unwind-protect ! 210: (progn ! 211: (unlock-buffer) ! 212: (find-file filename)) ! 213: (cond ((eq obuf (current-buffer)) ! 214: (setq buffer-file-name ofile) ! 215: (lock-buffer) ! 216: (rename-buffer oname)))) ! 217: (kill-buffer obuf))) ! 218: ! 219: (defun create-file-buffer (filename) ! 220: "Create a suitably named buffer for visiting FILENAME, and return it. ! 221: FILENAME (sans directory) is used unchanged if that name is free; ! 222: otherwise a string <2> or <3> or ... is appended to get an unused name." ! 223: (let ((lastname (file-name-nondirectory filename))) ! 224: (if (string= lastname "") ! 225: (setq lastname filename)) ! 226: (generate-new-buffer lastname))) ! 227: ! 228: (defun find-file-noselect (filename &optional nowarn) ! 229: "Read file FILENAME into a buffer and return the buffer. ! 230: If a buffer exists visiting FILENAME, return that one, ! 231: but verify that the file has not changed since visited or saved. ! 232: The buffer is not selected, just returned to the caller." ! 233: (setq filename (expand-file-name filename)) ! 234: (if (file-directory-p filename) ! 235: (if find-file-run-dired ! 236: (dired-noselect filename) ! 237: (error "%s is a directory." filename)) ! 238: (let ((buf (get-file-buffer filename)) ! 239: error) ! 240: (if buf ! 241: (or nowarn ! 242: (verify-visited-file-modtime buf) ! 243: (cond ((not (file-exists-p filename)) ! 244: (error "File %s no longer exists!" filename)) ! 245: ((yes-or-no-p ! 246: (if (buffer-modified-p buf) ! 247: "File has changed since last visited or saved. Flush your changes? " ! 248: "File has changed since last visited or saved. Read from disk? ")) ! 249: (save-excursion ! 250: (set-buffer buf) ! 251: (revert-buffer t t))))) ! 252: (save-excursion ! 253: (setq buf (create-file-buffer filename)) ! 254: (set-buffer buf) ! 255: (erase-buffer) ! 256: (condition-case () ! 257: (insert-file-contents filename t) ! 258: (file-error ! 259: (setq error t) ! 260: ;; Run find-file-not-found-hooks until one returns non-nil. ! 261: (let ((hooks find-file-not-found-hooks)) ! 262: (while (and hooks ! 263: (not (funcall (car hooks)))) ! 264: (setq hooks (cdr hooks)))))) ! 265: (setq default-directory (file-name-directory filename)) ! 266: (after-find-file error (not nowarn)))) ! 267: buf))) ! 268: ! 269: (defun after-find-file (&optional error warn) ! 270: "Called after finding a file and by the default revert function. ! 271: Sets buffer mode, parses local variables. ! 272: Optional args ERROR and WARN: ERROR non-nil means there was an ! 273: error in reading the file. WARN non-nil means warn if there ! 274: exists an auto-save file more recent than the visited file. ! 275: Finishes by calling the functions in find-file-hooks." ! 276: (setq buffer-read-only (not (file-writable-p buffer-file-name))) ! 277: (if noninteractive ! 278: nil ! 279: (let* (not-serious ! 280: (msg ! 281: (cond ((not buffer-read-only) ! 282: (if (and warn ! 283: (file-newer-than-file-p (make-auto-save-file-name) ! 284: buffer-file-name)) ! 285: "Auto save file is newer; consider M-x recover-file" ! 286: (setq not-serious t) ! 287: (if error "(New file)" nil))) ! 288: ((not error) ! 289: (setq not-serious t) ! 290: "File is write protected") ! 291: ((file-attributes buffer-file-name) ! 292: "File exists, but is read-protected.") ! 293: ((file-attributes (directory-file-name default-directory)) ! 294: "File not found and directory write-protected") ! 295: (t ! 296: "File not found and directory doesn't exist")))) ! 297: (if msg ! 298: (progn ! 299: (message msg) ! 300: (or not-serious (sit-for 1 t))))) ! 301: (if auto-save-default ! 302: (auto-save-mode t))) ! 303: (normal-mode t) ! 304: (mapcar 'funcall find-file-hooks)) ! 305: ! 306: (defun normal-mode (&optional find-file) ! 307: "Choose the major mode for this buffer automatically. ! 308: Also sets up any specified local variables of the file. ! 309: Uses the visited file name, the -*- line, and the local variables spec. ! 310: ! 311: This function is called automatically from `find-file'. In that case, ! 312: if `inhibit-local-variables' is non-`nil' we require confirmation before ! 313: processing a local variables spec. If you run `normal-mode' explicitly, ! 314: confirmation is never required." ! 315: (interactive) ! 316: (or find-file (funcall (or default-major-mode 'fundamental-mode))) ! 317: (condition-case err ! 318: (set-auto-mode) ! 319: (error (message "File mode specification error: %s" ! 320: (prin1-to-string err)))) ! 321: (condition-case err ! 322: (hack-local-variables (not find-file)) ! 323: (error (message "File local-variables error: %s" ! 324: (prin1-to-string err))))) ! 325: ! 326: ;(defvar auto-mode-alist ...) now in loaddefs.el ! 327: (defun set-auto-mode () ! 328: "Select major mode appropriate for current buffer. ! 329: May base decision on visited file name (See variable auto-mode-list) ! 330: or on buffer contents (-*- line or local variables spec), but does not look ! 331: for the \"mode:\" local variable. For that, use hack-local-variables." ! 332: ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- ! 333: (let (beg end mode) ! 334: (save-excursion ! 335: (goto-char (point-min)) ! 336: (skip-chars-forward " \t\n") ! 337: (if (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t) ! 338: (progn ! 339: (skip-chars-forward " \t") ! 340: (setq beg (point)) ! 341: (search-forward "-*-" (save-excursion (end-of-line) (point)) t)) ! 342: (progn ! 343: (forward-char -3) ! 344: (skip-chars-backward " \t") ! 345: (setq end (point)) ! 346: (goto-char beg) ! 347: (if (search-forward ":" end t) ! 348: (progn ! 349: (goto-char beg) ! 350: (if (let ((case-fold-search t)) ! 351: (search-forward "mode:" end t)) ! 352: (progn ! 353: (skip-chars-forward " \t") ! 354: (setq beg (point)) ! 355: (if (search-forward ";" end t) ! 356: (forward-char -1) ! 357: (goto-char end)) ! 358: (skip-chars-backward " \t") ! 359: (setq mode (buffer-substring beg (point)))))) ! 360: (setq mode (buffer-substring beg end))))) ! 361: (funcall (intern (concat (downcase mode) "-mode"))) ! 362: (let ((alist auto-mode-alist) ! 363: (name buffer-file-name)) ! 364: (let ((case-fold-search (eq system-type 'vax-vms))) ! 365: ;; Remove backup-suffixes from file name. ! 366: (setq name (file-name-sans-versions name)) ! 367: ;; Find first matching alist entry. ! 368: (while (and (not mode) alist) ! 369: (if (string-match (car (car alist)) name) ! 370: (setq mode (cdr (car alist)))) ! 371: (setq alist (cdr alist)))) ! 372: (if mode (funcall mode))))))) ! 373: ! 374: (defun hack-local-variables (&optional force) ! 375: "Parse, and bind or evaluate as appropriate, any local variables ! 376: for current buffer." ! 377: ;; Look for "Local variables:" line in last page. ! 378: (save-excursion ! 379: (goto-char (point-max)) ! 380: (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) ! 381: (if (let ((case-fold-search t)) ! 382: (and (search-forward "Local Variables:" nil t) ! 383: (or (not inhibit-local-variables) ! 384: force ! 385: (y-or-n-p (format"Set local variables as specified at end of %s? " ! 386: (file-name-nondirectory buffer-file-name)))))) ! 387: (let ((continue t) ! 388: prefix prefixlen suffix beg) ! 389: ;; The prefix is what comes before "local variables:" in its line. ! 390: ;; The suffix is what comes after "local variables:" in its line. ! 391: (skip-chars-forward " \t") ! 392: (or (eolp) ! 393: (setq suffix (buffer-substring (point) ! 394: (progn (end-of-line) (point))))) ! 395: (goto-char (match-beginning 0)) ! 396: (or (bolp) ! 397: (setq prefix ! 398: (buffer-substring (point) ! 399: (progn (beginning-of-line) (point))))) ! 400: (if prefix (setq prefixlen (length prefix) ! 401: prefix (regexp-quote prefix))) ! 402: (if suffix (setq suffix (regexp-quote suffix))) ! 403: (while continue ! 404: ;; Look at next local variable spec. ! 405: (if selective-display (re-search-forward "[\n\C-m]") ! 406: (forward-line 1)) ! 407: ;; Skip the prefix, if any. ! 408: (if prefix ! 409: (if (looking-at prefix) ! 410: (forward-char prefixlen) ! 411: (error "Local variables entry is missing the prefix"))) ! 412: ;; Find the variable name; strip whitespace. ! 413: (skip-chars-forward " \t") ! 414: (setq beg (point)) ! 415: (skip-chars-forward "^:\n") ! 416: (if (eolp) (error "Missing colon in local variables entry")) ! 417: (skip-chars-backward " \t") ! 418: (let* ((str (buffer-substring beg (point))) ! 419: (var (read str)) ! 420: val) ! 421: ;; Setting variable named "end" means end of list. ! 422: (if (string-equal (downcase str) "end") ! 423: (setq continue nil) ! 424: ;; Otherwise read the variable value. ! 425: (skip-chars-forward "^:") ! 426: (forward-char 1) ! 427: (setq val (read (current-buffer))) ! 428: (skip-chars-backward "\n") ! 429: (skip-chars-forward " \t") ! 430: (or (if suffix (looking-at suffix) (eolp)) ! 431: (error "Local variables entry is terminated incorrectly")) ! 432: ;; Set the variable. "Variables" mode and eval are funny. ! 433: (cond ((eq var 'mode) ! 434: (funcall (intern (concat (downcase (symbol-name val)) ! 435: "-mode")))) ! 436: ((eq var 'eval) ! 437: (if (string= (user-login-name) "root") ! 438: (message "Ignoring `eval:' in file's local variables") ! 439: (eval val))) ! 440: (t (make-local-variable var) ! 441: (set var val)))))))))) ! 442: ! 443: (defun set-visited-file-name (filename) ! 444: "Change name of file visited in current buffer to FILENAME. ! 445: The next time the buffer is saved it will go in the newly specified file. ! 446: nil or empty string as argument means make buffer not be visiting any file. ! 447: Remember to delete the initial contents of the minibuffer ! 448: if you wish to pass an empty string as the argument." ! 449: (interactive "FSet visited file name: ") ! 450: (if filename ! 451: (setq filename ! 452: (if (string-equal filename "") ! 453: nil ! 454: (expand-file-name filename)))) ! 455: (or (equal filename buffer-file-name) ! 456: (null filename) ! 457: (progn ! 458: (lock-buffer filename) ! 459: (unlock-buffer))) ! 460: (setq buffer-file-name filename) ! 461: (if filename ! 462: (let ((new-name (file-name-nondirectory buffer-file-name))) ! 463: (if (eq system-type 'vax-vms) ! 464: (setq new-name (downcase new-name))) ! 465: (setq default-directory (file-name-directory buffer-file-name)) ! 466: (or (get-buffer new-name) (rename-buffer new-name)))) ! 467: (setq buffer-backed-up nil) ! 468: (clear-visited-file-modtime) ! 469: (kill-local-variable 'write-file-hooks) ! 470: (kill-local-variable 'revert-buffer-function) ! 471: ;; Rename the auto-save file to go with the new visited name. ! 472: ;; If auto-save was not already on, turn it on if appropriate. ! 473: (if buffer-auto-save-file-name ! 474: (rename-auto-save-file) ! 475: (auto-save-mode (and buffer-file-name auto-save-default))) ! 476: (if buffer-file-name ! 477: (set-buffer-modified-p t))) ! 478: ! 479: (defun write-file (filename) ! 480: "Write current buffer into file FILENAME. ! 481: Makes buffer visit that file, and marks it not modified." ! 482: (interactive "FWrite file: ") ! 483: (or (null filename) (string-equal filename "") ! 484: (set-visited-file-name filename)) ! 485: (set-buffer-modified-p t) ! 486: (save-buffer)) ! 487: ! 488: (defun backup-buffer () ! 489: "Make a backup of the disk file visited by the current buffer, if appropriate. ! 490: This is normally done before saving the buffer the first time. ! 491: If the value is non-nil, it is the result of `file-modes' on the original file; ! 492: this means that the caller, after saving the buffer, should change the modes ! 493: of the new file to agree with the old modes." ! 494: (and make-backup-files ! 495: (not buffer-backed-up) ! 496: (file-exists-p buffer-file-name) ! 497: (memq (aref (elt (file-attributes buffer-file-name) 8) 0) ! 498: '(?- ?l)) ! 499: (or (< (length buffer-file-name) 5) ! 500: (not (string-equal "/tmp/" (substring buffer-file-name 0 5)))) ! 501: (condition-case () ! 502: (let* ((backup-info (find-backup-file-name buffer-file-name)) ! 503: (backupname (car backup-info)) ! 504: (targets (cdr backup-info)) ! 505: setmodes) ! 506: ; (if (file-directory-p buffer-file-name) ! 507: ; (error "Cannot save buffer in directory %s" buffer-file-name)) ! 508: (condition-case () ! 509: (if (or file-precious-flag ! 510: (file-symlink-p buffer-file-name) ! 511: backup-by-copying ! 512: (and backup-by-copying-when-linked ! 513: (> (file-nlinks buffer-file-name) 1)) ! 514: (and backup-by-copying-when-mismatch ! 515: (let ((attr (file-attributes buffer-file-name))) ! 516: (or (nth 9 attr) ! 517: (/= (nth 2 attr) (user-uid)))))) ! 518: (copy-file buffer-file-name backupname t t) ! 519: (condition-case () ! 520: (delete-file backupname) ! 521: (file-error nil)) ! 522: (rename-file buffer-file-name backupname t) ! 523: (setq setmodes (file-modes backupname))) ! 524: (file-error ! 525: ;; If trouble writing the backup, write it in ~. ! 526: (setq backupname (expand-file-name "~/%backup%~")) ! 527: (message "Cannot write backup file; backing up in ~/%%backup%%~") ! 528: (sleep-for 1) ! 529: (copy-file buffer-file-name backupname t t))) ! 530: (setq buffer-backed-up t) ! 531: (if (and targets ! 532: (or trim-versions-without-asking ! 533: (y-or-n-p (format "Delete excess backup versions of %s? " ! 534: buffer-file-name)))) ! 535: (while targets ! 536: (condition-case () ! 537: (delete-file (car targets)) ! 538: (file-error nil)) ! 539: (setq targets (cdr targets)))) ! 540: setmodes) ! 541: (file-error nil)))) ! 542: ! 543: (defun file-name-sans-versions (name) ! 544: "Return FILENAME sans backup versions or strings. ! 545: This is a separate procedure so your site-init or startup file can ! 546: redefine it." ! 547: (substring name 0 ! 548: (if (eq system-type 'vax-vms) ! 549: (or (string-match ";[0-9]+\\'" name) ! 550: (string-match ".[0-9]+\\'" name) ! 551: (length name)) ! 552: (or (string-match "\\.~[0-9]+~\\'" name) ! 553: (string-match "~\\'" name) ! 554: (length name))))) ! 555: ! 556: (defun make-backup-file-name (file) ! 557: "Create the non-numeric backup file name for FILE. ! 558: This is a separate function so you can redefine it for customization." ! 559: (concat file "~")) ! 560: ! 561: (defun backup-file-name-p (file) ! 562: "Return non-nil if FILE is a backup file name (numeric or not). ! 563: This is a separate function so you can redefine it for customization. ! 564: You may need to redefine file-name-sans-versions as well." ! 565: (string-match "~$" file)) ! 566: ! 567: ;; I believe there is no need to alter this behavior for VMS; ! 568: ;; since backup files are not made on VMS, it should not get called. ! 569: (defun find-backup-file-name (fn) ! 570: "Find a file name for a backup file, and suggestions for deletions. ! 571: Value is a list whose car is the name for the backup file ! 572: and whose cdr is a list of old versions to consider deleting now." ! 573: (if (eq version-control 'never) ! 574: (list (make-backup-file-name fn)) ! 575: (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) ! 576: (bv-length (length base-versions)) ! 577: (possibilities (file-name-all-completions ! 578: base-versions ! 579: (file-name-directory fn))) ! 580: (versions (sort (mapcar 'backup-extract-version possibilities) ! 581: '<)) ! 582: (high-water-mark (apply 'max (cons 0 versions))) ! 583: (deserve-versions-p ! 584: (or version-control ! 585: (> high-water-mark 0))) ! 586: (number-to-delete (- (length versions) ! 587: kept-old-versions kept-new-versions -1))) ! 588: (if (not deserve-versions-p) ! 589: (list (make-backup-file-name fn)) ! 590: (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") ! 591: (if (> number-to-delete 0) ! 592: (mapcar (function (lambda (n) ! 593: (concat fn ".~" (int-to-string n) "~"))) ! 594: (let ((v (nthcdr kept-old-versions versions))) ! 595: (rplacd (nthcdr (1- number-to-delete) v) ()) ! 596: v)))))))) ! 597: ! 598: (defun backup-extract-version (fn) ! 599: (if (and (string-match "[0-9]+~$" fn bv-length) ! 600: (= (match-beginning 0) bv-length)) ! 601: (string-to-int (substring fn bv-length -1)) ! 602: 0)) ! 603: ! 604: (defun file-nlinks (filename) ! 605: "Return number of names file FILENAME has." ! 606: (car (cdr (file-attributes filename)))) ! 607: ! 608: (defun save-buffer (&optional args) ! 609: "Save current buffer in visited file if modified. Versions described below. ! 610: ! 611: By default, makes the previous version into a backup file ! 612: if previously requested or if this is the first save. ! 613: With 1 or 3 \\[universal-argument]'s, marks this version ! 614: to become a backup when the next save is done. ! 615: With 2 or 3 \\[universal-argument]'s, ! 616: unconditionally makes the previous version into a backup file. ! 617: With argument of 0, never makes the previous version into a backup file. ! 618: ! 619: If a file's name is FOO, the names of its numbered backup versions are ! 620: FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. ! 621: Numeric backups (rather than FOO~) will be made if value of ! 622: `version-control' is not the atom `never' and either there are already ! 623: numeric versions of the file being backed up, or `version-control' is ! 624: non-nil. ! 625: We don't want excessive versions piling up, so there are variables ! 626: `kept-old-versions', which tells Emacs how many oldest versions to keep, ! 627: and `kept-new-versions', which tells how many newest versions to keep. ! 628: Defaults are 2 old versions and 2 new. ! 629: `dired-kept-versions' controls dired's clean-directory (.) command. ! 630: If `trim-versions-without-asking' is nil, system will query user ! 631: before trimming versions. Otherwise it does it silently." ! 632: (interactive "p") ! 633: (let ((modp (buffer-modified-p)) ! 634: (large (> (buffer-size) 50000)) ! 635: (make-backup-files (and make-backup-files (not (eq args 0))))) ! 636: (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) ! 637: (if (and modp large) (message "Saving file %s..." (buffer-file-name))) ! 638: (basic-save-buffer) ! 639: (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) ! 640: ! 641: (defun delete-auto-save-file-if-necessary () ! 642: "Delete the auto-save filename for the current buffer (if it has one) ! 643: if variable delete-auto-save-files is non-nil." ! 644: (and buffer-auto-save-file-name delete-auto-save-files ! 645: (progn ! 646: (condition-case () ! 647: (delete-file buffer-auto-save-file-name) ! 648: (file-error nil)) ! 649: (set-buffer-auto-saved)))) ! 650: ! 651: (defun basic-save-buffer () ! 652: "Save the current buffer in its visited file, if it has been modified." ! 653: (interactive) ! 654: (if (buffer-modified-p) ! 655: (let (setmodes tempsetmodes) ! 656: (or buffer-file-name ! 657: (progn ! 658: (setq buffer-file-name ! 659: (expand-file-name (read-file-name "File to save in: ") nil) ! 660: default-directory (file-name-directory buffer-file-name)) ! 661: (auto-save-mode auto-save-default))) ! 662: (if (not (file-writable-p buffer-file-name)) ! 663: (if (yes-or-no-p ! 664: (format "File %s is write-protected; try to save anyway? " ! 665: (file-name-nondirectory buffer-file-name))) ! 666: (setq tempsetmodes t) ! 667: (error ! 668: "Attempt to save to a file which you aren't allowed to write"))) ! 669: (or (verify-visited-file-modtime (current-buffer)) ! 670: (not (file-exists-p buffer-file-name)) ! 671: (yes-or-no-p ! 672: "Disk file has changed since visited or saved. Save anyway? ") ! 673: (error "Save not confirmed")) ! 674: (or buffer-backed-up ! 675: (setq setmodes (backup-buffer))) ! 676: (save-restriction ! 677: (widen) ! 678: (and (> (point-max) 1) ! 679: (/= (char-after (1- (point-max))) ?\n) ! 680: (or (eq require-final-newline t) ! 681: (and require-final-newline ! 682: (yes-or-no-p ! 683: (format "Buffer %s does not end in newline. Add one? " ! 684: (buffer-name))))) ! 685: (save-excursion ! 686: (goto-char (point-max)) ! 687: (insert ?\n))) ! 688: (let ((hooks write-file-hooks) ! 689: (done nil)) ! 690: (while (and hooks ! 691: (not (setq done (funcall (car hooks))))) ! 692: (setq hooks (cdr hooks))) ! 693: ;; If a hook returned t, file is already "written". ! 694: (cond ((not done) ! 695: (if file-precious-flag ! 696: ;; If file is precious, rename it away before ! 697: ;; overwriting it. ! 698: (let ((rename t) nodelete ! 699: (file (concat buffer-file-name "#"))) ! 700: (condition-case () ! 701: (progn (rename-file buffer-file-name file t) ! 702: (setq setmodes (file-modes file))) ! 703: (file-error (setq rename nil nodelete t))) ! 704: (unwind-protect ! 705: (progn (clear-visited-file-modtime) ! 706: (write-region (point-min) (point-max) ! 707: buffer-file-name nil t) ! 708: (setq rename nil)) ! 709: ;; If rename is still t, writing failed. ! 710: ;; So rename the old file back to original name, ! 711: (if rename ! 712: (progn ! 713: (rename-file file buffer-file-name t) ! 714: (clear-visited-file-modtime)) ! 715: ;; Otherwise we don't need the original file, ! 716: ;; so flush it. Unless we already lost it. ! 717: (or nodelete ! 718: (condition-case () ! 719: (delete-file file) ! 720: (error nil)))))) ! 721: ;; If file not writable, see if we can make it writable ! 722: ;; temporarily while we write it. ! 723: ;; But no need to do so if we have just backed it up ! 724: ;; (setmodes is set) because that says we're superseding. ! 725: (cond ((and tempsetmodes (not setmodes)) ! 726: ;; Change the mode back, after writing. ! 727: (setq setmodes (file-modes buffer-file-name)) ! 728: (set-file-modes buffer-file-name 511))) ! 729: (write-region (point-min) (point-max) ! 730: buffer-file-name nil t))))) ! 731: (if setmodes ! 732: (condition-case () ! 733: (set-file-modes buffer-file-name setmodes) ! 734: (error nil)))) ! 735: (delete-auto-save-file-if-necessary)) ! 736: (message "(No changes need to be saved)"))) ! 737: ! 738: (defun save-some-buffers (&optional arg exiting) ! 739: "Save some modified file-visiting buffers. Asks user about each one. ! 740: With argument, saves all with no questions." ! 741: (interactive "P") ! 742: (let (considered (list (buffer-list))) ! 743: (while list ! 744: (let ((buffer (car list))) ! 745: (and (buffer-modified-p buffer) ! 746: (save-excursion ! 747: (set-buffer buffer) ! 748: (and ! 749: (or buffer-file-name ! 750: (and exiting buffer-offer-save (> (buffer-size) 0))) ! 751: (setq considered t) ! 752: (or arg ! 753: (y-or-n-p (if buffer-file-name ! 754: (format "Save file %s? " ! 755: buffer-file-name) ! 756: (format "Save buffer %s? " (buffer-name))))) ! 757: (condition-case () ! 758: (save-buffer) ! 759: (error nil)))))) ! 760: (setq list (cdr list))) ! 761: (and save-abbrevs abbrevs-changed ! 762: (progn ! 763: (setq considered t) ! 764: (if (or arg ! 765: (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) ! 766: (write-abbrev-file nil)) ! 767: ;; Don't keep bothering user if he says no. ! 768: (setq abbrevs-changed nil))) ! 769: (if considered ! 770: (message "") ! 771: (message "(No files need saving)")))) ! 772: ! 773: (defun not-modified () ! 774: "Mark current buffer as unmodified, not needing to be saved." ! 775: (interactive) ! 776: (message "Modification-flag cleared") ! 777: (set-buffer-modified-p nil)) ! 778: ! 779: (defun toggle-read-only () ! 780: "Change whether this buffer is visiting its file read-only." ! 781: (interactive) ! 782: (setq buffer-read-only (not buffer-read-only)) ! 783: ;; Force mode-line redisplay ! 784: (set-buffer-modified-p (buffer-modified-p))) ! 785: ! 786: (defun insert-file (filename) ! 787: "Insert contents of file FILENAME into buffer after point. ! 788: Set mark after the inserted text." ! 789: (interactive "fInsert file: ") ! 790: (let ((tem (insert-file-contents filename))) ! 791: (push-mark (+ (point) (car (cdr tem)))))) ! 792: ! 793: (defun append-to-file (start end filename) ! 794: "Append the contents of the region to the end of file FILENAME. ! 795: When called from a function, expects three arguments, ! 796: START, END and FILENAME. START and END are buffer positions ! 797: saying what text to write." ! 798: (interactive "r\nFAppend to file: ") ! 799: (write-region start end filename t)) ! 800: ! 801: (defvar revert-buffer-function nil ! 802: "Function to use to revert this buffer, or nil to do the default.") ! 803: ! 804: (defun revert-buffer (&optional arg noconfirm) ! 805: "Replace the buffer text with the text of the visited file on disk. ! 806: This undoes all changes since the file was visited or saved. ! 807: If latest auto-save file is more recent than the visited file, ! 808: asks user whether to use that instead. ! 809: First argument (optional) non-nil means don't offer to use auto-save file. ! 810: This is the prefix arg when called interactively. ! 811: ! 812: Second argument (optional) non-nil means don't ask for confirmation at all. ! 813: ! 814: If revert-buffer-function's value is non-nil, it is called to do the work." ! 815: (interactive "P") ! 816: (if revert-buffer-function ! 817: (funcall revert-buffer-function arg noconfirm) ! 818: (let* ((opoint (point)) ! 819: (auto-save-p (and (null arg) (recent-auto-save-p) ! 820: buffer-auto-save-file-name ! 821: (file-readable-p buffer-auto-save-file-name) ! 822: (y-or-n-p ! 823: "Buffer has been auto-saved recently. Revert from auto-save file? "))) ! 824: (file-name (if auto-save-p ! 825: buffer-auto-save-file-name ! 826: buffer-file-name))) ! 827: (cond ((null file-name) ! 828: (error "Buffer does not seem to be associated with any file")) ! 829: ((not (file-exists-p file-name)) ! 830: (error "File %s no longer exists!" file-name)) ! 831: ((or noconfirm ! 832: (yes-or-no-p (format "Revert buffer from file %s? " ! 833: file-name))) ! 834: (let ((buffer-read-only nil)) ! 835: ;; Bind buffer-file-name to nil ! 836: ;; so that we don't try to lock the file. ! 837: (let ((buffer-file-name nil)) ! 838: (or auto-save-p ! 839: (unlock-buffer)) ! 840: (erase-buffer)) ! 841: (insert-file-contents file-name (not auto-save-p))) ! 842: (goto-char (min opoint (point-max))) ! 843: (after-find-file nil) ! 844: t))))) ! 845: ! 846: (defun recover-file (file) ! 847: "Visit file FILE, but get contents from its last auto-save file." ! 848: (interactive "FRecover file: ") ! 849: (setq file (expand-file-name file)) ! 850: (if (auto-save-file-name-p file) (error "%s is an auto-save file" file)) ! 851: (let ((file-name (let ((buffer-file-name file)) ! 852: (make-auto-save-file-name)))) ! 853: (cond ((not (file-newer-than-file-p file-name file)) ! 854: (error "Auto-save file %s not current" file-name)) ! 855: ((save-window-excursion ! 856: (if (not (eq system-type 'vax-vms)) ! 857: (with-output-to-temp-buffer "*Directory*" ! 858: (buffer-flush-undo standard-output) ! 859: (call-process "ls" nil standard-output nil ! 860: "-l" file file-name))) ! 861: (yes-or-no-p (format "Recover auto save file %s? " file-name))) ! 862: (switch-to-buffer (find-file-noselect file t)) ! 863: (let ((buffer-read-only nil)) ! 864: (erase-buffer) ! 865: (insert-file-contents file-name nil)) ! 866: (after-find-file nil)) ! 867: (t (error "Recover-file cancelled.")))) ! 868: (setq buffer-auto-save-file-name nil) ! 869: (message "Auto-save off in this buffer till you do M-x auto-save-mode.")) ! 870: ! 871: (defun kill-some-buffers () ! 872: "For each buffer, ask whether to kill it." ! 873: (interactive) ! 874: (let ((list (buffer-list))) ! 875: (while list ! 876: (let* ((buffer (car list)) ! 877: (name (buffer-name buffer))) ! 878: (and (not (string-equal name "")) ! 879: (/= (aref name 0) ? ) ! 880: (yes-or-no-p ! 881: (format "Buffer %s %s. Kill? " ! 882: name ! 883: (if (buffer-modified-p buffer) ! 884: "HAS BEEN EDITED" "is unmodified"))) ! 885: (kill-buffer buffer))) ! 886: (setq list (cdr list))))) ! 887: ! 888: (defun auto-save-mode (arg) ! 889: "Toggle auto-saving of contents of current buffer. ! 890: With arg, turn auto-saving on if arg is positive, else off." ! 891: (interactive "P") ! 892: (setq buffer-auto-save-file-name ! 893: (and (if (null arg) ! 894: (not buffer-auto-save-file-name) ! 895: (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) ! 896: (if (and buffer-file-name auto-save-visited-file-name ! 897: (not buffer-read-only)) ! 898: buffer-file-name ! 899: (make-auto-save-file-name)))) ! 900: (if (interactive-p) ! 901: (message "Auto-save %s (in this buffer)" ! 902: (if buffer-auto-save-file-name "on" "off"))) ! 903: buffer-auto-save-file-name) ! 904: ! 905: (defun rename-auto-save-file () ! 906: "Adjust current buffer's auto save file name for current conditions. ! 907: Also rename any existing auto save file." ! 908: (let ((osave buffer-auto-save-file-name)) ! 909: (setq buffer-auto-save-file-name ! 910: (make-auto-save-file-name)) ! 911: (if (and osave buffer-auto-save-file-name ! 912: (not (string= buffer-auto-save-file-name buffer-file-name)) ! 913: (not (string= buffer-auto-save-file-name osave)) ! 914: (file-exists-p osave)) ! 915: (rename-file osave buffer-auto-save-file-name t)))) ! 916: ! 917: (defun make-auto-save-file-name () ! 918: "Return file name to use for auto-saves of current buffer. ! 919: Does not consider auto-save-visited-file-name; that is checked ! 920: before calling this function. ! 921: You can redefine this for customization. ! 922: See also auto-save-file-name-p." ! 923: (if buffer-file-name ! 924: (concat (file-name-directory buffer-file-name) ! 925: "#" ! 926: (file-name-nondirectory buffer-file-name) ! 927: "#") ! 928: (expand-file-name (concat "#%" (buffer-name) "#")))) ! 929: ! 930: (defun auto-save-file-name-p (filename) ! 931: "Return non-nil if FILENAME can be yielded by make-auto-save-file-name. ! 932: FILENAME should lack slashes. ! 933: You can redefine this for customization." ! 934: (string-match "^#.*#$" filename)) ! 935: ! 936: (defconst list-directory-brief-switches "-CF" ! 937: "*Switches for list-directory to pass to `ls' for brief listing,") ! 938: (defconst list-directory-verbose-switches "-l" ! 939: "*Switches for list-directory to pass to `ls' for verbose listing,") ! 940: ! 941: (defun list-directory (dirname &optional verbose) ! 942: "Display a list of files in or matching DIRNAME, a la `ls'. ! 943: DIRNAME is globbed by the shell if necessary. ! 944: Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. ! 945: Actions controlled by variables list-directory-brief-switches ! 946: and list-directory-verbose-switches." ! 947: (interactive (let ((pfx current-prefix-arg)) ! 948: (list (read-file-name (if pfx "List directory (verbose): " ! 949: "List directory (brief): ") ! 950: nil default-directory nil) ! 951: pfx))) ! 952: (let ((switches (if verbose list-directory-verbose-switches ! 953: list-directory-brief-switches)) ! 954: full-dir-p) ! 955: (or dirname (setq dirname default-directory)) ! 956: (if (file-directory-p dirname) ! 957: (progn ! 958: (setq full-dir-p t) ! 959: (or (string-match "/$" dirname) ! 960: (setq dirname (concat dirname "/"))))) ! 961: (setq dirname (expand-file-name dirname)) ! 962: (with-output-to-temp-buffer "*Directory*" ! 963: (buffer-flush-undo standard-output) ! 964: (princ "Directory ") ! 965: (princ dirname) ! 966: (terpri) ! 967: (if full-dir-p ! 968: (call-process "ls" nil standard-output nil ! 969: switches dirname) ! 970: (let ((default-directory (file-name-directory dirname))) ! 971: (call-process shell-file-name nil standard-output nil ! 972: "-c" (concat "exec ls " ! 973: switches " " ! 974: (file-name-nondirectory dirname)))))))) ! 975: ! 976: (defun save-buffers-kill-emacs (&optional arg) ! 977: "Offer to save each buffer, then kill this Emacs fork. ! 978: With prefix arg, silently save all file-visiting buffers, then kill." ! 979: (interactive "P") ! 980: (save-some-buffers arg t) ! 981: (kill-emacs)) ! 982: ! 983: (define-key ctl-x-map "\C-f" 'find-file) ! 984: (define-key ctl-x-map "\C-q" 'toggle-read-only) ! 985: (define-key ctl-x-map "\C-r" 'find-file-read-only) ! 986: (define-key ctl-x-map "\C-v" 'find-alternate-file) ! 987: (define-key ctl-x-map "\C-s" 'save-buffer) ! 988: (define-key ctl-x-map "s" 'save-some-buffers) ! 989: (define-key ctl-x-map "\C-w" 'write-file) ! 990: (define-key ctl-x-map "i" 'insert-file) ! 991: (define-key esc-map "~" 'not-modified) ! 992: (define-key ctl-x-map "\C-d" 'list-directory) ! 993: (define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) ! 994: ! 995: (defvar ctl-x-4-map (make-keymap) ! 996: "Keymap for subcommands of C-x 4") ! 997: (fset 'ctl-x-4-prefix ctl-x-4-map) ! 998: (define-key ctl-x-map "4" 'ctl-x-4-prefix) ! 999: (define-key ctl-x-4-map "f" 'find-file-other-window) ! 1000: (define-key ctl-x-4-map "\C-f" 'find-file-other-window) ! 1001: (define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.