files.el

早期freebsd实现

				 (buffer-name)))))
	       (save-excursion
		 (goto-char (point-max))
		 (insert ?\n)))
	  (let ((hooks write-file-hooks)
		(done nil))
	    (while (and hooks
			(not (setq done (funcall (car hooks)))))
	      (setq hooks (cdr hooks)))
	    ;; If a hook returned t, file is already "written".
	    (cond ((not done)
		   (if file-precious-flag
		       ;; If file is precious, rename it away before
		       ;; overwriting it.
		       (let ((rename t) nodelete
			     (file (concat buffer-file-name "#")))
			 (condition-case ()
			     (progn (rename-file buffer-file-name file t)
				    (setq setmodes (file-modes file)))
			   (file-error (setq rename nil nodelete t)))
			 (unwind-protect
			     (progn (clear-visited-file-modtime)
				    (write-region (point-min) (point-max)
						  buffer-file-name nil t)
				    (setq rename nil))
			   ;; If rename is still t, writing failed.
			   ;; So rename the old file back to original name,
			   (if rename
			       (progn
				 (rename-file file buffer-file-name t)
				 (clear-visited-file-modtime))
			     ;; Otherwise we don't need the original file,
			     ;; so flush it.  Unless we already lost it.
			     (or nodelete
				 (condition-case ()
				     (delete-file file)
				   (error nil))))))
		     ;; If file not writable, see if we can make it writable
		     ;; temporarily while we write it.
		     ;; But no need to do so if we have just backed it up
		     ;; (setmodes is set) because that says we're superseding.
		     (cond ((and tempsetmodes (not setmodes))
			    ;; Change the mode back, after writing.
			    (setq setmodes (file-modes buffer-file-name))
			    (set-file-modes buffer-file-name 511)))
		     (write-region (point-min) (point-max) 
				   buffer-file-name nil t)))))
	  (if setmodes
	      (condition-case ()
		   (set-file-modes buffer-file-name setmodes)
		(error nil))))
	(delete-auto-save-file-if-necessary))
    (message "(No changes need to be saved)")))

(defun save-some-buffers (&optional arg exiting)
  "Save some modified file-visiting buffers.  Asks user about each one.
With argument, saves all with no questions."
  (interactive "P")
  (let (considered (list (buffer-list)))
    (while list
      (let ((buffer (car list)))
	(and (buffer-modified-p buffer)
	     (save-excursion
	       (set-buffer buffer)
	       (and
		(or buffer-file-name
		    (and exiting buffer-offer-save (> (buffer-size) 0)))
		(setq considered t)
		(or arg
		    (y-or-n-p (if buffer-file-name
				  (format "Save file %s? "
					  buffer-file-name)
				(format "Save buffer %s? " (buffer-name)))))
		(condition-case ()
		    (save-buffer)
		  (error nil))))))
      (setq list (cdr list)))
    (and save-abbrevs abbrevs-changed
	 (progn
	   (setq considered t)
	   (if (or arg
		   (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
	       (write-abbrev-file nil))
	   ;; Don't keep bothering user if he says no.
	   (setq abbrevs-changed nil)))
    (if considered
	(message "")
	(message "(No files need saving)"))))

(defun not-modified ()
  "Mark current buffer as unmodified, not needing to be saved."
  (interactive)
  (message "Modification-flag cleared")
  (set-buffer-modified-p nil))

(defun toggle-read-only ()
  "Change whether this buffer is visiting its file read-only."
  (interactive)
  (setq buffer-read-only (not buffer-read-only))
  ;; Force mode-line redisplay
  (set-buffer-modified-p (buffer-modified-p)))

(defun insert-file (filename)
  "Insert contents of file FILENAME into buffer after point.
Set mark after the inserted text."
  (interactive "fInsert file: ")
  (let ((tem (insert-file-contents filename)))
    (push-mark (+ (point) (car (cdr tem))))))

(defun append-to-file (start end filename)
  "Append the contents of the region to the end of file FILENAME.
When called from a function, expects three arguments,
START, END and FILENAME.  START and END are buffer positions
saying what text to write."
  (interactive "r\nFAppend to file: ")
  (write-region start end filename t))

(defvar revert-buffer-function nil
  "Function to use to revert this buffer, or nil to do the default.")

(defun revert-buffer (&optional arg noconfirm)
  "Replace the buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
If latest auto-save file is more recent than the visited file,
asks user whether to use that instead.
First argument (optional) non-nil means don't offer to use auto-save file.
 This is the prefix arg when called interactively.

Second argument (optional) non-nil means don't ask for confirmation at all.

If revert-buffer-function's value is non-nil, it is called to do the work."
  (interactive "P")
  (if revert-buffer-function
      (funcall revert-buffer-function arg noconfirm)
    (let* ((opoint (point))
	   (auto-save-p (and (null arg) (recent-auto-save-p)
			     buffer-auto-save-file-name
			     (file-readable-p buffer-auto-save-file-name)
			     (y-or-n-p
   "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
	   (file-name (if auto-save-p
			  buffer-auto-save-file-name
			buffer-file-name)))
      (cond ((null file-name)
	     (error "Buffer does not seem to be associated with any file"))
	    ((not (file-exists-p file-name))
	     (error "File %s no longer exists!" file-name))
	    ((or noconfirm
		 (yes-or-no-p (format "Revert buffer from file %s? "
				      file-name)))
	     ;; If file was backed up but has changed since,
	     ;; we shd make another backup.
	     (and (not auto-save-p)
		  (not (verify-visited-file-modtime (current-buffer)))
		  (setq buffer-backed-up nil))
	     ;; Discard all the undo information.
	     (or (eq buffer-undo-list t)
		 (setq buffer-undo-list nil))
	     (let ((buffer-read-only nil)
		   ;; Don't record undo info for the revert itself.
		   ;; Doing so chews up too much storage.
		   (buffer-undo-list t))
	       ;; Bind buffer-file-name to nil
	       ;; so that we don't try to lock the file.
	       (let ((buffer-file-name nil))
		 (or auto-save-p
		     (unlock-buffer))
		 (erase-buffer))
	       (insert-file-contents file-name (not auto-save-p)))
	     (goto-char (min opoint (point-max)))
	     (after-find-file nil)
	     t)))))

(defun recover-file (file)
  "Visit file FILE, but get contents from its last auto-save file."
  (interactive "FRecover file: ")
  (setq file (expand-file-name file))
  (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
  (let ((file-name (let ((buffer-file-name file))
		     (make-auto-save-file-name))))
    (cond ((not (file-newer-than-file-p file-name file))
	   (error "Auto-save file %s not current" file-name))
	  ((save-window-excursion
	     (if (not (eq system-type 'vax-vms))
		 (with-output-to-temp-buffer "*Directory*"
		   (buffer-flush-undo standard-output)
		   (call-process "ls" nil standard-output nil
				 "-l" file file-name)))
	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
	   (switch-to-buffer (find-file-noselect file t))
	   (let ((buffer-read-only nil))
	     (erase-buffer)
	     (insert-file-contents file-name nil))
	   (after-find-file nil))
	  (t (error "Recover-file cancelled."))))
  (setq buffer-auto-save-file-name nil)
  (message "Auto-save off in this buffer till you do M-x auto-save-mode."))

(defun kill-some-buffers ()
  "For each buffer, ask whether to kill it."
  (interactive)
  (let ((list (buffer-list)))
    (while list
      (let* ((buffer (car list))
	     (name (buffer-name buffer)))
	(and (not (string-equal name ""))
	     (/= (aref name 0) ? )
	     (yes-or-no-p
	      (format "Buffer %s %s.  Kill? "
		      name
		      (if (buffer-modified-p buffer)
			  "HAS BEEN EDITED" "is unmodified")))
	     (kill-buffer buffer)))
      (setq list (cdr list)))))

(defun auto-save-mode (arg)
  "Toggle auto-saving of contents of current buffer.
With arg, turn auto-saving on if arg is positive, else off."
  (interactive "P")
  (setq buffer-auto-save-file-name
        (and (if (null arg)
		 (not buffer-auto-save-file-name)
	       (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
	     (if (and buffer-file-name auto-save-visited-file-name
		      (not buffer-read-only))
		 buffer-file-name
	       (make-auto-save-file-name))))
  (if (interactive-p)
      (message "Auto-save %s (in this buffer)"
	       (if buffer-auto-save-file-name "on" "off")))
  buffer-auto-save-file-name)

(defun rename-auto-save-file ()
  "Adjust current buffer's auto save file name for current conditions.
Also rename any existing auto save file."
  (let ((osave buffer-auto-save-file-name))
    (setq buffer-auto-save-file-name
	  (make-auto-save-file-name))
    (if (and osave buffer-auto-save-file-name
	     (not (string= buffer-auto-save-file-name buffer-file-name))
	     (not (string= buffer-auto-save-file-name osave))
	     (file-exists-p osave))
	(rename-file osave buffer-auto-save-file-name t))))

(defun make-auto-save-file-name ()
  "Return file name to use for auto-saves of current buffer.
Does not consider auto-save-visited-file-name; that is checked
before calling this function.
You can redefine this for customization.
See also auto-save-file-name-p."
  (if buffer-file-name
      (concat (file-name-directory buffer-file-name)
	      "#"
	      (file-name-nondirectory buffer-file-name)
	      "#")
    (expand-file-name (concat "#%" (buffer-name) "#"))))

(defun auto-save-file-name-p (filename)
  "Return non-nil if FILENAME can be yielded by make-auto-save-file-name.
FILENAME should lack slashes.
You can redefine this for customization."
  (string-match "^#.*#$" filename))

(defconst list-directory-brief-switches "-CF"
  "*Switches for list-directory to pass to `ls' for brief listing,")
(defconst list-directory-verbose-switches "-l"
  "*Switches for list-directory to pass to `ls' for verbose listing,")

(defun list-directory (dirname &optional verbose)
  "Display a list of files in or matching DIRNAME, a la `ls'.
DIRNAME is globbed by the shell if necessary.
Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
Actions controlled by variables list-directory-brief-switches
 and list-directory-verbose-switches."
  (interactive (let ((pfx current-prefix-arg))
		 (list (read-file-name (if pfx "List directory (verbose): "
					 "List directory (brief): ")
				       nil default-directory nil)
		       pfx)))
  (let ((switches (if verbose list-directory-verbose-switches
		    list-directory-brief-switches))
	full-dir-p)
    (or dirname (setq dirname default-directory))
    (if (file-directory-p dirname)
	(progn
	 (setq full-dir-p t)
	 (or (string-match "/$" dirname)
	     (setq dirname (concat dirname "/")))))
    (setq dirname (expand-file-name dirname))
    (with-output-to-temp-buffer "*Directory*"
      (buffer-flush-undo standard-output)
      (princ "Directory ")
      (princ dirname)
      (terpri)
      (if full-dir-p
	  (call-process "ls" nil standard-output nil
			switches dirname)
	(let ((default-directory (file-name-directory dirname)))
	  (call-process shell-file-name nil standard-output nil
			"-c" (concat "exec ls "
				     switches " "
				     (file-name-nondirectory dirname))))))))

(defun save-buffers-kill-emacs (&optional arg)
  "Offer to save each buffer, then kill this Emacs fork.
With prefix arg, silently save all file-visiting buffers, then kill."
  (interactive "P")
  (save-some-buffers arg t)
  (and (or (not (memq t (mapcar (function
				  (lambda (buf) (and (buffer-file-name buf)
						     (buffer-modified-p buf))))
				(buffer-list))))
	   (yes-or-no-p "Modified buffers exist; exit anyway? "))
       (or (not (fboundp 'process-list))
	   ;; process-list is not defined on VMS.
	   (let ((processes (process-list))
		 active)
	     (while processes
	       (and (memq (process-status (car processes)) '(run stop))
		    (let ((val (process-kill-without-query (car processes))))
		      (process-kill-without-query (car processes) val)
		      val)
		    (setq active t))
	       (setq processes (cdr processes)))
	     (or (not active)
		 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
       (kill-emacs)))

(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key ctl-x-map "\C-v" 'find-alternate-file)
(define-key ctl-x-map "\C-s" 'save-buffer)
(define-key ctl-x-map "s" 'save-some-buffers)
(define-key ctl-x-map "\C-w" 'write-file)
(define-key ctl-x-map "i" 'insert-file)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)

(defvar ctl-x-4-map (make-keymap)
  "Keymap for subcommands of C-x 4")
(fset 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)