Return to files.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/files.el, revision 1.1

1.1     ! root        1: ;; File input and output commands for Emacs
        !             2: ;; Copyright (C) 1985 Richard M. Stallman.
        !             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: (defconst make-backup-files t
        !            27:   "*Create a backup of each file when it is saved for the first time.
        !            28: This can be done by renaming the file or by copying, according to the
        !            29: values of  backup-by-copying  and   backup-by-copying-when-linked.")
        !            30: 
        !            31: (defconst backup-by-copying nil
        !            32:  "*Non-nil means create backups of files by copying rather than by renaming.")
        !            33: 
        !            34: (defconst backup-by-copying-when-linked nil
        !            35:  "*Non-nil means create backups of multi-named files by copying
        !            36: rather than by renaming.
        !            37: This causes the alternate names to refer to the latest version as edited.")
        !            38: 
        !            39: (defvar version-control nil
        !            40:   "*Control use of version numbers for backup files.
        !            41: t means make numeric backup versions unconditionally.
        !            42: nil means make them for files that have some already.
        !            43: never means do not make them.")
        !            44: 
        !            45: (defvar dired-kept-versions 2
        !            46:   "*When cleaning directory, number of versions to keep.")
        !            47: 
        !            48: (defvar trim-versions-without-asking nil
        !            49:   "*If true, deletes excess backup versions silently.
        !            50: Otherwise asks confirmation.")
        !            51: 
        !            52: (defvar kept-old-versions 2
        !            53:   "*Number of oldest versions to keep when a new numbered backup is made.")
        !            54: 
        !            55: (defvar kept-new-versions 2
        !            56:   "*Number of newest versions to keep when a new numbered backup is made.
        !            57: Includes the new backup.  Must be > 0")
        !            58: 
        !            59: (defconst require-final-newline nil
        !            60:   "*t says silently put a newline at the end whenever a file is saved.
        !            61: Non-nil but not t says ask user whether to add a newline in each such case.
        !            62: nil means don't add newlines.")
        !            63: 
        !            64: (defconst auto-save-default t
        !            65:   "*t says by default do auto-saving of every file-visiting buffer.")
        !            66: 
        !            67: (defconst auto-save-visited-file-name nil
        !            68:   "*t says auto-save a buffer in the file it is visiting, when practical.
        !            69: Normally auto-save files are written under other names.")
        !            70: 
        !            71: (defconst save-abbrevs t
        !            72:   "*Non-nil means save word abbrevs too when files are saved.")
        !            73: 
        !            74: (defconst find-file-run-dired t
        !            75:   "*Non-nil says run dired if find-file is given the name of a directory.")
        !            76: 
        !            77: (defvar find-file-not-found-hook nil
        !            78:   "*If non-nil specifies a function to be called for find-file on nonexistent file.
        !            79: This function is called as soon as the error is detected.
        !            80: buffer-file-name is already set up.")
        !            81: 
        !            82: (defvar find-file-hook nil
        !            83:   "*If non-nil specifies a function to be called after a buffer
        !            84: is found or reverted from a file.
        !            85: The buffer's local variables (if any) will have been processed before the
        !            86: function is called.")
        !            87: 
        !            88: (defvar write-file-hook nil
        !            89:   "*If non-nil specifies a function to be called before writing out a buffer
        !            90: to a file.")
        !            91: 
        !            92: ;; Avoid losing in versions where CLASH_DETECTION is disabled.
        !            93: (or (fboundp 'lock-buffer)
        !            94:     (fset 'lock-buffer 'ignore))
        !            95: (or (fboundp 'unlock-buffer)
        !            96:     (fset 'unlock-buffer 'ignore))
        !            97: 
        !            98: (defun pwd ()
        !            99:   "Show the current default directory."
        !           100:   (interactive nil)
        !           101:   (message "Directory %s" default-directory))
        !           102: 
        !           103: (defun cd (dir)
        !           104:   "Make DIR become the current buffer's default directory."
        !           105:   (interactive "DChange default directory: ")
        !           106:   (setq dir (expand-file-name dir))
        !           107:   ;; (interactive "D") really doesn't do the right thing at all
        !           108:   (or (string-match "/$" dir)
        !           109:       (setq dir (concat dir "/")))
        !           110:   (if (not (file-directory-p dir))
        !           111:       (error "%s is not a directory" dir)
        !           112:     (setq default-directory dir))
        !           113:   (pwd))
        !           114: 
        !           115: (defun switch-to-buffer-other-window (buffer)
        !           116:   "Select buffer BUFFER in another window."
        !           117:   (interactive "BSwitch to buffer in other window: ")
        !           118:   (let ((pop-up-windows t))
        !           119:     (pop-to-buffer buffer t)))
        !           120: 
        !           121: (defun find-file (filename)
        !           122:   "Edit file FILENAME.
        !           123: Switch to a buffer visiting file FILENAME,
        !           124: creating one if none already exists."
        !           125:   (interactive "FFind file: ")
        !           126:   (switch-to-buffer (find-file-noselect filename)))
        !           127: 
        !           128: (defun find-file-other-window (filename)
        !           129:   "Edit file FILENAME, in another window.
        !           130: May create a new window, or reuse an existing one;
        !           131: see the function display-buffer."
        !           132:   (interactive "FFind file in other window: ")
        !           133:   (switch-to-buffer-other-window (find-file-noselect filename)))
        !           134: 
        !           135: (defun find-file-read-only (filename)
        !           136:   "Edit file FILENAME but don't save without confirmation.
        !           137: Like find-file but marks buffer as read-only."
        !           138:   (interactive "fFind file read-only: ")
        !           139:   (find-file filename)
        !           140:   (setq buffer-read-only t))
        !           141: 
        !           142: (defun find-alternate-file (filename)
        !           143:   "Find file FILENAME, select its buffer, kill previous buffer.
        !           144: If the current buffer now contains an empty file that you just visited
        !           145: \(presumably by mistake), use this command to visit the file you really want."
        !           146:   (interactive "FFind alternate file: ")
        !           147:   (if (null buffer-file-name)
        !           148:       (error "Non-file buffer"))
        !           149:   (and (buffer-modified-p)
        !           150:        (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
        !           151:                                 (buffer-name))))
        !           152:        (error "Aborted"))
        !           153:   (let ((obuf (current-buffer))
        !           154:        (ofile buffer-file-name)
        !           155:        (oname (buffer-name)))
        !           156:     (rename-buffer " **lose**")
        !           157:     (setq buffer-file-name nil)
        !           158:     (unwind-protect
        !           159:        (progn
        !           160:          (unlock-buffer)
        !           161:          (find-file filename))
        !           162:       (cond ((eq obuf (current-buffer))
        !           163:             (setq buffer-file-name ofile)
        !           164:             (lock-buffer)
        !           165:             (rename-buffer oname))))
        !           166:     (kill-buffer obuf)))
        !           167: 
        !           168: (defvar ask-about-buffer-names nil
        !           169:   "*Non-nil means ask user for buffer name when there is a conflict.
        !           170: The default is to generate a unique name with no interaction.")
        !           171: 
        !           172: (defun create-file-buffer (filename)
        !           173:   "Creates a suitably named buffer for visiting FILENAME, and returns it."
        !           174:   (let ((base (file-name-nondirectory filename)))
        !           175:     (if (and (get-buffer base)
        !           176:             ask-about-buffer-names)
        !           177:        (get-buffer-create
        !           178:          (let ((tem (read-string (format
        !           179:  "Buffer name \"%s\" is in use; type a new name, or Return to clobber: "
        !           180:                                    base))))
        !           181:            (if (equal tem "") base tem)))
        !           182:       (generate-new-buffer base))))
        !           183: 
        !           184: (defun find-file-noselect (filename)
        !           185:   "Read file FILENAME into a buffer and return the buffer.
        !           186: If a buffer exists visiting FILENAME, return that one,
        !           187: but verify that the file has not changed since visited or saved.
        !           188: The buffer is not selected, just returned to the caller."
        !           189:   (if (file-directory-p filename)
        !           190:       (if find-file-run-dired
        !           191:          (dired-noselect filename)
        !           192:        (error "%s is a directory." filename))
        !           193:     (let ((buf (get-file-buffer filename))
        !           194:          error)
        !           195:       (if buf
        !           196:          (or (verify-visited-file-modtime buf)
        !           197:              (if (not (file-exists-p filename))
        !           198:                  (progn (message "Note: file %s no longer exists" filename)
        !           199:                         t))
        !           200:              (not (yes-or-no-p
        !           201:                     (if (buffer-modified-p buf)
        !           202:    "File has changed since last visited or saved.  Flush your changes? "
        !           203:    "File has changed since last visited or saved.  Read from disk? ")))
        !           204:              (save-excursion
        !           205:                (set-buffer buf)
        !           206:                (revert-buffer t)))
        !           207:        (save-excursion
        !           208:          (setq buf (create-file-buffer filename)
        !           209:                filename (expand-file-name filename))
        !           210:          (set-buffer buf)
        !           211:          (erase-buffer)
        !           212:          (condition-case ()
        !           213:              (insert-file-contents filename t)
        !           214:            (file-error
        !           215:             (setq error t
        !           216:                   buffer-file-name filename)
        !           217:             (if find-file-not-found-hook
        !           218:                 (funcall find-file-not-found-hook))))
        !           219:          (setq default-directory (file-name-directory filename))
        !           220:          (after-find-file error)))
        !           221:       buf)))
        !           222: 
        !           223: 
        !           224: (defun after-find-file (error)
        !           225:   "Called after finding a file and by the default revert function.
        !           226: Sets buffer mode, parses local variables, calls  find-file-hook."
        !           227:   (setq buffer-read-only (not (file-writable-p buffer-file-name)))
        !           228:   (if noninteractive
        !           229:       nil
        !           230:     (message (cond ((not buffer-read-only)
        !           231:                    (if error "(New file)" ""))
        !           232:                   ((not error)
        !           233:                    "File is write protected")
        !           234:                   ((file-attributes buffer-file-name)
        !           235:                    ;; file-exists-p is not the right thing above, as that
        !           236:                    ;;  returns t iff the file is READABLE by you
        !           237:                    "File exists, but is read-protected.")
        !           238:                   ((file-attributes default-directory)
        !           239:                    "File not found and directory write-protected")
        !           240:                   (t
        !           241:                    "File not found and directory doesn't exist")))
        !           242:     (if auto-save-default
        !           243:        (auto-save-mode t)))
        !           244:   (normal-mode))
        !           245: 
        !           246: (defun normal-mode ()
        !           247:   "Choose the major mode for this buffer automatically.
        !           248: Also sets up any specified local variables of the file.
        !           249: Uses the visited file name, the -*- line, and the local variables spec.
        !           250: Finishes by calling value of find-file-hook if that's not nil."
        !           251:   (interactive)
        !           252:   (condition-case err
        !           253:                  (set-auto-mode)
        !           254:     (error (message "Error processing file's mode specifications: %s"
        !           255:                    (prin1-to-string err))))
        !           256:   (condition-case err
        !           257:                  (hack-local-variables)
        !           258:     (error (message "Error processing file's local variables: %s"
        !           259:                    (prin1-to-string err))))
        !           260:   (and find-file-hook
        !           261:        (funcall find-file-hook)))
        !           262: 
        !           263: ;(defvar auto-mode-alist ...) now in loaddefs.el
        !           264: (defun set-auto-mode ()
        !           265:   "Select major mode appropriate for current buffer.
        !           266: May base decision on visited file name (See variable  auto-mode-list)
        !           267: or on buffer contents (-*- line or local variables spec), but does not look
        !           268: for the \"mode:\" local variable. For that, use  hack-local-variables."
        !           269:   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
        !           270:   (let (beg end mode)
        !           271:     (save-excursion
        !           272:       (goto-char (point-min))
        !           273:       (skip-chars-forward " \t\n")
        !           274:       (if (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t)
        !           275:               (progn
        !           276:                 (skip-chars-forward " \t")
        !           277:                 (setq beg (point))
        !           278:                 (search-forward "-*-" (save-excursion (end-of-line) (point)) t))
        !           279:               (progn
        !           280:                 (forward-char -3)
        !           281:                 (skip-chars-backward " \t")
        !           282:                 (setq end (point))
        !           283:                 (goto-char beg)
        !           284:                 (if (search-forward ":" end t)
        !           285:                     (progn
        !           286:                       (goto-char beg)
        !           287:                       (if (let ((case-fold-search t))
        !           288:                             (search-forward "mode:" end t))
        !           289:                           (progn
        !           290:                             (skip-chars-forward " \t")
        !           291:                             (setq beg (point))
        !           292:                             (if (search-forward ";" end t)
        !           293:                                 (forward-char -1)
        !           294:                               (goto-char end))
        !           295:                             (skip-chars-backward " \t")
        !           296:                             (setq mode (buffer-substring beg (point))))))
        !           297:                   (setq mode (buffer-substring beg end)))))
        !           298:          (funcall (intern (concat (downcase mode) "-mode")))
        !           299:        (let ((alist auto-mode-alist)
        !           300:              (name buffer-file-name))
        !           301:          (let (case-fold-search)
        !           302:            ;; Remove backup-suffixes from file name.
        !           303:            (setq name (substring name 0
        !           304:                                  (or (string-match "\\.~[0-9]+~\\'" name)
        !           305:                                      (string-match "~\\'" name)
        !           306:                                      (length name))))
        !           307:            ;; Find first matching alist entry.
        !           308:            (while (and (not mode) alist)
        !           309:              (if (string-match (car (car alist)) name)
        !           310:                  (setq mode (cdr (car alist))))
        !           311:              (setq alist (cdr alist))))
        !           312:          (if mode (funcall mode)))))))
        !           313: 
        !           314: (defun hack-local-variables ()
        !           315:   "Parse, and bind or evaluate as appropriate, any local variables
        !           316: for current buffer."
        !           317:   ;; Look for "Local variables:" line in last page.
        !           318:   (save-excursion
        !           319:     (goto-char (point-max))
        !           320:     (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
        !           321:     (if (let ((case-fold-search t))
        !           322:          (search-forward "Local Variables:" nil t))
        !           323:        (let ((continue t)
        !           324:              prefix prefixlen suffix beg)
        !           325:          ;; The prefix is what comes before "local variables:" in its line.
        !           326:          ;; The suffix is what comes after "local variables:" in its line.
        !           327:          (or (eolp)
        !           328:              (setq suffix (buffer-substring (point)
        !           329:                                             (progn (end-of-line) (point)))))
        !           330:          (goto-char (match-beginning 0))
        !           331:          (or (bolp)
        !           332:              (setq prefix
        !           333:                    (buffer-substring (point)
        !           334:                                      (progn (beginning-of-line) (point)))))
        !           335:          (if prefix (setq prefixlen (length prefix)
        !           336:                           prefix (regexp-quote prefix)))
        !           337:          (if suffix (setq suffix (regexp-quote suffix)))
        !           338:          (while continue
        !           339:            ;; Look at next local variable spec.
        !           340:            (forward-line 1)
        !           341:            ;; Skip the prefix, if any.
        !           342:            (if prefix
        !           343:                (if (looking-at prefix)
        !           344:                    (forward-char prefixlen)
        !           345:                  (error "Local variables entry is missing the prefix")))
        !           346:            ;; Find the variable name; strip whitespace.
        !           347:            (skip-chars-forward " \t")
        !           348:            (setq beg (point))
        !           349:            (skip-chars-forward "^:\n")
        !           350:            (if (eolp) (error "Missing colon in local variables entry"))
        !           351:            (skip-chars-backward " \t")
        !           352:            (let* ((str (buffer-substring beg (point)))
        !           353:                   (var (read str))
        !           354:                  val)
        !           355:              ;; Setting variable named "end" means end of list.
        !           356:              (if (string-equal (downcase str) "end")
        !           357:                  (setq continue nil)
        !           358:                ;; Otherwise read the variable value.
        !           359:                (skip-chars-forward "^:")
        !           360:                (forward-char 1)
        !           361:                (setq val (read (current-buffer)))
        !           362:                (skip-chars-backward "\n")
        !           363:                (skip-chars-forward " \t")
        !           364:                (or (if suffix (looking-at suffix) (eolp))
        !           365:                    (error "Local variables entry is terminated incorrectly"))
        !           366:                ;; Set the variable.  "Variables" mode and eval are funny.
        !           367:                (cond ((eq var 'mode)
        !           368:                       (funcall (intern (concat (downcase (symbol-name val))
        !           369:                                                "-mode"))))
        !           370:                      ((eq var 'eval)
        !           371:                       (eval val))
        !           372:                      (t (make-local-variable var)
        !           373:                         (set var val))))))))))
        !           374: 
        !           375: (defun set-visited-file-name (filename)
        !           376:   "Change name of file visited in current buffer to FILENAME.
        !           377: The next time the buffer is saved it will go in the newly specified file.
        !           378: nil or empty string as argument means make buffer not be visiting any file."
        !           379:   (interactive "FSet visited file name: ")
        !           380:   (if filename
        !           381:       (setq filename
        !           382:            (if (string-equal filename "")
        !           383:                nil
        !           384:              (expand-file-name filename))))
        !           385:   (or (equal filename buffer-file-name)
        !           386:       (null filename)
        !           387:       (progn
        !           388:        (lock-buffer filename)
        !           389:        (unlock-buffer)))
        !           390:   (setq buffer-file-name filename)
        !           391:   (if filename
        !           392:       (progn
        !           393:        (setq default-directory (file-name-directory buffer-file-name))
        !           394:        (or (get-buffer (file-name-nondirectory buffer-file-name))
        !           395:           (rename-buffer (file-name-nondirectory buffer-file-name)))))
        !           396:   (setq buffer-backed-up nil)
        !           397:   (clear-visited-file-modtime)
        !           398:   (auto-save-mode (and buffer-file-name auto-save-default))
        !           399:   (if buffer-file-name
        !           400:       (set-buffer-modified-p t)))
        !           401: 
        !           402: (defun write-file (filename)
        !           403:   "Write current buffer into file FILENAME.
        !           404: Makes buffer visit that file, and marks it not modified."
        !           405:   (interactive "FWrite file: ")
        !           406:   (or (null filename) (string-equal filename "")
        !           407:       (set-visited-file-name filename))
        !           408:   (set-buffer-modified-p t)
        !           409:   (save-buffer))
        !           410: 
        !           411: (defun backup-buffer ()
        !           412:   "Make a backup of the disk file visited by the current buffer.
        !           413: This is done before saving the buffer the first time."
        !           414:   (and make-backup-files
        !           415:        (not buffer-backed-up)
        !           416:        (file-exists-p buffer-file-name)
        !           417:        (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
        !           418:             '(?- ?l))
        !           419:        (or (< (length buffer-file-name) 5)
        !           420:           (not (string-equal "/tmp/" (substring buffer-file-name 0 5))))
        !           421:     (condition-case ()
        !           422:        (let* ((backup-info (find-backup-file-name buffer-file-name))
        !           423:               (backupname (car backup-info))
        !           424:               (targets (cdr backup-info))
        !           425:               setmodes)
        !           426: ;        (if (file-directory-p buffer-file-name)
        !           427: ;            (error "Cannot save buffer in directory %s" buffer-file-name))
        !           428:          (if (or (file-symlink-p buffer-file-name)
        !           429:                  backup-by-copying
        !           430:                  (and backup-by-copying-when-linked
        !           431:                       (> (file-nlinks buffer-file-name) 1)))
        !           432:              (copy-file buffer-file-name backupname t)
        !           433:            (condition-case ()
        !           434:                (delete-file backupname)
        !           435:              (file-error nil))
        !           436:            (rename-file buffer-file-name backupname t)
        !           437:            (setq setmodes (file-modes backupname)))
        !           438:          (setq buffer-backed-up t)
        !           439:          (if (and targets
        !           440:                   (or trim-versions-without-asking
        !           441:                       (y-or-n-p (format "Delete excess backup versions of %s? "
        !           442:                                         buffer-file-name))))
        !           443:              (while targets
        !           444:                (condition-case ()
        !           445:                    (delete-file (car targets))
        !           446:                  (file-error nil))
        !           447:                (setq targets (cdr targets))))
        !           448:          setmodes)
        !           449:       (file-error nil))))
        !           450: 
        !           451: (defun find-backup-file-name (fn)
        !           452:   "Find a file name for a backup file, and suggestions for deletions.
        !           453: Value is a list whose car is the name for the backup file
        !           454:  and whose cdr is a list of old versions to consider deleting now."
        !           455:   (if (eq version-control 'never)
        !           456:       (list (concat fn "~"))
        !           457:     (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
        !           458:           (bv-length (length base-versions))
        !           459:           (possibilities (file-name-all-completions
        !           460:                           base-versions
        !           461:                           (file-name-directory fn)))
        !           462:           (versions (sort (mapcar 'backup-extract-version possibilities)
        !           463:                           '<))
        !           464:           (high-water-mark (apply 'max (cons 0 versions)))
        !           465:           (deserve-versions-p
        !           466:            (or version-control
        !           467:                (> high-water-mark 0)))
        !           468:           (number-to-delete (- (length versions)
        !           469:                                kept-old-versions kept-new-versions -1)))
        !           470:       (if (not deserve-versions-p)
        !           471:          (list (concat fn "~"))
        !           472:        (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
        !           473:              (if (> number-to-delete 0)
        !           474:                  (mapcar (function (lambda (n)
        !           475:                                      (concat fn ".~" (int-to-string n) "~")))
        !           476:                          (let ((v (nthcdr kept-old-versions versions)))
        !           477:                            (rplacd (nthcdr (1- number-to-delete) v) ())
        !           478:                            v))))))))
        !           479: 
        !           480: (defun backup-extract-version (fn)
        !           481:   (string-to-int (substring fn bv-length -1)))
        !           482: 
        !           483: (defun file-nlinks (filename)
        !           484:   "Return number of names file FILENAME has." 
        !           485:   (car (cdr (file-attributes filename))))
        !           486: 
        !           487: (defun save-buffer (&optional args)
        !           488:   "Save current buffer in visited file if modified.  Versions described below.
        !           489: 
        !           490: With no arg, only backs up if first save or previously motivated.
        !           491: With 1 or 3 \\[universal-argument]'s, marks this version to be backed up.
        !           492: With 2 or 3 \\[universal-argument]'s, unconditionally backs up previous \
        !           493: version.
        !           494: 
        !           495: If a file's name is FOO, the names of numbered versions are
        !           496:  FOO.~i~ for various integers i.
        !           497: Numeric backups (rather than FOO~) will be made if value of
        !           498:  version-control  is not the atom never and either there are already
        !           499:  numeric versions of the file being backed up, or  version-control  is
        !           500:  non-nil.
        !           501: dired-kept-versions  controls dired's clean-directory (.) command.
        !           502: We don't want excessive versions piling up, so variables
        !           503:  kept-old-versions , which tells system how many oldest versions to
        !           504:  keep, and  kept-new-versions , which tells how many new versions to
        !           505:  keep, are provided.  Defaults are 2 old versions and 2 new.
        !           506: If  trim-versions-without-asking  is nil, system will query user
        !           507:  before trimming versions.  Otherwise it does it silently."
        !           508:   (interactive "p")
        !           509:   (let ((modp (buffer-modified-p)))
        !           510:     (and modp (memq args '(4 64)) (setq buffer-backed-up nil))
        !           511:     (basic-save-buffer)
        !           512:     (and modp (memq args '(16 64)) (setq buffer-backed-up nil))))
        !           513: 
        !           514: (defun delete-auto-save-file-if-necessary ()
        !           515:   "Delete the auto-save filename for the current buffer (if it has one)
        !           516: if variable  delete-auto-save-files  is non-nil."
        !           517:   (and buffer-auto-save-file-name delete-auto-save-files
        !           518:        (progn
        !           519:         (condition-case ()
        !           520:             (delete-file buffer-auto-save-file-name)
        !           521:           (file-error nil))
        !           522:         (set-buffer-auto-saved))))
        !           523: 
        !           524: (defun basic-save-buffer ()
        !           525:   "Save the current buffer in its visited file, if it has been modified."  
        !           526:   (interactive)
        !           527:   (if (buffer-modified-p)
        !           528:       (let (setmodes tempsetmodes)
        !           529:        (or buffer-file-name
        !           530:            (setq buffer-file-name
        !           531:                  (expand-file-name (read-file-name "File to save in: ") nil)
        !           532:                  default-directory (file-name-directory buffer-file-name)))
        !           533:        (if (not (file-writable-p buffer-file-name))
        !           534:            (if (yes-or-no-p
        !           535:                 (format "File %s is write-protected; try to save anyway? "
        !           536:                         (file-name-nondirectory buffer-file-name)))
        !           537:                (setq tempsetmodes t)
        !           538:              (error
        !           539:    "Attempt to save to a file which you aren't allowed to write")))
        !           540:        (or (verify-visited-file-modtime (current-buffer))
        !           541:            (not (file-exists-p buffer-file-name))
        !           542:            (yes-or-no-p
        !           543:              "File has changed on disk since last visited or saved.  Save anyway? ")
        !           544:            (error "Save not confirmed"))
        !           545:        (or buffer-backed-up
        !           546:            (setq setmodes (backup-buffer)))
        !           547:        (save-restriction
        !           548:          (widen)
        !           549:          (and (> (point-max) 1)
        !           550:               (/= (char-after (1- (point-max))) ?\n)
        !           551:               (or (eq require-final-newline t)
        !           552:                   (and require-final-newline
        !           553:                        (yes-or-no-p
        !           554:                         (format "Buffer %s does not end in newline.  Add one? "
        !           555:                                 (buffer-name)))))
        !           556:               (save-excursion
        !           557:                 (goto-char (point-max))
        !           558:                 (insert ?\n)))
        !           559:          (and write-file-hook
        !           560:               (funcall write-file-hook))
        !           561:          ;; If file not writable, see if we can make it writable
        !           562:          ;; temporarily while we write it.
        !           563:          ;; But no need to do so if we have just backed up the file
        !           564:          ;; (if setmodes is set) because in that case we are superseding.
        !           565:          (cond ((and tempsetmodes (not setmodes))
        !           566:                 ;; Change the mode back, after writing.
        !           567:                 (setq setmodes (file-modes buffer-file-name))
        !           568:                 (set-file-modes buffer-file-name 511)))
        !           569:          (write-region (point-min) (point-max) buffer-file-name nil t)
        !           570:          (if setmodes
        !           571:              (condition-case ()
        !           572:                   (set-file-modes buffer-file-name setmodes)
        !           573:                (error nil))))
        !           574:        (delete-auto-save-file-if-necessary))
        !           575:     (message "(No changes need to be saved)")))
        !           576: 
        !           577: (defun save-some-buffers (&optional arg)
        !           578:   "Save some modified file-visiting buffers.  Asks user about each one.
        !           579: With argument, saves all with no questions."
        !           580:   (interactive "P")
        !           581:   (let (considered (list (buffer-list)))
        !           582:     (while list
        !           583:       (let ((buffer (car list)))
        !           584:        (condition-case ()
        !           585:            (and (buffer-modified-p buffer)
        !           586:                 (buffer-file-name buffer)
        !           587:                 (setq considered t)
        !           588:                 (or arg
        !           589:                     (y-or-n-p (format "Save file %s? " (buffer-file-name buffer))))
        !           590:                 (save-excursion
        !           591:                   (set-buffer buffer)
        !           592:                   (save-buffer)))
        !           593:          (error nil)))
        !           594:       (setq list (cdr list)))
        !           595:     (and save-abbrevs abbrevs-changed
        !           596:         (setq considered t)
        !           597:         (or arg
        !           598:             (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
        !           599:         (progn
        !           600:          (write-abbrev-file nil)
        !           601:          (setq abbrevs-changed nil)))
        !           602:     (if considered
        !           603:        (message "")
        !           604:        (message "(No files need saving)"))))
        !           605: 
        !           606: (defun not-modified ()
        !           607:   "Mark current buffer as unmodified, not needing to be saved."
        !           608:   (interactive)
        !           609:   (message "Modification-flag cleared")
        !           610:   (set-buffer-modified-p nil))
        !           611: 
        !           612: (defun toggle-read-only ()
        !           613:   "Change whether this buffer is visiting its file read-only."
        !           614:   (interactive)
        !           615:   (setq buffer-read-only (not buffer-read-only))
        !           616:   ;; Force mode-line redisplay
        !           617:   (set-buffer-modified-p (buffer-modified-p)))
        !           618: 
        !           619: (defun insert-file (filename)
        !           620:   "Insert contents of file FILENAME into buffer after point.
        !           621: Set mark after the inserted text."
        !           622:   (interactive "fInsert file: ")
        !           623:   (let ((tem (insert-file-contents filename)))
        !           624:     (push-mark (+ (point) (car (cdr tem))))))
        !           625: 
        !           626: (defun append-to-file (start end filename)
        !           627:   "Append the contents of the region to the end of file FILENAME.
        !           628: When called from a function, expects three arguments,
        !           629: START, END and FILENAME.  START and END are buffer positions
        !           630: saying what text to write."
        !           631:   (interactive "r\nFAppend to file: ")
        !           632:   (write-region start end filename t))
        !           633: 
        !           634: (defvar revert-buffer-function nil
        !           635:   "Function to use to revert this buffer, or nil to do the default.")
        !           636: 
        !           637: (defun revert-buffer (&optional arg)
        !           638:   "Replace the buffer text with the text of the visited file on disk.
        !           639: This undoes all changes since the file was visited or saved.
        !           640: If latest auto-save file is more recent than the visited file,
        !           641: asks user whether to use that instead, unless a non-nil argument is given.
        !           642: 
        !           643: If revert-buffer-function's value is non-nil, it is called to do the work."
        !           644:   (interactive "P")
        !           645:   (if revert-buffer-function
        !           646:       (funcall revert-buffer-function arg)
        !           647:     (let* ((opoint (point))
        !           648:           (auto-save-p (and (null arg) (recent-auto-save-p)
        !           649:                             (y-or-n-p
        !           650:    "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
        !           651:           (file-name (if auto-save-p
        !           652:                          buffer-auto-save-file-name
        !           653:                        buffer-file-name)))
        !           654:       (cond ((null file-name)
        !           655:             (error "Buffer does not seem to be associated with any file"))
        !           656:            ((not (file-exists-p file-name))
        !           657:             (error "File %s no longer exists!" file-name))
        !           658:            ((yes-or-no-p (format "Revert buffer from file %s? " file-name))
        !           659:             (let ((buffer-read-only nil))
        !           660:               ;; Bind buffer-file-name to nil
        !           661:               ;; so that we don't try to lock the file.
        !           662:               (let ((buffer-file-name nil))
        !           663:                 (or auto-save-p
        !           664:                     (unlock-buffer))
        !           665:                 (erase-buffer))
        !           666:               (insert-file-contents file-name (not auto-save-p)))
        !           667:             (after-find-file nil)
        !           668:             (or find-file-hook         ; the hook may have set point itself
        !           669:                 (goto-char (min opoint (point-max)))))))))
        !           670: 
        !           671: (defun recover-file (file)
        !           672:   "Visit file FILE, then get contents from its last auto-save file."
        !           673:   (interactive "FRecover file: ")
        !           674:   (find-file file)
        !           675:   (let ((file-name (make-auto-save-file-name)))
        !           676:     (cond ((not (file-exists-p file-name))
        !           677:           (error "Auto-save file %s does not exist" file-name))
        !           678:          ((yes-or-no-p (format "Recover buffer from file %s? " file-name))
        !           679:           (let ((buffer-read-only nil))
        !           680:             (erase-buffer)
        !           681:             (insert-file-contents file-name nil))
        !           682:           (after-find-file nil))))
        !           683:   (setq buffer-auto-save-file-name nil)
        !           684:   (message "Auto-save turned off, for now, in this buffer"))
        !           685: 
        !           686: (defun kill-some-buffers ()
        !           687:   "For each buffer, ask whether to kill it."
        !           688:   (interactive)
        !           689:   (let ((list (buffer-list)))
        !           690:     (while list
        !           691:       (let* ((buffer (car list))
        !           692:             (name (buffer-name buffer)))
        !           693:        (and (not (string-equal name ""))
        !           694:             (/= (aref name 0) ? )
        !           695:             (yes-or-no-p
        !           696:              (format "Buffer %s %s.  Kill? "
        !           697:                      name
        !           698:                      (if (buffer-modified-p buffer)
        !           699:                          "HAS BEEN EDITED" "is unmodified")))
        !           700:             (kill-buffer buffer)))
        !           701:       (setq list (cdr list)))))
        !           702: 
        !           703: (defun auto-save-mode (arg)
        !           704:   "Toggle auto-saving of contents of current buffer.
        !           705: With arg, turn auto-saving on if arg is positive, else off."
        !           706:   (interactive "P")
        !           707:   (setq buffer-auto-save-file-name
        !           708:         (and (if (null arg)
        !           709:                 (not buffer-auto-save-file-name)
        !           710:               (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
        !           711:             (if (and buffer-file-name auto-save-visited-file-name
        !           712:                      (not buffer-read-only))
        !           713:                 buffer-file-name
        !           714:               (make-auto-save-file-name)))))
        !           715: 
        !           716: (defun make-auto-save-file-name ()
        !           717:   "Return file name to use for auto-saves of current buffer.
        !           718: Does not consider auto-save-visited-file-name; that is checked
        !           719: before calling this function.
        !           720: This is a separate function so your .emacs file or site-init.el can redefine it.
        !           721: See also auto-save-file-name-p."
        !           722:   (if buffer-file-name
        !           723:       (concat (file-name-directory buffer-file-name)
        !           724:              "#"
        !           725:              (file-name-nondirectory buffer-file-name))
        !           726:     (expand-file-name (concat "#%" (buffer-name)))))
        !           727: 
        !           728: (defun auto-save-file-name-p (filename)
        !           729:   "Return t if FILENAME can be yielded by make-auto-save-file-name.
        !           730: FILENAME should lack slashes.
        !           731: This is a separate function so your .emacs file or site-init.el can redefine it."
        !           732:   (string-match "^#" filename))
        !           733: 
        !           734: (defconst list-directory-brief-switches "-CF"
        !           735:   "*Switches for list-directory to pass to `ls' for brief listing,")
        !           736: (defconst list-directory-verbose-switches "-l"
        !           737:   "*Switches for list-directory to pass to `ls' for verbose listing,")
        !           738: 
        !           739: (defun list-directory (dirname &optional verbose)
        !           740:   "Display a list of files in or matching DIRNAME, a la `ls'.
        !           741: DIRNAME is globbed by the shell if necessary.
        !           742: Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
        !           743: Actions controlled by variables list-directory-brief-switches
        !           744:  and list-directory-verbose-switches."
        !           745:   (interactive (let ((pfx current-prefix-arg))
        !           746:                 (list (read-file-name (if pfx "List directory (verbose): "
        !           747:                                         "List directory (brief): ")
        !           748:                                       nil default-directory nil)
        !           749:                       pfx)))
        !           750:   (let ((switches (if verbose list-directory-verbose-switches
        !           751:                    list-directory-brief-switches))
        !           752:        full-dir-p)
        !           753:     (or dirname (setq dirname default-directory))
        !           754:     (if (file-directory-p dirname)
        !           755:        (progn
        !           756:         (setq full-dir-p t)
        !           757:         (or (string-match "/$" dirname)
        !           758:             (setq dirname (concat dirname "/")))))
        !           759:     (setq dirname (expand-file-name dirname))
        !           760:     (with-output-to-temp-buffer "*Directory*"
        !           761:       (buffer-flush-undo standard-output)
        !           762:       (princ "Directory ")
        !           763:       (princ dirname)
        !           764:       (terpri)
        !           765:       (if full-dir-p
        !           766:          (call-process "/bin/ls" nil standard-output nil
        !           767:                        switches dirname)
        !           768:        (let ((default-directory (file-name-directory dirname)))
        !           769:          (call-process shell-file-name nil standard-output nil
        !           770:                        "-c" (concat "exec /bin/ls "
        !           771:                                     switches " "
        !           772:                                     (file-name-nondirectory dirname))))))))
        !           773: 
        !           774: (defun save-buffers-kill-emacs ()
        !           775:   "Offer to save each buffer, then kill this Emacs fork."
        !           776:   (interactive)
        !           777:   (save-some-buffers)
        !           778:   (kill-emacs))
        !           779: 
        !           780: (define-key ctl-x-map "\C-f" 'find-file)
        !           781: (define-key ctl-x-map "\C-q" 'toggle-read-only)
        !           782: (define-key ctl-x-map "\C-r" 'find-file-read-only)
        !           783: (define-key ctl-x-map "\C-v" 'find-alternate-file)
        !           784: (define-key ctl-x-map "\C-s" 'save-buffer)
        !           785: (define-key ctl-x-map "s" 'save-some-buffers)
        !           786: (define-key ctl-x-map "\C-w" 'write-file)
        !           787: (define-key ctl-x-map "i" 'insert-file)
        !           788: (define-key esc-map "~" 'not-modified)
        !           789: (define-key ctl-x-map "\C-d" 'list-directory)
        !           790: (define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
        !           791: 
        !           792: (defvar ctl-x-4-map (make-keymap)
        !           793:   "Keymap for subcommands of C-x 4")
        !           794: (fset 'ctl-x-4-prefix ctl-x-4-map)
        !           795: (define-key ctl-x-map "4" 'ctl-x-4-prefix)
        !           796: (define-key ctl-x-4-map "f" 'find-file-other-window)
        !           797: (define-key ctl-x-4-map "\C-f" 'find-file-other-window)
        !           798: (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.