[sxemacs] / files.el

;;; files.el --- file input and output commands for SXEmacs.

;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Sun Microsystems.

;; Maintainer: SXEmacs Development Team
;; Keywords: extensions, dumped

;; This file is part of SXEmacs.

;; SXEmacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; SXEmacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Synched up with: FSF 20.3 (but diverging)
;;; Warning: Merging this file is tough.  Beware.

;;; Commentary:

;; This file is dumped with SXEmacs.

;; Defines most of XEmacs's file- and directory-handling functions,
;; including basic file visiting, backup generation, link handling,
;; ITS-id version control, load- and write-hook handling, and the like.

;;; Code:

;; XEmacs: Avoid compilation warnings.
(defvar coding-system-for-read)
(defvar buffer-file-coding-system)
(eval-when-compile
  (globally-declare-fboundp '(dired-noselect dired)))


(defgroup files nil
  "Support editing files."
  :group 'emacs)

(defgroup backup nil
  "Backups of edited data files."
  :group 'files)

(defgroup find-file nil
  "Finding and editing files."
  :group 'files)


;; XEmacs: In buffer.c
;(defconst delete-auto-save-files t
;  "*Non-nil means delete auto-save file when a buffer is saved or killed.")

;; FSF has automount-dir-prefix.  Our directory-abbrev-alist is more general.
;; note: tmp_mnt bogosity conversion is established in paths.el.
(defcustom directory-abbrev-alist nil
  "*Alist of abbreviations for file directories.
A list of elements of the form (FROM . TO), each meaning to replace
FROM with TO when it appears in a directory name.
This replacement is done when setting up the default directory of a
newly visited file.  *Every* FROM string should start with \\\\` or ^.

Use this feature when you have directories which you normally refer to
via absolute symbolic links or to eliminate automounter mount points
from the beginning of your filenames.  Make TO the name of the link,
and FROM the name it is linked to."
  :type '(repeat (cons :format "%v"
                       :value ("\\`" . "")
                       (regexp :tag "From")
                       (regexp :tag "To")))
  :group 'find-file)

(defcustom make-backup-files t
  "*Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.

Renaming means that XEmacs renames the existing file so that it is a
backup file, then writes the buffer into a new file.  Any other names
that the old file had will now refer to the backup file.  The new file
is owned by you and its group is defaulted.

Copying means that XEmacs copies the existing file into the backup
file, then writes the buffer on top of the existing file.  Any other
names that the old file had will now refer to the new (edited) file.
The file's owner and group are unchanged.

The choice of renaming or copying is controlled by the variables
`backup-by-copying', `backup-by-copying-when-linked' and
`backup-by-copying-when-mismatch'.  See also `backup-inhibited'."
  :type 'boolean
  :group 'backup)

;; Do this so that local variables based on the file name
;; are not overridden by the major mode.
(defvar backup-inhibited nil
  "Non-nil means don't make a backup, regardless of the other parameters.
This variable is intended for use by making it local to a buffer.
But it is local only if you make it local.")
(put 'backup-inhibited 'permanent-local t)

(defcustom backup-by-copying nil
 "*Non-nil means always use copying to create backup files.
See documentation of variable `make-backup-files'."
 :type 'boolean
 :group 'backup)

(defcustom backup-by-copying-when-linked nil
 "*Non-nil means use copying to create backups for files with multiple names.
This causes the alternate names to refer to the latest version as edited.
This variable is relevant only if `backup-by-copying' is nil."
 :type 'boolean
 :group 'backup)

(defcustom backup-by-copying-when-mismatch nil
  "*Non-nil means create backups by copying if this preserves owner or group.
Renaming may still be used (subject to control of other variables)
when it would not result in changing the owner or group of the file;
that is, for files which are owned by you and whose group matches
the default for a new file created there by you.
This variable is relevant only if `backup-by-copying' is nil."
  :type 'boolean
  :group 'backup)

(defvar backup-enable-predicate
  #'(lambda (name)
     (not (or (null name)
              (string-match "^/tmp/" name)
              (let ((tmpdir (temp-directory)))
                (and tmpdir
                     (string-match (concat "\\`" (regexp-quote tmpdir) "/")
                                   tmpdir))))))
  "Predicate that looks at a file name and decides whether to make backups.
Called with an absolute file name as argument, it returns t to enable backup.")

(defcustom buffer-offer-save nil
  "*Non-nil in a buffer means offer to save the buffer on exit
even if the buffer is not visiting a file.
Automatically local in all buffers."
  :type 'boolean
  :group 'find-file)
(make-variable-buffer-local 'buffer-offer-save)

;; FSF uses normal defconst
(defvaralias 'find-file-visit-truename 'find-file-use-truenames)
(defvaralias 'find-file-existing-other-name 'find-file-compare-truenames)

(defcustom revert-without-query nil
  "*Specify which files should be reverted without query.
The value is a list of regular expressions.
If the file name matches one of these regular expressions,
then `revert-buffer' reverts the file without querying
if the file has changed on disk and you have not edited the buffer."
  :type '(repeat (regexp ""))
  :group 'find-file)

(defvar buffer-file-number nil
  "The device number and file number of the file visited in the current buffer.
The value is a list of the form (FILENUM DEVNUM).
This pair of numbers uniquely identifies the file.
If the buffer is visiting a new file, the value is nil.")
(make-variable-buffer-local 'buffer-file-number)
(put 'buffer-file-number 'permanent-local t)

(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
  "Non-nil means that buffer-file-number uniquely identifies files.")

(defcustom file-precious-flag nil
  "*Non-nil means protect against I/O errors while saving files.
Some modes set this non-nil in particular buffers.

This feature works by writing the new contents into a temporary file
and then renaming the temporary file to replace the original.
In this way, any I/O error in writing leaves the original untouched,
and there is never any instant where the file is nonexistent.

Note that this feature forces backups to be made by copying.
Yet, at the same time, saving a precious file
breaks any hard links between it and other files."
  :type 'boolean
  :group 'backup)

(defcustom version-control nil
  "*Control use of version numbers for backup files.
t means make numeric backup versions unconditionally.
nil means make them for files that have some already.
`never' means do not make them."
  :type 'boolean
  :group 'backup
  :group 'vc)

;; This is now defined in efs.
;(defvar dired-kept-versions 2
;  "*When cleaning directory, number of versions to keep.")

(defcustom delete-old-versions (when noninteractive 'leave)
  "*If t, delete excess backup versions silently.
If nil, ask confirmation.  Any other value prevents any trimming."
  :type '(choice (const :tag "Delete" t)
                 (const :tag "Ask" nil)
                 (sexp :tag "Leave" :format "%t\n" other))
  :group 'backup)

(defcustom kept-old-versions 2
  "*Number of oldest versions to keep when a new numbered backup is made."
  :type 'integer
  :group 'backup)

(defcustom kept-new-versions 2
  "*Number of newest versions to keep when a new numbered backup is made.
Includes the new backup.  Must be > 0"
  :type 'integer
  :group 'backup)

(defcustom require-final-newline nil
  "*Value of t says silently ensure a file ends in a newline when it is saved.
Non-nil but not t says ask user whether to add a newline when there isn't one.
nil means don't add newlines."
  :type '(choice (const :tag "Off" nil)
                 (const :tag "Add" t)
                 (sexp :tag "Ask" :format "%t\n" ask))
  :group 'editing-basics)

(defcustom auto-save-default t
  "*Non-nil says by default do auto-saving of every file-visiting buffer."
  :type 'boolean
  :group 'auto-save)

(defcustom auto-save-visited-file-name nil
  "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
Normally auto-save files are written under other names."
  :type 'boolean
  :group 'auto-save)

(defcustom save-abbrevs nil
  "*Non-nil means save word abbrevs too when files are saved.
Loading an abbrev file sets this to t."
  :type 'boolean
  :group 'abbrev)

(defcustom find-file-run-dired t
  "*Non-nil says run dired if `find-file' is given the name of a directory."
  :type 'boolean
  :group 'find-file)

;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
(defvar find-file-not-found-hooks nil
  "List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
`buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")

;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
(defvar find-file-hooks nil
  "List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
functions are called.")

(defvar write-file-hooks nil
  "List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the visited file.
So this list is cleared if you change the visited file name.
See also `write-contents-hooks' and `continue-save-buffer'.")
;;; However, in case someone does make it local...
(put 'write-file-hooks 'permanent-local t)

(defvar local-write-file-hooks nil
  "Just like `write-file-hooks', except intended for per-buffer use.
The functions in this list are called before the ones in
`write-file-hooks'.

This variable is meant to be used for hooks that have to do with a
particular visited file.  Therefore, it is a permanent local, so that
changing the major mode does not clear it.  However, calling
`set-visited-file-name' does clear it.")
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)


;; #### think about this (added by Sun).
(put 'after-set-visited-file-name-hooks 'permanent-local t)
(defvar after-set-visited-file-name-hooks nil
  "List of functions to be called after \\[set-visited-file-name]
or during \\[write-file].
You can use this hook to restore local values of `write-file-hooks',
`after-save-hook', and `revert-buffer-function', which pertain
to a specific file and therefore are normally killed by a rename.
Put hooks pertaining to the buffer contents on `write-contents-hooks'
and `revert-buffer-insert-file-contents-function'.")

(defvar write-contents-hooks nil
  "List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the buffer's contents,
not to the particular visited file; thus, `set-visited-file-name' does
not clear this variable, but changing the major mode does clear it.
See also `write-file-hooks' and `continue-save-buffer'.")

;;  XEmacs addition
;;  Energize needed this to hook into save-buffer at a lower level; we need
;;  to provide a new output method, but don't want to have to duplicate all
;;  of the backup file and file modes logic.that does not occur if one uses
;;  a write-file-hook which returns non-nil.
(put 'write-file-data-hooks 'permanent-local t)
(defvar write-file-data-hooks nil
  "List of functions to be called to put the bytes on disk.
These functions receive the name of the file to write to as argument.
The default behavior is to call
  (write-region (point-min) (point-max) filename nil t)
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the visited file.
So this list is cleared if you change the visited file name.
See also `write-file-hooks'.")

(defcustom enable-local-variables t
  "*Control use of local-variables lists in files you visit.
The value can be t, nil or something else.
A value of t means local-variables lists are obeyed;
nil means they are ignored; anything else means query.

The command \\[normal-mode] always obeys local-variables lists
and ignores this variable."
  :type '(choice (const :tag "Obey" t)
                 (const :tag "Ignore" nil)
                 (sexp :tag "Query" :format "%t\n" other))
  :group 'find-file)

(defcustom enable-local-eval 'maybe
  "*Control processing of the \"variable\" `eval' in a file's local variables.
The value can be t, nil or something else.
A value of t means obey `eval' variables;
nil means ignore them; anything else means query.

The command \\[normal-mode] always obeys local-variables lists
and ignores this variable."
  :type '(choice (const :tag "Obey" t)
                 (const :tag "Ignore" nil)
                 (sexp :tag "Query" :format "%t\n" other))
  :group 'find-file)

;;; SXEmacs addition
(defcustom find-file-magic-files-alist
  '((file-directory-p . find-file-try-dired-noselect))
  "Alist where each element is in form \(PREDICATE . FUNCTION-OF-ONE-ARGUMENT\).
FUNCTION-OF-ONE-ARGUMENT must return some buffer."
  :type 'alist
  :group 'find-file)

;; Avoid losing in versions where CLASH_DETECTION is disabled.
(or (fboundp 'lock-buffer)
    (defalias 'lock-buffer 'ignore))
(or (fboundp 'unlock-buffer)
    (defalias 'unlock-buffer 'ignore))
\f
;;FSFmacs bastardized ange-ftp cruft
;; This hook function provides support for ange-ftp host name
;; completion.  It runs the usual ange-ftp hook, but only for
;; completion operations.  Having this here avoids the need
;; to load ange-ftp when it's not really in use.
;(defun ange-ftp-completion-hook-function (op &rest args)
;  (if (memq op '(file-name-completion file-name-all-completions))
;      (apply 'ange-ftp-hook-function op args)
;    (let ((inhibit-file-name-handlers
;          (cons 'ange-ftp-completion-hook-function
;                (and (eq inhibit-file-name-operation op)
;                     inhibit-file-name-handlers)))
;         (inhibit-file-name-operation op))
;      (apply op args))

(defun convert-standard-filename (filename)
  "Convert a standard file's name to something suitable for the current OS."
  (if (eq system-type 'windows-nt)
      (let ((name (copy-sequence filename))
            (start 0))
        ;; leave ':' if part of drive specifier
        (if (and (> (length name) 1)
                 (eq (aref name 1) ?:))
            (setq start 2))
        ;; destructively replace invalid filename characters with !
        (while (string-match "[?*:<>|\"\000-\037]" name start)
          (aset name (match-beginning 0) ?!)
          (setq start (match-end 0)))
        ;; FSF: [convert directory separators to Windows format ...]
        ;; unneeded in XEmacs.
        name)
    filename))

\f
(defun pwd ()
  "Show the current default directory."
  (interactive nil)
  (message "Directory %s" default-directory))

(defvar cd-path nil
  "Value of the CDPATH environment variable, as a list.
Not actually set up until the first time you use it.")

(defvar cdpath-previous nil
  "Prior value of the CDPATH environment variable.")

(defun parse-colon-path (cd-path)
  "Explode a colon-separated search path into a list of directory names.

If you think you want to use this, you probably don't.  This function
is provided for backward compatibility.  A more robust implementation
of the same functionality is available as `split-path', which see."
  (and cd-path
       (let (cd-list (cd-start 0) cd-colon)
         (setq cd-path (concat cd-path path-separator))
         (while (setq cd-colon (string-match path-separator cd-path cd-start))
           (setq cd-list
                 (nconc cd-list
                        (list (if (= cd-start cd-colon)
                                   nil
                                (substitute-in-file-name
                                 (file-name-as-directory
                                  (substring cd-path cd-start cd-colon)))))))
           (setq cd-start (+ cd-colon 1)))
         cd-list)))

(defun cd-absolute (dir)
  "Change current directory to given absolute file name DIR."
  ;; Put the name into directory syntax now,
  ;; because otherwise expand-file-name may give some bad results.
  (setq dir (file-name-as-directory dir))
  ;; XEmacs change: stig@hackvan.com
  (if find-file-use-truenames
      (setq dir (file-truename dir)))
  (setq dir (abbreviate-file-name (expand-file-name dir)))
  (cond ((not (file-directory-p dir))
         (error "%s is not a directory" dir))
        ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
        ;;((not (file-executable-p dir))
        ;; (error "Cannot cd to %s:  Permission denied" dir))
        (t
         (setq default-directory dir))))

(defun cd (dir)
  "Make DIR become the current buffer's default directory.
If your environment includes a `CDPATH' variable, try each one of that
colon-separated list of directories when resolving a relative directory name."
  (interactive
   ;; XEmacs change? (read-file-name => read-directory-name)
   (list (read-directory-name "Change default directory: "
                              default-directory default-directory
                              (and (member cd-path '(nil ("./")))
                                   (null (getenv "CDPATH"))))))
  (if (file-name-absolute-p dir)
      (cd-absolute (expand-file-name dir))
    ;; XEmacs
    (unless (and cd-path (equal (getenv "CDPATH") cdpath-previous))
      ;;#### Unix-specific
      (let ((trypath (parse-colon-path
                      (setq cdpath-previous (getenv "CDPATH")))))
        (setq cd-path (or trypath (list "./")))))
    (or (catch 'found
          (mapcar #'(lambda (x)
                        (let ((f (expand-file-name (concat x dir))))
                          (if (file-directory-p f)
                              (progn
                                (cd-absolute f)
                                (throw 'found t)))))
                  cd-path)
          nil)
        ;; jwz: give a better error message to those of us with the
        ;; good taste not to use a kludge like $CDPATH.
        (if (equal cd-path '("./"))
            (error "No such directory: %s" (expand-file-name dir))
          (error "Directory not found in $CDPATH: %s" dir)))))

(defun load-file (file)
  "Load the Lisp file named FILE."
  (interactive "fLoad file: ")
  (load (expand-file-name file) nil nil t))

; We now dump utils/lib-complete.el which has improved versions of this.
;(defun load-library (library)
;  "Load the library named LIBRARY.
;This is an interface to the function `load'."
;  (interactive "sLoad library: ")
;  (load library))
;
;(defun find-library (library)
;  "Find the library of Lisp code named LIBRARY.
;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"."
;  (interactive "sFind library file: ")
;  (let ((f (locate-file library load-path ":.el:")))
;    (if f
;        (find-file f)
;        (error "Couldn't locate library %s" library))))

(defun file-local-copy (file &optional buffer)
  "Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible."
  (let ((handler (find-file-name-handler file 'file-local-copy)))
    (if handler
        (funcall handler 'file-local-copy file)
      nil)))

;; XEmacs change block
; We have this in C and use the realpath() system call.

;(defun file-truename (filename &optional counter prev-dirs)
; [... lots of code snipped ...]
;    filename))

;; XEmacs addition.  Called from `insert-file-contents-internal'
;; at the appropriate time.
(defun compute-buffer-file-truename (&optional buffer)
  "Recompute BUFFER's value of `buffer-file-truename'
based on the current value of `buffer-file-name'.
BUFFER defaults to the current buffer if unspecified."
  (save-excursion
    (set-buffer (or buffer (current-buffer)))
    (cond ((null buffer-file-name)
           (setq buffer-file-truename nil))
          ((setq buffer-file-truename (file-truename buffer-file-name))
           ;; it exists, we're done.
           nil)
          (t
           ;; the file doesn't exist, but maybe the directory does.
           (let* ((dir (file-name-directory buffer-file-name))
                  (truedir (file-truename dir)))
             (if truedir (setq dir truedir))
             (setq buffer-file-truename
                   (expand-file-name (file-name-nondirectory buffer-file-name)
                                     dir)))))
    (if (and find-file-use-truenames buffer-file-truename)
        (setq buffer-file-name (abbreviate-file-name buffer-file-truename)
              default-directory (file-name-directory buffer-file-name)))
    buffer-file-truename))
;; End XEmacs change block

(defun file-chase-links (filename)
  "Chase links in FILENAME until a name that is not a link.
Does not examine containing directories for links,
unlike `file-truename'."
  (let (tem (count 100) (newname filename))
    (while (setq tem (file-symlink-p newname))
      (save-match-data
        (if (= count 0)
            (error "Apparent cycle of symbolic links for %s" filename))
        ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
        (while (string-match "//+" tem)
          (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
                            (substring tem (match-end 0)))))
        ;; Handle `..' by hand, since it needs to work in the
        ;; target of any directory symlink.
        ;; This code is not quite complete; it does not handle
        ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
        (while (string-match #r"\`\.\./" tem) ;#### Unix specific
          (setq tem (substring tem 3))
          (setq newname (file-name-as-directory
                         ;; Do the .. by hand.
                         (directory-file-name
                          (file-name-directory
                           ;; Chase links in the default dir of the symlink.
                           (file-chase-links
                            (directory-file-name
                             (file-name-directory newname))))))))
        (setq newname (expand-file-name tem (file-name-directory newname)))
        (setq count (1- count))))
    newname))
\f
(defun switch-to-other-buffer (arg)
  "Switch to the previous buffer.  With a numeric arg, n, switch to the nth
most recent buffer.  With an arg of 0, buries the current buffer at the
bottom of the buffer stack."
  (interactive "p")
  (if (eq arg 0)
      (bury-buffer (current-buffer)))
  (switch-to-buffer
   (if (<= arg 1) (other-buffer (current-buffer))
     (nth (1+ arg) (buffer-list)))))

(defun switch-to-buffer-other-window (buffer)
  "Select buffer BUFFER in another window."
  (interactive "BSwitch to buffer in other window: ")
  (let ((pop-up-windows t))
    ;; XEmacs: this used to have (selected-frame) as the third argument,
    ;; but this is obnoxious.  If the user wants the buffer in a
    ;; different frame, then it should be this way.

    ;; Change documented above undone --mrb
    (pop-to-buffer buffer t (selected-frame))))

(defun switch-to-buffer-other-frame (buffer)
  "Switch to buffer BUFFER in a newly-created frame."
  (interactive "BSwitch to buffer in other frame: ")
  (let* ((name (get-frame-name-for-buffer buffer))
         (frame (make-frame (if name
                                  (list (cons 'name (symbol-name name)))))))
    (pop-to-buffer buffer t frame)
    (make-frame-visible frame)
    buffer))

(defun find-file (filename &optional codesys)
  "Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "FFind file: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (switch-to-buffer (find-file-noselect filename)))
    (switch-to-buffer (find-file-noselect filename))))

(defun find-file-other-window (filename &optional codesys)
  "Edit file FILENAME, in another window.
May create a new window, or reuse an existing one.
See the function `display-buffer'.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "FFind file in other window: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (switch-to-buffer-other-window (find-file-noselect filename)))
    (switch-to-buffer-other-window (find-file-noselect filename))))

(defun find-file-other-frame (filename &optional codesys)
  "Edit file FILENAME, in a newly-created frame.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "FFind file in other frame: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (switch-to-buffer-other-frame (find-file-noselect filename)))
    (switch-to-buffer-other-frame (find-file-noselect filename))))

(defun find-file-read-only (filename &optional codesys)
  "Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "fFind file read-only: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (find-file filename))
    (find-file filename))
  (setq buffer-read-only t)
  (current-buffer))

(defun find-file-read-only-other-window (filename &optional codesys)
  "Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "fFind file read-only other window: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (find-file-other-window filename))
    (find-file-other-window filename))
  (setq buffer-read-only t)
  (current-buffer))

(defun find-file-read-only-other-frame (filename &optional codesys)
  "Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive "fFind file read-only other frame: \nZCoding system: ")
  (if codesys
      (let ((coding-system-for-read
             (get-coding-system codesys)))
        (find-file-other-frame filename))
    (find-file-other-frame filename))
  (setq buffer-read-only t)
  (current-buffer))

(defun find-alternate-file-other-window (filename &optional codesys)
  "Find file FILENAME as a replacement for the file in the next window.
This command does not select that window.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive
   (save-selected-window
     (other-window 1)
     (let ((file buffer-file-name)
           (file-name nil)
           (file-dir nil))
       (and file
            (setq file-name (file-name-nondirectory file)
                  file-dir (file-name-directory file)))
       (list (read-file-name
              "Find alternate file: " file-dir nil nil file-name)
             (if (and current-prefix-arg (featurep 'mule))
                 (read-coding-system "Coding-system: "))))))
  (if (one-window-p)
      (find-file-other-window filename)
    (save-selected-window
      (other-window 1)
      (find-alternate-file filename codesys))))

(defun find-alternate-file (filename &optional codesys)
  "Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
\(presumably by mistake), use this command to visit the file you really want.
Under XEmacs/Mule, optional second argument specifies the
coding system to use when decoding the file.  Interactively,
with a prefix argument, you will be prompted for the coding system."
  (interactive
   (let ((file buffer-file-name)
         (file-name nil)
         (file-dir nil))
     (and file
          (setq file-name (file-name-nondirectory file)
                file-dir (file-name-directory file)))
     (list (read-file-name
            "Find alternate file: " file-dir nil nil file-name)
           (if (and current-prefix-arg (featurep 'mule))
               (read-coding-system "Coding-system: ")))))
  (and (buffer-modified-p) (buffer-file-name)
     &nb