![[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] / 43BSD / contrib / emacs / lisp|
Return to files.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
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.