files.el

早期freebsd实现

		 (forward-char -3)
		 (skip-chars-backward " \t")
		 (setq end (point))
		 (goto-char beg)
		 (if (search-forward ":" end t)
		     (progn
		       (goto-char beg)
		       (if (let ((case-fold-search t))
			     (search-forward "mode:" end t))
			   (progn
			     (skip-chars-forward " \t")
			     (setq beg (point))
			     (if (search-forward ";" end t)
				 (forward-char -1)
			       (goto-char end))
			     (skip-chars-backward " \t")
			     (setq mode (buffer-substring beg (point))))))
		   (setq mode (buffer-substring beg end)))))
	  (funcall (intern (concat (downcase mode) "-mode")))
	(let ((alist auto-mode-alist)
	      (name buffer-file-name))
	  (let ((case-fold-search (eq system-type 'vax-vms)))
	    ;; Remove backup-suffixes from file name.
	    (setq name (file-name-sans-versions name))
	    ;; Find first matching alist entry.
	    (while (and (not mode) alist)
	      (if (string-match (car (car alist)) name)
		  (setq mode (cdr (car alist))))
	      (setq alist (cdr alist))))
	  (if mode (funcall mode)))))))

(defun hack-local-variables (&optional force)
  "Parse, and bind or evaluate as appropriate, any local variables
for current buffer."
  ;; Look for "Local variables:" line in last page.
  (save-excursion
    (goto-char (point-max))
    (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
    (if (let ((case-fold-search t))
	  (and (search-forward "Local Variables:" nil t)
	       (or (not inhibit-local-variables)
		   force
		   (save-window-excursion
		     (switch-to-buffer (current-buffer))
		     (save-excursion
		       (beginning-of-line)
		       (set-window-start (selected-window) (point)))
		     (y-or-n-p (format "Set local variables as specified at end of %s? "
				       (file-name-nondirectory buffer-file-name)))))))
	(let ((continue t)
	      prefix prefixlen suffix beg)
	  ;; The prefix is what comes before "local variables:" in its line.
	  ;; The suffix is what comes after "local variables:" in its line.
	  (skip-chars-forward " \t")
	  (or (eolp)
	      (setq suffix (buffer-substring (point)
					     (progn (end-of-line) (point)))))
	  (goto-char (match-beginning 0))
	  (or (bolp)
	      (setq prefix
		    (buffer-substring (point)
				      (progn (beginning-of-line) (point)))))
	  (if prefix (setq prefixlen (length prefix)
			   prefix (regexp-quote prefix)))
	  (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
	  (while continue
	    ;; Look at next local variable spec.
	    (if selective-display (re-search-forward "[\n\C-m]")
	      (forward-line 1))
	    ;; Skip the prefix, if any.
	    (if prefix
		(if (looking-at prefix)
		    (forward-char prefixlen)
		  (error "Local variables entry is missing the prefix")))
	    ;; Find the variable name; strip whitespace.
	    (skip-chars-forward " \t")
	    (setq beg (point))
	    (skip-chars-forward "^:\n")
	    (if (eolp) (error "Missing colon in local variables entry"))
	    (skip-chars-backward " \t")
	    (let* ((str (buffer-substring beg (point)))
		   (var (read str))
		  val)
	      ;; Setting variable named "end" means end of list.
	      (if (string-equal (downcase str) "end")
		  (setq continue nil)
		;; Otherwise read the variable value.
		(skip-chars-forward "^:")
		(forward-char 1)
		(setq val (read (current-buffer)))
		(skip-chars-backward "\n")
		(skip-chars-forward " \t")
		(or (if suffix (looking-at suffix) (eolp))
		    (error "Local variables entry is terminated incorrectly"))
		;; Set the variable.  "Variables" mode and eval are funny.
		(cond ((eq var 'mode)
		       (funcall (intern (concat (downcase (symbol-name val))
						"-mode"))))
		      ((eq var 'eval)
		       (if (string= (user-login-name) "root")
			   (message "Ignoring `eval:' in file's local variables")
			 (eval val)))
		      (t (make-local-variable var)
			 (set var val))))))))))

(defun set-visited-file-name (filename)
  "Change name of file visited in current buffer to FILENAME.
The next time the buffer is saved it will go in the newly specified file.
nil or empty string as argument means make buffer not be visiting any file.
Remember to delete the initial contents of the minibuffer
if you wish to pass an empty string as the argument."
  (interactive "FSet visited file name: ")
  (if filename
      (setq filename
	    (if (string-equal filename "")
		nil
	      (expand-file-name filename))))
  (or (equal filename buffer-file-name)
      (null filename)
      (progn
	(lock-buffer filename)
	(unlock-buffer)))
  (setq buffer-file-name filename)
  (if filename
      (let ((new-name (file-name-nondirectory buffer-file-name)))
	(if (string= new-name "")
	    (error "Empty file name"))
	(if (eq system-type 'vax-vms)
	    (setq new-name (downcase new-name)))
	(setq default-directory (file-name-directory buffer-file-name))
	(or (get-buffer new-name) (rename-buffer new-name))))
  (setq buffer-backed-up nil)
  (clear-visited-file-modtime)
  (kill-local-variable 'write-file-hooks)
  (kill-local-variable 'revert-buffer-function)
  ;; Rename the auto-save file to go with the new visited name.
  ;; If auto-save was not already on, turn it on if appropriate.
  (if buffer-auto-save-file-name
      (rename-auto-save-file)
    (auto-save-mode (and buffer-file-name auto-save-default)))
  (if buffer-file-name
      (set-buffer-modified-p t)))

(defun write-file (filename)
  "Write current buffer into file FILENAME.
Makes buffer visit that file, and marks it not modified."
  (interactive "FWrite file: ")
  (or (null filename) (string-equal filename "")
      (set-visited-file-name filename))
  (set-buffer-modified-p t)
  (save-buffer))

(defun backup-buffer ()
  "Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
If the value is non-nil, it is the result of `file-modes' on the original file;
this means that the caller, after saving the buffer, should change the modes
of the new file to agree with the old modes."
  (and make-backup-files
       (not buffer-backed-up)
       (file-exists-p buffer-file-name)
       (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
	     '(?- ?l))
       (or (< (length buffer-file-name) 5)
	   (not (string-equal "/tmp/" (substring buffer-file-name 0 5))))
    (condition-case ()
	(let* ((backup-info (find-backup-file-name buffer-file-name))
	       (backupname (car backup-info))
	       (targets (cdr backup-info))
	       setmodes)
;	  (if (file-directory-p buffer-file-name)
;	      (error "Cannot save buffer in directory %s" buffer-file-name))
	  (condition-case ()
	      (if (or file-precious-flag
		      (file-symlink-p buffer-file-name)
		      backup-by-copying
		      (and backup-by-copying-when-linked
			   (> (file-nlinks buffer-file-name) 1))
		      (and backup-by-copying-when-mismatch
			   (let ((attr (file-attributes buffer-file-name)))
			     (or (nth 9 attr)
				 (/= (nth 2 attr) (user-uid))))))
		  (copy-file buffer-file-name backupname t t)
		(condition-case ()
		    (delete-file backupname)
		  (file-error nil))
		(rename-file buffer-file-name backupname t)
		(setq setmodes (file-modes backupname)))
	    (file-error
	     ;; If trouble writing the backup, write it in ~.
	     (setq backupname (expand-file-name "~/%backup%~"))
	     (message "Cannot write backup file; backing up in ~/%%backup%%~")
	     (sleep-for 1)
	     (copy-file buffer-file-name backupname t t)))
	  (setq buffer-backed-up t)
	  (if (and targets
		   (or trim-versions-without-asking
		       (y-or-n-p (format "Delete excess backup versions of %s? "
					 buffer-file-name))))
	      (while targets
		(condition-case ()
		    (delete-file (car targets))
		  (file-error nil))
		(setq targets (cdr targets))))
	  setmodes)
      (file-error nil))))

(defun file-name-sans-versions (name)
  "Return FILENAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
redefine it."
  (substring name 0
	     (if (eq system-type 'vax-vms)
		 (or (string-match ";[0-9]+\\'" name)
		     (string-match ".[0-9]+\\'" name)
		     (length name))
	       (or (string-match "\\.~[0-9]+~\\'" name)
		   (string-match "~\\'" name)
		   (length name)))))

(defun make-backup-file-name (file)
  "Create the non-numeric backup file name for FILE.
This is a separate function so you can redefine it for customization."
  (concat file "~"))

(defun backup-file-name-p (file)
  "Return non-nil if FILE is a backup file name (numeric or not).
This is a separate function so you can redefine it for customization.
You may need to redefine file-name-sans-versions as well."
  (string-match "~$" file))

;; I believe there is no need to alter this behavior for VMS;
;; since backup files are not made on VMS, it should not get called.
(defun find-backup-file-name (fn)
  "Find a file name for a backup file, and suggestions for deletions.
Value is a list whose car is the name for the backup file
 and whose cdr is a list of old versions to consider deleting now."
  (if (eq version-control 'never)
      (list (make-backup-file-name fn))
    (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
	   (bv-length (length base-versions))
	   (possibilities (file-name-all-completions
			   base-versions
			   (file-name-directory fn)))
	   (versions (sort (mapcar 'backup-extract-version possibilities)
			   '<))
	   (high-water-mark (apply 'max (cons 0 versions)))
	   (deserve-versions-p
	    (or version-control
		(> high-water-mark 0)))
	   (number-to-delete (- (length versions)
				kept-old-versions kept-new-versions -1)))
      (if (not deserve-versions-p)
	  (list (make-backup-file-name fn))
	(cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
	      (if (> number-to-delete 0)
		  (mapcar (function (lambda (n)
				      (concat fn ".~" (int-to-string n) "~")))
			  (let ((v (nthcdr kept-old-versions versions)))
			    (rplacd (nthcdr (1- number-to-delete) v) ())
			    v))))))))

(defun backup-extract-version (fn)
  (if (and (string-match "[0-9]+~$" fn bv-length)
	   (= (match-beginning 0) bv-length))
      (string-to-int (substring fn bv-length -1))
      0))

(defun file-nlinks (filename)
  "Return number of names file FILENAME has." 
  (car (cdr (file-attributes filename))))

(defun save-buffer (&optional args)
  "Save current buffer in visited file if modified.  Versions described below.

By default, makes the previous version into a backup file
 if previously requested or if this is the first save.
With 1 or 3 \\[universal-argument]'s, marks this version
 to become a backup when the next save is done.
With 2 or 3 \\[universal-argument]'s,
 unconditionally makes the previous version into a backup file.
With argument of 0, never makes the previous version into a backup file.

If a file's name is FOO, the names of its numbered backup versions are
 FOO.~i~ for various integers i.  A non-numbered backup file is called FOO~.
Numeric backups (rather than FOO~) will be made if value of
 `version-control' is not the atom `never' and either there are already
 numeric versions of the file being backed up, or `version-control' is
 non-nil.
We don't want excessive versions piling up, so there are variables
 `kept-old-versions', which tells Emacs how many oldest versions to keep,
 and `kept-new-versions', which tells how many newest versions to keep.
 Defaults are 2 old versions and 2 new.
`dired-kept-versions' controls dired's clean-directory (.) command.
If `trim-versions-without-asking' is nil, system will query user
 before trimming versions.  Otherwise it does it silently."
  (interactive "p")
  (let ((modp (buffer-modified-p))
	(large (> (buffer-size) 50000))
	(make-backup-files (and make-backup-files (not (eq args 0)))))
    (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
    (if (and modp large) (message "Saving file %s..." (buffer-file-name)))
    (basic-save-buffer)
    (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))

(defun delete-auto-save-file-if-necessary ()
  "Delete the auto-save filename for the current buffer (if it has one)
if variable  delete-auto-save-files  is non-nil."
  (and buffer-auto-save-file-name delete-auto-save-files
       (not (string= buffer-file-name buffer-auto-save-file-name))
       (progn
	 (condition-case ()
	     (delete-file buffer-auto-save-file-name)
	   (file-error nil))
	 (set-buffer-auto-saved))))

(defun basic-save-buffer ()
  "Save the current buffer in its visited file, if it has been modified."  
  (interactive)
  (if (buffer-modified-p)
      (let (setmodes tempsetmodes)
	(or buffer-file-name
	    (progn
	      (setq buffer-file-name
		    (expand-file-name (read-file-name "File to save in: ") nil)
		    default-directory (file-name-directory buffer-file-name))
	      (auto-save-mode auto-save-default)))
	(if (not (file-writable-p buffer-file-name))
	    (if (yes-or-no-p
		 (format "File %s is write-protected; try to save anyway? "
			 (file-name-nondirectory buffer-file-name)))
		(setq tempsetmodes t)
	      (error
   "Attempt to save to a file which you aren't allowed to write")))
	(or (verify-visited-file-modtime (current-buffer))
	    (not (file-exists-p buffer-file-name))
	    (yes-or-no-p
	      "Disk file has changed since visited or saved.  Save anyway? ")
	    (error "Save not confirmed"))
	(or buffer-backed-up
	    (setq setmodes (backup-buffer)))
	(save-restriction
	  (widen)
	  (and (> (point-max) 1)
	       (/= (char-after (1- (point-max))) ?\n)
	       (or (eq require-final-newline t)
		   (and require-final-newline
			(yes-or-no-p
			 (format "Buffer %s does not end in newline.  Add one? "