annotate lisp/files.el @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents e29fcfd8df5f
children 733f067a73ce
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; files.el --- file input and output commands for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Sun Microsystems.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
5 ;; Copyright (C) 2001, 2002, 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
27 ;;; [[ Synched up with: FSF 20.3 (but diverging)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
28 ;;; Warning: Merging this file is tough. Beware.]]
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
29
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
30 ;;; Beware of sync messages with 20.x or 21.x! (Unless I did them, of
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
31 ;;; course ... :-) Those who did these synchronizations did not do proper
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
32 ;;; jobs and often left out lots of changes. In practice you need to do a
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
33 ;;; line-by-line comparison, and whenever encountering differences, see
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
34 ;;; what FSF 19.34 looks like to see if the changes are intentional or just
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
35 ;;; regressions. In at least one case below, our code was unchanged from
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
36 ;;; FSF 19.30! --ben
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
37
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
38 ;;; Mostly synched to FSF 21.2 by Ben Wing using a line-by-line comparison,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
39 ;;; except some really hard parts that have changed almost completely.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
45 ;; BEGIN SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
46
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; Defines most of XEmacs's file- and directory-handling functions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; including basic file visiting, backup generation, link handling,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; ITS-id version control, load- and write-hook handling, and the like.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; XEmacs: Avoid compilation warnings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (defvar coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (defvar buffer-file-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (defgroup files nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 "Support editing files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (defgroup backup nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 "Backups of edited data files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 :group 'files)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (defgroup find-file nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 "Finding and editing files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 :group 'files)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
69 ;; XEmacs: In buffer.c (also)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
70 (defcustom delete-auto-save-files t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
71 "*Non-nil means delete auto-save file when a buffer is saved or killed.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
72
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
73 Note that auto-save file will not be deleted if the buffer is killed
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
74 when it has unsaved changes."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
75 :type 'boolean
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
76 :group 'auto-save)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; note: tmp_mnt bogosity conversion is established in paths.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (defcustom directory-abbrev-alist nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 "*Alist of abbreviations for file directories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 A list of elements of the form (FROM . TO), each meaning to replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 FROM with TO when it appears in a directory name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 This replacement is done when setting up the default directory of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 newly visited file. *Every* FROM string should start with \\\\` or ^.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
87 Do not use `~' in the TO strings.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
88 They should be ordinary absolute directory names.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
89
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Use this feature when you have directories which you normally refer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 via absolute symbolic links or to eliminate automounter mount points
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 from the beginning of your filenames. Make TO the name of the link,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 and FROM the name it is linked to."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 :type '(repeat (cons :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 :value ("\\`" . "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (regexp :tag "From")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (regexp :tag "To")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (defcustom make-backup-files t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 "*Non-nil means make a backup of a file the first time it is saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 This can be done by renaming the file or by copying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Renaming means that XEmacs renames the existing file so that it is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 backup file, then writes the buffer into a new file. Any other names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 that the old file had will now refer to the backup file. The new file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 is owned by you and its group is defaulted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Copying means that XEmacs copies the existing file into the backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 file, then writes the buffer on top of the existing file. Any other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 names that the old file had will now refer to the new (edited) file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 The file's owner and group are unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 The choice of renaming or copying is controlled by the variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 `backup-by-copying', `backup-by-copying-when-linked' and
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
116 `backup-by-copying-when-mismatch' and
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
117 `backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 ;; Do this so that local variables based on the file name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;; are not overridden by the major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (defvar backup-inhibited nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 "Non-nil means don't make a backup, regardless of the other parameters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 This variable is intended for use by making it local to a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 But it is local only if you make it local.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (put 'backup-inhibited 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (defcustom backup-by-copying nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 "*Non-nil means always use copying to create backup files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 See documentation of variable `make-backup-files'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (defcustom backup-by-copying-when-linked nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 "*Non-nil means use copying to create backups for files with multiple names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 This causes the alternate names to refer to the latest version as edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 This variable is relevant only if `backup-by-copying' is nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (defcustom backup-by-copying-when-mismatch nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 "*Non-nil means create backups by copying if this preserves owner or group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Renaming may still be used (subject to control of other variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 when it would not result in changing the owner or group of the file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 that is, for files which are owned by you and whose group matches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 the default for a new file created there by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 This variable is relevant only if `backup-by-copying' is nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
152 (defcustom backup-by-copying-when-privileged-mismatch 200
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
153 "*Non-nil means create backups by copying to preserve a privileged owner.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
154 Renaming may still be used (subject to control of other variables)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
155 when it would not result in changing the owner of the file or if the owner
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
156 has a user id greater than the value of this variable. This is useful
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
157 when low-numbered uid's are used for special system users (such as root)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
158 that must maintain ownership of certain files.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
159 This variable is relevant only if `backup-by-copying' and
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
160 `backup-by-copying-when-mismatch' are nil."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
161 :type '(choice (const nil) integer)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
162 :group 'backup)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
163
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
164 (defun normal-backup-enable-predicate (name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
165 "Default `backup-enable-predicate' function.
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
166 Checks for files in the directory returned by `temp-directory' or specified
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
167 by `small-temporary-file-directory'."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
168 (let ((temporary-file-directory (temp-directory)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
169 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
170 name 0 nil)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
171 ;; Directory is under temporary-file-directory.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
172 (and (not (eq comp t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
173 (< comp (- (length temporary-file-directory)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
174 (if small-temporary-file-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
175 (let ((comp (compare-strings small-temporary-file-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
176 0 nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
177 name 0 nil)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
178 ;; Directory is under small-temporary-file-directory.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
179 (and (not (eq comp t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
180 (< comp (- (length small-temporary-file-directory))))))))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
181
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
182 (defvar backup-enable-predicate 'normal-backup-enable-predicate
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 "Predicate that looks at a file name and decides whether to make backups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 Called with an absolute file name as argument, it returns t to enable backup.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (defcustom buffer-offer-save nil
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
187 "*Non-nil in a buffer means always offer to save buffer on exit.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
188 Do so even if the buffer is not visiting a file.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Automatically local in all buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (make-variable-buffer-local 'buffer-offer-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ;; FSF uses normal defconst
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (defvaralias 'find-file-visit-truename 'find-file-use-truenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (defcustom revert-without-query nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 "*Specify which files should be reverted without query.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 The value is a list of regular expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 If the file name matches one of these regular expressions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 then `revert-buffer' reverts the file without querying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 if the file has changed on disk and you have not edited the buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 :type '(repeat (regexp ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (defvar buffer-file-number nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 "The device number and file number of the file visited in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 The value is a list of the form (FILENUM DEVNUM).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 This pair of numbers uniquely identifies the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 If the buffer is visiting a new file, the value is nil.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (make-variable-buffer-local 'buffer-file-number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (put 'buffer-file-number 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 "Non-nil means that buffer-file-number uniquely identifies files.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
218 ;; FSF 21.2. We use (temp-directory).
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
219 ; (defvar temporary-file-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
220 ; (file-name-as-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
221 ; (cond ((memq system-type '(ms-dos windows-nt))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
222 ; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
223 ; ((memq system-type '(vax-vms axp-vms))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
224 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
225 ; (t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
226 ; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
227 ; "The directory for writing temporary files.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
228
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
229 (defvar small-temporary-file-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
230 (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
231 "The directory for writing small temporary files.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
232 If non-nil, this directory is used instead of `temporary-file-directory'
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
233 by programs that create small temporary files. This is for systems that
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
234 have fast storage with limited space, such as a RAM disk.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
235
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
236 ; (defvar file-name-invalid-regexp
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
237 ; (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
238 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
239 ; "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
240 ; "[\000-\031]\\|" ; control characters
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
241 ; "\\(/\\.\\.?[^/]\\)\\|" ; leading dots
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
242 ; "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
243 ; ((memq system-type '(ms-dos windows-nt))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
244 ; (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
245 ; "[|<>\"?*\000-\031]")) ; invalid characters
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
246 ; (t "[\000]"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
247 ; "Regexp recognizing file names which aren't allowed by the filesystem.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
248
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (defcustom file-precious-flag nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 "*Non-nil means protect against I/O errors while saving files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Some modes set this non-nil in particular buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 This feature works by writing the new contents into a temporary file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 and then renaming the temporary file to replace the original.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 In this way, any I/O error in writing leaves the original untouched,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 and there is never any instant where the file is nonexistent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 Note that this feature forces backups to be made by copying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 Yet, at the same time, saving a precious file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 breaks any hard links between it and other files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (defcustom version-control nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 "*Control use of version numbers for backup files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 t means make numeric backup versions unconditionally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 nil means make them for files that have some already.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 `never' means do not make them."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
269 :type '(choice (const :tag "Never" never)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
270 (const :tag "If existing" nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
271 (other :tag "Always" t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 :group 'backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 :group 'vc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 ;; This is now defined in efs.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
276 ; (defcustom dired-kept-versions 2
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
277 ; "*When cleaning directory, number of versions to keep."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
278 ; :type 'integer
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
279 ; :group 'backup
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
280 ; :group 'dired)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
2103
19834ffbffc4 [xemacs-hg @ 2004-05-29 23:57:41 by adrian]
adrian
parents: 2030
diff changeset
282 (defcustom delete-old-versions (when noninteractive 'leave)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 "*If t, delete excess backup versions silently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 If nil, ask confirmation. Any other value prevents any trimming."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 :type '(choice (const :tag "Delete" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (const :tag "Ask" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (sexp :tag "Leave" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (defcustom kept-old-versions 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 "*Number of oldest versions to keep when a new numbered backup is made."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (defcustom kept-new-versions 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 "*Number of newest versions to keep when a new numbered backup is made.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 Includes the new backup. Must be > 0"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (defcustom require-final-newline nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 "*Value of t says silently ensure a file ends in a newline when it is saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 Non-nil but not t says ask user whether to add a newline when there isn't one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 nil means don't add newlines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 :type '(choice (const :tag "Off" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (const :tag "Add" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (sexp :tag "Ask" :format "%t\n" ask))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (defcustom auto-save-default t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 "*Non-nil says by default do auto-saving of every file-visiting buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 :group 'auto-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (defcustom auto-save-visited-file-name nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 Normally auto-save files are written under other names."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 :group 'auto-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
321 (defcustom auto-save-file-name-transforms
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
322 `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
323 ,(expand-file-name "\\2" (temp-directory))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
324 "*Transforms to apply to buffer file name before making auto-save file name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
325 Each transform is a list (REGEXP REPLACEMENT):
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
326 REGEXP is a regular expression to match against the file name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
327 If it matches, `replace-match' is used to replace the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
328 matching part with REPLACEMENT.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
329 All the transforms in the list are tried, in the order they are listed.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
330 When one transform applies, its result is final;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
331 no further transforms are tried.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
332
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
333 The default value is set up to put the auto-save file into the temporary
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
334 directory (see the function `temp-directory') for editing a remote file."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
335 :group 'auto-save
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
336 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
337 ;:version "21.1"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
338 )
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
339
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (defcustom save-abbrevs nil
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
341 "*Non-nil means save word abbrevs too when files are saved.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
342 If `silently', don't ask the user before saving.
1337
5f6cef39d81f [xemacs-hg @ 2003-03-03 10:21:24 by stephent]
stephent
parents: 1333
diff changeset
343 Loading an abbrev file sets this to t."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
344 :type '(choice (const t) (const nil) (const silently))
1337
5f6cef39d81f [xemacs-hg @ 2003-03-03 10:21:24 by stephent]
stephent
parents: 1333
diff changeset
345 :group 'abbrev)
5f6cef39d81f [xemacs-hg @ 2003-03-03 10:21:24 by stephent]
stephent
parents: 1333
diff changeset
346
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (defcustom find-file-run-dired t
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
348 "*Non-nil means allow `find-file' to visit directories.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
349 To visit the directory, `find-file' runs `find-directory-functions'."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
350 :type 'boolean
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
351 :group 'find-file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
352
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
353 (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
354 "*List of functions to try in sequence to visit a directory.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
355 Each function is called with the directory name as the sole argument
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
356 and should return either a buffer or nil."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
357 :type '(hook :options (cvs-dired-noselect dired-noselect))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;;;It is not useful to make this a local variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 ;;;(put 'find-file-not-found-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (defvar find-file-not-found-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 "List of functions to be called for `find-file' on nonexistent file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 These functions are called as soon as the error is detected.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
365 Variable `buffer-file-name' is already set up.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 The functions are called in the order given until one of them returns non-nil.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ;;;It is not useful to make this a local variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 ;;;(put 'find-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defvar find-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "List of functions to be called after a buffer is loaded from a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 The buffer's local variables (if any) will have been processed before the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 functions are called.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (defvar write-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 "List of functions to be called before writing out a buffer to a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 and the rest are not called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 These hooks are considered to pertain to the visited file.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
380 So any buffer-local binding of `write-file-hooks' is
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
381 discarded if you change the visited file name with \\[set-visited-file-name].
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
382
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
383 Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 See also `write-contents-hooks' and `continue-save-buffer'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;;; However, in case someone does make it local...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (put 'write-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (defvar local-write-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 "Just like `write-file-hooks', except intended for per-buffer use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 The functions in this list are called before the ones in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 `write-file-hooks'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 This variable is meant to be used for hooks that have to do with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 particular visited file. Therefore, it is a permanent local, so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 changing the major mode does not clear it. However, calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 `set-visited-file-name' does clear it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (make-variable-buffer-local 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (put 'local-write-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 ;; #### think about this (added by Sun).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (put 'after-set-visited-file-name-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defvar after-set-visited-file-name-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 "List of functions to be called after \\[set-visited-file-name]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 or during \\[write-file].
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
406 You can use this hook to restore local values of `write-file-hooks',
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
407 `after-save-hook', and `revert-buffer-function', which pertain
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 to a specific file and therefore are normally killed by a rename.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
409 Put hooks pertaining to the buffer contents on `write-contents-hooks'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
410 and `revert-buffer-insert-file-contents-function'.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (defvar write-contents-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 "List of functions to be called before writing out a buffer to a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 and the rest are not called.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
416
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
417 This variable is meant to be used for hooks that pertain to the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
418 buffer's contents, not to the particular visited file; thus,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
419 `set-visited-file-name' does not clear this variable; but changing the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
420 major mode does clear it.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
421
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
422 This variable automatically becomes buffer-local whenever it is set.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
423 If you use `add-hook' to add elements to the list, use nil for the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
424 LOCAL argument.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
425
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 See also `write-file-hooks' and `continue-save-buffer'.")
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
427 (make-variable-buffer-local 'write-contents-hooks)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 ;; XEmacs addition
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 ;; Energize needed this to hook into save-buffer at a lower level; we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 ;; to provide a new output method, but don't want to have to duplicate all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 ;; of the backup file and file modes logic.that does not occur if one uses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 ;; a write-file-hook which returns non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (put 'write-file-data-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (defvar write-file-data-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 "List of functions to be called to put the bytes on disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 These functions receive the name of the file to write to as argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 The default behavior is to call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (write-region (point-min) (point-max) filename nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 and the rest are not called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 These hooks are considered to pertain to the visited file.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
443 So any buffer-local binding of `write-file-data-hooks' is
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
444 discarded if you change the visited file name with \\[set-visited-file-name].
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 See also `write-file-hooks'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (defcustom enable-local-variables t
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
448 "*Control use of local variables in files you visit.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 The value can be t, nil or something else.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
450 A value of t means file local variables specifications are obeyed;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 nil means they are ignored; anything else means query.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
452 This variable also controls use of major modes specified in
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
453 a -*- line.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
454
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
455 The command \\[normal-mode], when used interactively,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
456 always obeys file local variable specifications and the -*- line,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 and ignores this variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 :type '(choice (const :tag "Obey" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (const :tag "Ignore" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (sexp :tag "Query" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
463 ; (defvar local-enable-local-variables t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
464 ; "Like `enable-local-variables' but meant for buffer-local bindings.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
465 ; The meaningful values are nil and non-nil. The default is non-nil.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
466 ; If a major mode sets this to nil, buffer-locally, then any local
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
467 ; variables list in the file will be ignored.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
468
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
469 ; This variable does not affect the use of major modes
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
470 ; specified in a -*- line.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
471
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (defcustom enable-local-eval 'maybe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 "*Control processing of the \"variable\" `eval' in a file's local variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 The value can be t, nil or something else.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 A value of t means obey `eval' variables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 nil means ignore them; anything else means query.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 The command \\[normal-mode] always obeys local-variables lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 and ignores this variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 :type '(choice (const :tag "Obey" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (const :tag "Ignore" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (sexp :tag "Query" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (or (fboundp 'lock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (defalias 'lock-buffer 'ignore))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (or (fboundp 'unlock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (defalias 'unlock-buffer 'ignore))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
490 (or (fboundp 'file-locked-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
491 (defalias 'file-locked-p 'ignore))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
492
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
493 (defvar view-read-only nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
494 "*Non-nil means buffers visiting files read-only, do it in view mode.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 ;;FSFmacs bastardized ange-ftp cruft
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 ;(defun ange-ftp-completion-hook-function (op &rest args)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
498 ; "Provides support for ange-ftp host name completion.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
499 ;Runs the usual ange-ftp hook, but only for completion operations."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
500 ; ;; Having this here avoids the need to load ange-ftp when it's not
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
501 ; ;; really in use.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ; (if (memq op '(file-name-completion file-name-all-completions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 ; (apply 'ange-ftp-hook-function op args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ; (let ((inhibit-file-name-handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 ; (cons 'ange-ftp-completion-hook-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 ; (and (eq inhibit-file-name-operation op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 ; inhibit-file-name-handlers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 ; (inhibit-file-name-operation op))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 ; (apply op args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
511 ;; FSF 21.2:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
512 ;This function's standard definition is trivial; it just returns the argument.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
513 ;However, on some systems, the function is redefined with a definition
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
514 ;that really does change some file names to canonicalize certain
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
515 ;patterns and to guarantee valid names."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (defun convert-standard-filename (filename)
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
517 "Convert a standard file's name to something suitable for the current OS."
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
518 (if (eq system-type 'windows-nt)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
519 (let ((name (copy-sequence filename))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
520 (start 0))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
521 ;; leave ':' if part of drive specifier
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
522 (if (and (> (length name) 1)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
523 (eq (aref name 1) ?:))
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
524 (setq start 2))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
525 ;; destructively replace invalid filename characters with !
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
526 (while (string-match "[?*:<>|\"\000-\037]" name start)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
527 (aset name (match-beginning 0) ?!)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
528 (setq start (match-end 0)))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
529 ;; FSF: [convert directory separators to Windows format ...]
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
530 ;; unneeded in XEmacs.
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
531 name)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
532 filename))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
533
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (defun pwd ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 "Show the current default directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (interactive nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (message "Directory %s" default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (defvar cd-path nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 "Value of the CDPATH environment variable, as a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Not actually set up until the first time you use it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (defvar cdpath-previous nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 "Prior value of the CDPATH environment variable.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (defun parse-colon-path (cd-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 "Explode a colon-separated search path into a list of directory names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 If you think you want to use this, you probably don't. This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 is provided for backward compatibility. A more robust implementation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 of the same functionality is available as `split-path', which see."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (and cd-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (let (cd-list (cd-start 0) cd-colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (setq cd-path (concat cd-path path-separator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (while (setq cd-colon (string-match path-separator cd-path cd-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (setq cd-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (nconc cd-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (list (if (= cd-start cd-colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (substitute-in-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (substring cd-path cd-start cd-colon)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (setq cd-start (+ cd-colon 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 cd-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (defun cd-absolute (dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 "Change current directory to given absolute file name DIR."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 ;; Put the name into directory syntax now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 ;; because otherwise expand-file-name may give some bad results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (setq dir (file-name-as-directory dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 ;; XEmacs change: stig@hackvan.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (if find-file-use-truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (setq dir (file-truename dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (setq dir (abbreviate-file-name (expand-file-name dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (cond ((not (file-directory-p dir))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
577 (if (file-exists-p dir)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
578 (error "%s is not a directory" dir)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
579 (error "%s: no such directory" dir)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ;;((not (file-executable-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ;; (error "Cannot cd to %s: Permission denied" dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (setq default-directory dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (defun cd (dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 "Make DIR become the current buffer's default directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 If your environment includes a `CDPATH' variable, try each one of that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 colon-separated list of directories when resolving a relative directory name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 ;; XEmacs change? (read-file-name => read-directory-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (list (read-directory-name "Change default directory: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 default-directory default-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (and (member cd-path '(nil ("./")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (null (getenv "CDPATH"))))))
4645
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
596
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
597 (let* ((cdpath-current (getenv "CDPATH"))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
598 (trypath (if cdpath-current
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
599 (split-path (setq cdpath-previous cdpath-current))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
600 nil))) ; null list
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
601 (if (file-name-absolute-p dir)
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
602 (cd-absolute (expand-file-name dir))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
603 ;; XEmacs change. I'm not sure respecting CDPATH is the right thing to
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
604 ;; do under Windows.
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
605 (unless (and cd-path (equal cdpath-current cdpath-previous))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
606 (setq cd-path (or (and trypath
4640
8cef85a39d2c Make CDPATH handling portable, accept entries not matching "/$".
Aidan Kehoe <kehoea@parhasard.net>
parents: 4400
diff changeset
607 (mapcar #'file-name-as-directory trypath))
4645
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
608 (list (file-name-as-directory "")))))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
609 (or (catch 'found
4783
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
610 (mapc #'(lambda (x)
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
611 (let ((f (expand-file-name (concat x dir))))
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
612 (if (file-directory-p f)
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
613 (progn
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
614 (cd-absolute f)
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
615 (throw 'found t)))))
e29fcfd8df5f Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4720
diff changeset
616 cd-path)
4645
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
617 nil)
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
618 ;; jwz: give a better error message to those of us with the
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
619 ;; good taste not to use a kludge like $CDPATH.
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
620 (if (equal cd-path '("./"))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
621 (error "No such directory: %s" (expand-file-name dir))
f2a991ff6db0 Do not #'split-path on nil #'getenv result. <877hz7lzrt.fsf@yahoo.com.cn>
Jerry James <james@xemacs.org>
parents: 4640
diff changeset
622 (error "Directory not found in $CDPATH: %s" dir))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (defun load-file (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 "Load the Lisp file named FILE."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
626 ;; This is a case where .elc makes a lot of sense.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
627 (interactive (list (let ((completion-ignored-extensions
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
628 (remove ".elc" completion-ignored-extensions)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
629 (read-file-name "Load file: "))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (load (expand-file-name file) nil nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 ; We now dump utils/lib-complete.el which has improved versions of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 ;(defun load-library (library)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 ; "Load the library named LIBRARY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 ;This is an interface to the function `load'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 ; (interactive "sLoad library: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 ; (load library))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 ;(defun find-library (library)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 ; "Find the library of Lisp code named LIBRARY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 ;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 ; (interactive "sFind library file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 ; (let ((f (locate-file library load-path ":.el:")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 ; (if f
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 ; (find-file f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 ; (error "Couldn't locate library %s" library))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
648 (defun file-local-copy (file)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 "Copy the file FILE into a temporary file on this machine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 Returns the name of the local copy, or nil, if FILE is directly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 accessible."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
652 ;; This formerly had an optional BUFFER argument that wasn't used by
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
653 ;; anything.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (let ((handler (find-file-name-handler file 'file-local-copy)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (funcall handler 'file-local-copy file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 ;; XEmacs change block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 ; We have this in C and use the realpath() system call.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 ;(defun file-truename (filename &optional counter prev-dirs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 ; [... lots of code snipped ...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 ; filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 ;; XEmacs addition. Called from `insert-file-contents-internal'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ;; at the appropriate time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (defun compute-buffer-file-truename (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 "Recompute BUFFER's value of `buffer-file-truename'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 based on the current value of `buffer-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 BUFFER defaults to the current buffer if unspecified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (set-buffer (or buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (cond ((null buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (setq buffer-file-truename nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ((setq buffer-file-truename (file-truename buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 ;; it exists, we're done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 ;; the file doesn't exist, but maybe the directory does.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (let* ((dir (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (truedir (file-truename dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (if truedir (setq dir truedir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (setq buffer-file-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (expand-file-name (file-name-nondirectory buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 dir)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (if (and find-file-use-truenames buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (setq buffer-file-name (abbreviate-file-name buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 default-directory (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 buffer-file-truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 ;; End XEmacs change block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (defun file-chase-links (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 "Chase links in FILENAME until a name that is not a link.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 Does not examine containing directories for links,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 unlike `file-truename'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (let (tem (count 100) (newname filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (while (setq tem (file-symlink-p newname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (if (= count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (error "Apparent cycle of symbolic links for %s" filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (while (string-match "//+" tem)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
704 (setq tem (replace-match "/" nil nil tem)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 ;; Handle `..' by hand, since it needs to work in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 ;; target of any directory symlink.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 ;; This code is not quite complete; it does not handle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (setq tem (substring tem 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (setq newname (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 ;; Do the .. by hand.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (directory-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (file-name-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 ;; Chase links in the default dir of the symlink.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 (file-chase-links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (directory-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (file-name-directory newname))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (setq newname (expand-file-name tem (file-name-directory newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (setq count (1- count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 newname))
4266
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
722
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
723 (defun make-temp-file (prefix &optional dir-flag suffix)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
724 "Create a temporary file.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
725 The returned file name (created by appending some random characters at the
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
726 end of PREFIX, and expanding against the return value of `temp-directory' if
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
727 necessary), is guaranteed to point to a newly created empty file. You can
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
728 then use `write-region' to write new data into the file.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
729
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
730 If DIR-FLAG is non-nil, create a new empty directory instead of a file.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
731
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
732 If SUFFIX is non-nil, add that at the end of the file name.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
733
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
734 This function is analagous to mkstemp(3) under POSIX, avoiding the race
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
735 condition between testing for the existence of the generated filename (under
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
736 POSIX with mktemp(3), under Emacs Lisp with `make-temp-name') and creating
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
737 it."
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
738 (let ((umask (default-file-modes))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
739 (temporary-file-directory (temp-directory))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
740 file)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
741 (unwind-protect
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
742 (progn
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
743 ;; Create temp files with strict access rights. It's easy to
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
744 ;; loosen them later, whereas it's impossible to close the
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
745 ;; time-window of loose permissions otherwise.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
746 (set-default-file-modes #o700)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
747 (while (condition-case ()
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
748 (progn
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
749 (setq file
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
750 (make-temp-name
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
751 (expand-file-name prefix
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
752 temporary-file-directory)))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
753 (if suffix
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
754 (setq file (concat file suffix)))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
755 (if dir-flag
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
756 (make-directory file)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
757 (write-region "" nil file nil 'silent nil 'excl))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
758 nil)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
759 (file-already-exists t))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
760 ;; the file was somehow created by someone else between
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
761 ;; `make-temp-name' and `write-region', let's try again.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
762 nil)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
763 file)
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
764 ;; Reset the umask.
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
765 (set-default-file-modes umask))))
c5a2b80bc4fa [xemacs-hg @ 2007-11-14 18:51:20 by aidan]
aidan
parents: 4156
diff changeset
766
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (defun switch-to-other-buffer (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 "Switch to the previous buffer. With a numeric arg, n, switch to the nth
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 most recent buffer. With an arg of 0, buries the current buffer at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 bottom of the buffer stack."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (if (eq arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (bury-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (switch-to-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (if (<= arg 1) (other-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (nth (1+ arg) (buffer-list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
779 ;;FSF 21.2
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
780 ;Optional second arg NORECORD non-nil means
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
781 ;do not put this buffer at the front of the list of recently selected ones.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
782 (defun switch-to-buffer-other-window (buffer) ;;FSF 21.2: &optional norecord
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
783 "Select buffer BUFFER in another window.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
784
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
785 This uses the function `display-buffer' as a subroutine; see its
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
786 documentation for additional customization information."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
787 (interactive "BSwitch to buffer in other window: ")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (let ((pop-up-windows t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 ;; XEmacs: this used to have (selected-frame) as the third argument,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 ;; but this is obnoxious. If the user wants the buffer in a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ;; different frame, then it should be this way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 ;; Change documented above undone --mrb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (pop-to-buffer buffer t (selected-frame))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
795 ;(pop-to-buffer buffer t norecord)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
796
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
797 ;; FSF 21.2:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
798 ; (defun switch-to-buffer-other-frame (buffer &optional norecord)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
799 ; "Switch to buffer BUFFER in another frame.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
800 ; Optional second arg NORECORD non-nil means
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
801 ; do not put this buffer at the front of the list of recently selected ones.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
802
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
803 ; This uses the function `display-buffer' as a subroutine; see its
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
804 ; documentation for additional customization information."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
805 ; (interactive "BSwitch to buffer in other frame: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
806 ; (let ((pop-up-frames t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
807 ; (pop-to-buffer buffer t norecord)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
808 ; (raise-frame (window-frame (selected-window)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 (defun switch-to-buffer-other-frame (buffer)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
811 "Switch to buffer BUFFER in a newly-created frame.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
812
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
813 This uses the function `display-buffer' as a subroutine; see its
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
814 documentation for additional customization information."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (interactive "BSwitch to buffer in other frame: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (let* ((name (get-frame-name-for-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (frame (make-frame (if name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 (list (cons 'name (symbol-name name)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (pop-to-buffer buffer t frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
823 (defun switch-to-next-buffer (&optional n)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
824 "Switch to the next-most-recent buffer.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
825 This essentially rotates the buffer list forward.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
826 N (interactively, the prefix arg) specifies how many times to rotate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
827 forward, and defaults to 1. Buffers whose name begins with a space
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
828 \(i.e. \"invisible\" buffers) are ignored."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
829 ;; Here is a different interactive spec. Look up the function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
830 ;; `interactive' (i.e. `C-h f interactive') to understand how this
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
831 ;; all works.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
832 (interactive "p")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
833 (dotimes (n (or n 1))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
834 (loop
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
835 do (bury-buffer (car (buffer-list)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
836 while (funcall buffers-tab-omit-function (car (buffer-list))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
837 (switch-to-buffer (car (buffer-list)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
838
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
839 (defun switch-to-previous-buffer (&optional n)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
840 "Switch to the previously most-recent buffer.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
841 This essentially rotates the buffer list backward.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
842 N (interactively, the prefix arg) specifies how many times to rotate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
843 backward, and defaults to 1. Buffers whose name begins with a space
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
844 \(i.e. \"invisible\" buffers) are ignored."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
845 (interactive "p")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
846 (dotimes (n (or n 1))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
847 (loop
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
848 do (switch-to-buffer (car (last (buffer-list))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
849 while (funcall buffers-tab-omit-function (car (buffer-list))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
850
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
851 (defun switch-to-next-buffer-in-group (&optional n)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
852 "Switch to the next-most-recent buffer in the current group.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
853 This essentially rotates the buffer list forward.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
854 N (interactively, the prefix arg) specifies how many times to rotate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
855 forward, and defaults to 1. Buffers whose name begins with a space
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
856 \(i.e. \"invisible\" buffers) are ignored."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
857 (interactive "p")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
858 (dotimes (n (or n 1))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
859 (let ((curbuf (car (buffer-list))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
860 (loop
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
861 do (bury-buffer (car (buffer-list)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
862 while (or (funcall buffers-tab-omit-function (car (buffer-list)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
863 (not (funcall buffers-tab-selection-function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
864 curbuf (car (buffer-list)))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
865 (switch-to-buffer (car (buffer-list)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
866
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
867 (defun switch-to-previous-buffer-in-group (&optional n)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
868 "Switch to the previously most-recent buffer in the current group.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
869 This essentially rotates the buffer list backward.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
870 N (interactively, the prefix arg) specifies how many times to rotate
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
871 backward, and defaults to 1. Buffers whose name begins with a space
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
872 \(i.e. \"invisible\" buffers) are ignored."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
873 (interactive "p")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
874 (dotimes (n (or n 1))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
875 (let ((curbuf (car (buffer-list))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
876 (loop
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
877 do (switch-to-buffer (car (last (buffer-list))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
878 while (or (funcall buffers-tab-omit-function (car (buffer-list)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
879 (not (funcall buffers-tab-selection-function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
880 curbuf (car (buffer-list)))))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
881
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
882 (defmacro find-file-create-switch-thunk (switch-function)
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
883 "Mark buffer modified if needed, then call SWITCH-FUNCTION.
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
884
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
885 The buffer will be marked modified if the file associated with the buffer
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
886 does not exist. This means that \\[find-file] on a non-existent file will
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
887 create a modified buffer, making \\[save-buffer] sufficient to create the
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
888 file.
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
889
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
890 SWITCH-FUNCTION should be `switch-to-buffer' or a related function. This
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
891 function (that is, `find-file-create-switch-thunk') is implemented as a macro
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
892 because we don't have built-in lexical scope, a closure created with
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
893 `lexical-let' will always run as interpreted code. Though functions created
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
894 by this macro are unlikely to be called in performance-critical contexts.
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
895
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
896 This function may be called from functions related to `find-file', as well
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
897 as `find-file' itself."
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
898 `(function
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
899 (lambda (buffer)
4655
13273cffca2a Avoid errors in Dired when opening directories.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4649
diff changeset
900 (unless (and (buffer-file-name buffer)
13273cffca2a Avoid errors in Dired when opening directories.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4649
diff changeset
901 (file-exists-p (buffer-file-name buffer)))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
902 ;; XEmacs: nonexistent file--qualifies as a modification to the
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
903 ;; buffer.
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
904 (set-buffer-modified-p t buffer))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
905 (,switch-function buffer))))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
906
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
907 (defun find-file (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 "Edit file FILENAME.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
909 Switch to a buffer visiting file FILENAME, creating one if none already
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
910 exists. Optional second argument specifies the coding system to use when
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
911 decoding the file. Interactively, with a prefix argument, you will be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
912 prompted for the coding system.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
913
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
914 If you do not explicitly specify a coding system, the coding system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
915 is determined as follows:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
916
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
917 1. `coding-system-for-read', if non-nil. (This is used by Lisp programs to
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
918 temporarily set an overriding coding system and should almost never
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
919 apply here in `find-file'.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
920 2. The result of `insert-file-contents-pre-hook', if non-nil. (This is a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
921 complex interface for handling special cases.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
922 3. The matching value for this filename from `file-coding-system-alist',
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
923 if any. (This lets you specify the coding system to be used for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
924 files with particular extensions, names, etc.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
925 4. `buffer-file-coding-system-for-read', if non-nil. (This is the global
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
926 default -- normally `undecided', so the built-in auto-detection
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
927 mechanism can do its thing.)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
928 5. The coding system 'raw-text.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
929
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
930 See `insert-file-contents' for more details about how the process of
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
931 determining the coding system works.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
932
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
933 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
934 expand wildcards (if any) and visit multiple files. Wildcard expansion
1745
d91e7fd568fd [xemacs-hg @ 2003-10-14 16:10:05 by stephent]
stephent
parents: 1695
diff changeset
935 can be suppressed by setting `find-file-wildcards' to `nil'."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
936 (interactive (list (read-file-name "Find file: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
937 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
938 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
939 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
940 (and codesys (setq codesys (check-coding-system codesys)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
941 (let* ((coding-system-for-read (or codesys coding-system-for-read))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
942 (value (find-file-noselect filename nil nil wildcards))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
943 (thunk (find-file-create-switch-thunk switch-to-buffer)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
944 (if (listp value)
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
945 (mapcar thunk (nreverse value))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
946 (funcall thunk value))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
947
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
948 (defun find-file-other-window (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 "Edit file FILENAME, in another window.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
950 May create a new window, or reuse an existing one. See the function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
951 `display-buffer'. Optional second argument specifies the coding system to
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
952 use when decoding the file. Interactively, with a prefix argument, you
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
953 will be prompted for the coding system."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
954 (interactive (list (read-file-name "Find file in other window: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
955 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
956 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
957 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
958 (and codesys (setq codesys (check-coding-system codesys)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
959 (let* ((coding-system-for-read (or codesys coding-system-for-read))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
960 (value (find-file-noselect filename nil nil wildcards))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
961 (list (and (listp value) (nreverse value)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
962 (other-window-thunk (find-file-create-switch-thunk
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
963 switch-to-buffer-other-window)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
964 (if list
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
965 (cons
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
966 (funcall other-window-thunk (car list))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
967 (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
968 (funcall other-window-thunk value))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
969
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
970 (defun find-file-other-frame (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 "Edit file FILENAME, in a newly-created frame.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
972 Optional second argument specifies the coding system to use when decoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
973 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
974 the coding system."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
975 (interactive (list (read-file-name "Find file in other frame: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
976 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
977 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
978 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
979 (and codesys (setq codesys (check-coding-system codesys)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
980 (let* ((coding-system-for-read (or codesys coding-system-for-read))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
981 (value (find-file-noselect filename nil nil wildcards))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
982 (list (and (listp value) (nreverse value)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
983 (other-frame-thunk (find-file-create-switch-thunk
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
984 switch-to-buffer-other-frame)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
985 (if list
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
986 (cons
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
987 (funcall other-frame-thunk (car list))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
988 (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
989 (funcall other-frame-thunk value))))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
990
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
991 ;; No need to keep this macro around in the dumped executable.
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
992 (unintern 'find-file-create-switch-thunk)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
993
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
994 (defun find-file-read-only (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 "Edit file FILENAME but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 Like \\[find-file] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 Use \\[toggle-read-only] to permit editing.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
998 Optional second argument specifies the coding system to use when decoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
999 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1000 the coding system."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1001 (interactive (list (read-file-name "Find file read-only: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1002 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1003 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1004 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1005 (let ((value (find-file filename codesys wildcards)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1006 (mapcar #'(lambda (buffer)
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1007 (set-symbol-value-in-buffer 'buffer-read-only t buffer))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1008 (if (listp value) value (list value)))
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1009 value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1011 (defun find-file-read-only-other-window (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 "Edit file FILENAME in another window but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 Like \\[find-file-other-window] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 Use \\[toggle-read-only] to permit editing.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1015 Optional second argument specifies the coding system to use when decoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1016 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1017 the coding system."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1018 (interactive (list (read-file-name "Find file read-only other window: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1019 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1020 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1021 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1022 (find-file-other-window filename codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1026 (defun find-file-read-only-other-frame (filename &optional codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 "Edit file FILENAME in another frame but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 Like \\[find-file-other-frame] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 Use \\[toggle-read-only] to permit editing.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1030 Optional second argument specifies the coding system to use when decoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1031 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1032 the coding system."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1033 (interactive (list (read-file-name "Find file read-only other frame: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1034 (and current-prefix-arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1035 (read-coding-system "Coding system: "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1036 t))
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1037 (find-file-other-frame filename codesys wildcards)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (defun find-alternate-file-other-window (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 "Find file FILENAME as a replacement for the file in the next window.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1043 This command does not select that window. Optional second argument
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1044 specifies the coding system to use when decoding the file. Interactively,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (save-selected-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (other-window 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (let ((file buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (file-dir nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (and file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (setq file-name (file-name-nondirectory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 file-dir (file-name-directory file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (list (read-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 "Find alternate file: " file-dir nil nil file-name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1057 (if current-prefix-arg (read-coding-system "Coding-system: "))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (if (one-window-p)
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1059 (find-file-other-window filename codesys)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 (save-selected-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 (other-window 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 (find-alternate-file filename codesys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (defun find-alternate-file (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 "Find file FILENAME, select its buffer, kill previous buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 If the current buffer now contains an empty file that you just visited
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1067 \(presumably by mistake), use this command to visit the file you really
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1068 want. Optional second argument specifies the coding system to use when
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1069 decoding the file. Interactively, with a prefix argument, you will be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1070 prompted for the coding system."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (let ((file buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (file-dir nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (and file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 (setq file-name (file-name-nondirectory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 file-dir (file-name-directory file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 (list (read-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 "Find alternate file: " file-dir nil nil file-name)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
1080 (if current-prefix-arg (read-coding-system "Coding-system: ")))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 (and (buffer-modified-p) (buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 ;; (not buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (not (yes-or-no-p (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 "Buffer %s is modified; kill anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (error "Aborted"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 (let ((obuf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 (ofile buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 (onum buffer-file-number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (otrue buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 (oname (buffer-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (if (get-buffer " **lose**")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (kill-buffer " **lose**"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (rename-buffer " **lose**")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (setq buffer-file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 (setq buffer-file-number nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 (setq buffer-file-truename nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (unlock-buffer)
4648
907697569a49 Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4645
diff changeset
1101 (find-file filename codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 (cond ((eq obuf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 (setq buffer-file-name ofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (setq buffer-file-number onum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (setq buffer-file-truename otrue)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 (lock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 (rename-buffer oname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 (or (eq (current-buffer) obuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 (kill-buffer obuf))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1110
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 (defun create-file-buffer (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 "Create a suitably named buffer for visiting FILENAME, and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 FILENAME (sans directory) is used unchanged if that name is free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 otherwise a string <2> or <3> or ... is appended to get an unused name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 (let ((handler (find-file-name-handler filename 'create-file-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (funcall handler 'create-file-buffer filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (let ((lastname (file-name-nondirectory filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 (if (string= lastname "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (setq lastname filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (generate-new-buffer lastname)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (defun generate-new-buffer (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 "Create and return a buffer with a name based on NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 Choose the buffer's name using `generate-new-buffer-name'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (get-buffer-create (generate-new-buffer-name name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 (defvar abbreviated-home-dir nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 (defun abbreviate-file-name (filename &optional hack-homedir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1133 Type \\[describe-variable] directory-abbrev-alist RET for more information.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 \"~\" for the user's home directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (funcall handler 'abbreviate-file-name filename hack-homedir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 ;; Get rid of the prefixes added by the automounter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 ;;(if (and (string-match automount-dir-prefix filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 ;; (file-exists-p (file-name-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 ;; (substring filename (1- (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 ;; (setq filename (substring filename (1- (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (let ((tail directory-abbrev-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 ;; If any elt of directory-abbrev-alist matches this name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 ;; abbreviate accordingly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 (while tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 (when (string-match (car (car tail)) filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 (concat (cdr (car tail)) (substring filename (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 (setq tail (cdr tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (when hack-homedir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 ;; Compute and save the abbreviated homedir name.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1154 ;; We defer computing this until the first time it's needed,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1155 ;; to give time for directory-abbrev-alist to be set properly.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1156 ;; We include the separator at the end, to avoid spurious
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1157 ;; matches such as `/usr/foobar' when the home dir is
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1158 ;; `/usr/foo'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 (or abbreviated-home-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 (setq abbreviated-home-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 (let ((abbreviated-home-dir "$foo"))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1162 (concat "\\`"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1163 (regexp-quote
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1164 (abbreviate-file-name (expand-file-name "~")))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1165 "\\("
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1166 (regexp-quote (string directory-sep-char))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1167 "\\|\\'\\)"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 ;; If FILENAME starts with the abbreviated homedir,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 ;; make it start with `~' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 (if (and (string-match abbreviated-home-dir filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 ;; If the home dir is just /, don't change it.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1172 (not (and (= (match-end 0) 1)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1173 (= (aref filename 0) directory-sep-char)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1174 (not (and (eq system-type 'windows-nt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 (save-match-data
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1176 (string-match (concat "\\`[a-zA-Z]:"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1177 (regexp-quote
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1178 (string directory-sep-char))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1179 "\\'")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1180 filename)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 (concat "~"
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1183 (match-string 1 filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 (substring filename (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (defcustom find-file-not-true-dirname-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 "*List of logical names for which visiting shouldn't save the true dirname."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 :type '(repeat (string :tag "Name"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 ;; This function is needed by FSF vc.el. I hope somebody can make it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 ;; work for XEmacs. -sb.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 ;; #### In what way does it not work? --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 (defun find-buffer-visiting (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 "Return the buffer visiting file FILENAME (a string).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 This is like `get-file-buffer', except that it checks for any buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 visiting the same file, possibly under a different name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 If there is no such live buffer, return nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 (let ((buf (get-file-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 (truename (abbreviate-file-name (file-truename filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 (or buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 (let ((list (buffer-list)) found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 (while (and (not found) list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 (set-buffer (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 (if (and buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 (string= buffer-file-truename truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 (setq found (car list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 found)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1212 (let* ((attributes (file-attributes truename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1213 (number (nthcdr 10 attributes))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1214 (list (buffer-list)) found)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 (and buffer-file-numbers-unique
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 (while (and (not found) list)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1218 (with-current-buffer (car list)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1219 (if (and buffer-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1220 (equal buffer-file-number number)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 ;; Verify this buffer's file number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 ;; still belongs to its file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 (file-exists-p buffer-file-name)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1224 (equal (file-attributes buffer-file-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1225 attributes))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 (setq found (car list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 (setq list (cdr list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 found))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1229
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1230 (defcustom find-file-wildcards t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1231 "*Non-nil means file-visiting commands should handle wildcards.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1232 For example, if you specify `*.c', that would visit all the files
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1233 whose names match the pattern."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1234 :group 'files
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1235 ; :version "20.4"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1236 :type 'boolean)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1237
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1238 (defcustom find-file-suppress-same-file-warnings nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1239 "*Non-nil means suppress warning messages for symlinked files.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1240 When nil, Emacs prints a warning when visiting a file that is already
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1241 visited, but with a different name. Setting this option to t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1242 suppresses this warning."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1243 :group 'files
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1244 ; :version "21.1"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1245 :type 'boolean)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1246
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1247 (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1248 "Read file FILENAME into a buffer and return the buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1249 If a buffer exists visiting FILENAME, return that one, but
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1250 verify that the file has not changed since visited or saved.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1251 The buffer is not selected, just returned to the caller.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1252 If NOWARN is non-nil, warning messages will be suppressed.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1253 If RAWFILE is non-nil, the file is read literally."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1254 (setq filename
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1255 (abbreviate-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1256 (expand-file-name filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1257 (if (file-directory-p filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1258 (or (and find-file-run-dired
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1259 (loop for fn in find-directory-functions
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1260 for x = (and (fboundp fn)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1261 (funcall fn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1262 (if find-file-use-truenames
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1263 (abbreviate-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1264 (file-truename filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1265 filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1266 if x
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1267 return x))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1268 (error "%s is a directory" filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1269 (if (and wildcards
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1270 find-file-wildcards
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1271 (not (string-match "\\`/:" filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1272 (string-match "[[*?]" filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1273 (let ((files (condition-case nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1274 (file-expand-wildcards filename t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1275 (error (list filename))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1276 (find-file-wildcards nil))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1277 (if (null files)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1278 (find-file-noselect filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1279 (mapcar #'find-file-noselect files)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1280 (let* ((buf (get-file-buffer filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1281 (truename (abbreviate-file-name (file-truename filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1282 (number (nthcdr 10 (file-attributes truename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1283 ; ;; Find any buffer for a file which has same truename.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1284 ; (other (and (not buf) (find-buffer-visiting filename)))
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
1285 )
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1286
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1287 ; ;; Let user know if there is a buffer with the same truename.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1288 ; (if other
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1289 ; (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1290 ; (or nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1291 ; find-file-suppress-same-file-warnings
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1292 ; (string-equal filename (buffer-file-name other))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1293 ; (message "%s and %s are the same file"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1294 ; filename (buffer-file-name other)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1295 ; ;; Optionally also find that buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1296 ; (if (or find-file-existing-other-name find-file-visit-truename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1297 ; (setq buf other))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1298
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1299 (when (and buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1300 (or find-file-compare-truenames find-file-use-truenames)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1301 (not find-file-suppress-same-file-warnings)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1302 (not nowarn))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1303 (save-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1304 (set-buffer buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1305 (if (not (string-equal buffer-file-name filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1306 (message "%s and %s are the same file (%s)"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1307 filename buffer-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1308 buffer-file-truename))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1309
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1310 (if buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1311 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1312 (or nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1313 (verify-visited-file-modtime buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1314 (cond ((not (file-exists-p filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1315 (error "File %s no longer exists!" filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1316 ;; Certain files should be reverted automatically
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1317 ;; if they have changed on disk and not in the buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1318 ((and (not (buffer-modified-p buf))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1319 (dolist (rx revert-without-query nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1320 (when (string-match rx filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1321 (return t))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1322 (with-current-buffer buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1323 (message "Reverting file %s..." filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1324 (revert-buffer t t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1325 (message "Reverting file %s... done" filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1326 ((yes-or-no-p
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1327 (if (string= (file-name-nondirectory filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1328 (buffer-name buf))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1329 (format
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1330 (if (buffer-modified-p buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1331 (gettext "File %s changed on disk. Discard your edits? ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1332 (gettext "File %s changed on disk. Reread from disk? "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1333 (file-name-nondirectory filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1334 (format
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1335 (if (buffer-modified-p buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1336 (gettext "File %s changed on disk. Discard your edits in %s? ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1337 (gettext "File %s changed on disk. Reread from disk into %s? "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1338 (file-name-nondirectory filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1339 (buffer-name buf))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1340 (with-current-buffer buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1341 (revert-buffer t t)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1342 (when (not (eq rawfile (not (null find-file-literally))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1343 (with-current-buffer buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1344 (if (buffer-modified-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1345 (if (y-or-n-p (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1346 "Save file and revisit literally? "
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1347 "Save file and revisit non-literally? "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1348 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1349 (save-buffer)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1350 (find-file-noselect-1 buf filename nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1351 rawfile truename number))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1352 (if (y-or-n-p (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1353 "Discard your edits and revisit file literally? "
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1354 "Discard your edits and revisit file non-literally? "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1355 (find-file-noselect-1 buf filename nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1356 rawfile truename number)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1357 (error (if rawfile "File already visited non-literally"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1358 "File already visited literally"))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1359 (if (y-or-n-p (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1360 "Revisit file literally? "
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1361 "Revisit file non-literally? "))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1362 (find-file-noselect-1 buf filename nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1363 rawfile truename number)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1364 (error (if rawfile "File already visited non-literally"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1365 "File already visited literally"))))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1366 ;; Return the buffer we are using.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1367 buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1368 ;; Create a new buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1369 (setq buf (create-file-buffer filename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1370 ;; Catch various signals, such as QUIT, and kill the buffer
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1371 ;; in that case.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1372 (condition-case data
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1373 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1374 (set-buffer-major-mode buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1375 ;; find-file-noselect-1 may use a different buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1376 (find-file-noselect-1 buf filename nowarn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1377 rawfile truename number))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1378 (t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1379 (kill-buffer buf)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1380 (signal (car data) (cdr data)))))))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1381
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1382 (defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1383 (let ((inhibit-read-only t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1384 error)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1385 (with-current-buffer buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1386 (kill-local-variable 'find-file-literally)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1387 ;; Needed in case we are re-visiting the file with a different
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1388 ;; text representation.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1389 (kill-local-variable 'buffer-file-coding-system)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1390 (erase-buffer)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1391 ; (and (default-value 'enable-multibyte-characters)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1392 ; (not rawfile)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1393 ; (set-buffer-multibyte t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1394 (condition-case ()
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1395 (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1396 (insert-file-contents-literally filename t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1397 (insert-file-contents filename t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1398 (file-error
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1399 (when (and (file-exists-p filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1400 (not (file-readable-p filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1401 (signal 'file-error (list "File is not readable" filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1402 (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1403 ;; Unconditionally set error
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1404 (setq error t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1405 (or
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1406 ;; Run find-file-not-found-hooks until one returns non-nil.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1407 (run-hook-with-args-until-success 'find-file-not-found-hooks)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1408 ;; If they fail too, set error.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1409 (setq error t)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1410 ;; Find the file's truename, and maybe use that as visited name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1411 ;; automatically computed in XEmacs, unless jka-compr was used!
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1412 (unless buffer-file-truename
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1413 (setq buffer-file-truename truename))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1414 (setq buffer-file-number number)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1415 (and find-file-use-truenames
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1416 ;; This should be in C. Put pathname
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1417 ;; abbreviations that have been explicitly
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1418 ;; requested back into the pathname. Most
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1419 ;; importantly, strip out automounter /tmp_mnt
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1420 ;; directories so that auto-save will work
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1421 (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1422 ;; Set buffer's default directory to that of the file.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1423 (setq default-directory (file-name-directory buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1424 ;; Turn off backup files for certain file names. Since
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1425 ;; this is a permanent local, the major mode won't eliminate it.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1426 (and (not (funcall backup-enable-predicate buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1427 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1428 (make-local-variable 'backup-inhibited)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1429 (setq backup-inhibited t)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1430 (if rawfile
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1431 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1432 (setq buffer-file-coding-system 'no-conversion)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1433 (make-local-variable 'find-file-literally)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1434 (setq find-file-literally t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1435 (after-find-file error (not nowarn))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1436 (setq buf (current-buffer)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1437 (current-buffer))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1438
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1439 (defun insert-file-contents-literally (filename &optional visit start end replace)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1440 "Like `insert-file-contents', but only reads in the file literally.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1441 A buffer may be modified in several ways after reading into the buffer,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1442 due to Emacs features such as format decoding, character code
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1443 conversion, `find-file-hooks', automatic uncompression, etc.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1444
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1445 This function ensures that none of these modifications will take place."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1446 (let ((wrap-func (find-file-name-handler filename
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1447 'insert-file-contents-literally)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1448 (if wrap-func
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1449 (funcall wrap-func 'insert-file-contents-literally filename
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1450 visit start end replace)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1451 (let ((file-name-handler-alist nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1452 (format-alist nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1453 (after-insert-file-functions nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1454 (coding-system-for-read 'binary)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1455 (coding-system-for-write 'binary)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1456 (find-buffer-file-type-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1457 (if (fboundp 'find-buffer-file-type)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1458 (symbol-function 'find-buffer-file-type)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1459 nil))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1460 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1461 (inhibit-file-name-operation 'insert-file-contents))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1462 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1463 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1464 (fset 'find-buffer-file-type (lambda (filename) t))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1465 (insert-file-contents filename visit start end replace))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1466 (if find-buffer-file-type-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1467 (fset 'find-buffer-file-type find-buffer-file-type-function)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1468 (fmakunbound 'find-buffer-file-type)))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1470 (defun insert-file-literally (filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1471 "Insert contents of file FILENAME into buffer after point with no conversion.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1472
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1473 This function is meant for the user to run interactively.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1474 Don't call it from programs! Use `insert-file-contents-literally' instead.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1475 \(Its calling sequence is different; see its documentation)."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1476 (interactive "*fInsert file literally: ")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 (if (file-directory-p filename)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1478 (signal 'file-error (list "Opening input file" "file is a directory"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1479 filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1480 (let ((tem (insert-file-contents-literally filename)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1481 (push-mark (+ (point) (car (cdr tem))))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1482
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1483 (defvar find-file-literally nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1484 "Non-nil if this buffer was made by `find-file-literally' or equivalent.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1485 This is a permanent local.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1486 (put 'find-file-literally 'permanent-local t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1487
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1488 (defun find-file-literally (filename)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1489 "Visit file FILENAME with no conversion of any kind.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1490 Format conversion and character code conversion are both disabled,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1491 and multibyte characters are disabled in the resulting buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1492 The major mode used is Fundamental mode regardless of the file name,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1493 and local variable specifications in the file are ignored.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1494 Automatic uncompression and adding a newline at the end of the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1495 file due to `require-final-newline' is also disabled.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1496
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1497 You cannot absolutely rely on this function to result in
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1498 visiting the file literally. If Emacs already has a buffer
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1499 which is visiting the file, you get the existing buffer,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1500 regardless of whether it was created literally or not.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1501
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1502 In a Lisp program, if you want to be sure of accessing a file's
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1503 contents literally, you should create a temporary buffer and then read
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1504 the file contents into it using `insert-file-contents-literally'."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1505 (interactive "FFind file literally: ")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1506 (switch-to-buffer (find-file-noselect filename nil t)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 (defvar after-find-file-from-revert-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (defun after-find-file (&optional error warn noauto
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 after-find-file-from-revert-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 nomodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 "Called after finding a file and by the default revert function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 Sets buffer mode, parses local variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 error in reading the file. WARN non-nil means warn if there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 exists an auto-save file more recent than the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 NOAUTO means don't mess with auto-save mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 means this call was from `revert-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 Fifth arg NOMODES non-nil means don't alter the file's modes.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1522 Finishes by calling the functions in `find-file-hooks'
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1523 unless NOMODES is non-nil."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 (if noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 (let* (not-serious
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 (msg
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1529 (cond
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1530 ((not warn) nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1531 ((and error (file-attributes buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1532 (setq buffer-read-only t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1533 (gettext "File exists, but cannot be read."))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1534 ((not buffer-read-only)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1535 (if (and warn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1536 (file-newer-than-file-p (make-auto-save-file-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1537 buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1538 (format "%s has auto save data; consider M-x recover-file"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1539 (file-name-nondirectory buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1540 (setq not-serious t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1541 (if error (gettext "(New file)") nil)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1542 ((not error)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1543 (setq not-serious t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1544 (gettext "Note: file is write protected"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1545 ((file-attributes (directory-file-name default-directory))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1546 (gettext "File not found and directory write-protected"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1547 ((file-exists-p (file-name-directory buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1548 (setq buffer-read-only nil))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1549 (t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1550 ;; If the directory the buffer is in doesn't exist,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1551 ;; offer to create it. It's better to do this now
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1552 ;; than when we save the buffer, because we want
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1553 ;; autosaving to work.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1554 (setq buffer-read-only nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1555 ;; XEmacs
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1556 (or (file-exists-p (file-name-directory buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1557 (condition-case nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1558 (if (yes-or-no-p
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1559 (format
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1560 "\
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 The directory containing %s does not exist. Create? "
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1562 (abbreviate-file-name buffer-file-name)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1563 (make-directory (file-name-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1564 buffer-file-name)
4649
3972966a4588 Kill buffer if directory name misspelled and user doesn't want to create it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4648
diff changeset
1565 t)
3972966a4588 Kill buffer if directory name misspelled and user doesn't want to create it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4648
diff changeset
1566 (kill-buffer (current-buffer)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1567 (quit
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1568 (kill-buffer (current-buffer))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1569 (signal 'quit nil))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1570 nil))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 (if msg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 (message "%s" msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 (or not-serious (sit-for 1 t)))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1575 (when (and auto-save-default (not noauto))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (auto-save-mode t)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1577 ;; Make people do a little extra work (C-x C-q)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1578 ;; before altering a backup file.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1579 (when (backup-file-name-p buffer-file-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1580 (setq buffer-read-only t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (unless nomodes
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1582 ;; #### No view-mode-disable.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1583 ; (when view-read-only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1584 ; (and-boundp 'view-mode (view-mode-disable)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 (normal-mode t)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1586 (when (and buffer-read-only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1587 view-read-only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1588 (not (eq (get major-mode 'mode-class) 'special)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1589 (view-mode))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 (run-hooks 'find-file-hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 (defun normal-mode (&optional find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 "Choose the major mode for this buffer automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 Also sets up any specified local variables of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 Uses the visited file name, the -*- line, and the local variables spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 This function is called automatically from `find-file'. In that case,
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1598 we may set up the file-specified mode and local variables,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1599 depending on the value of `enable-local-variables': if it is t, we do;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1600 if it is nil, we don't; otherwise, we query.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1601 In addition, if `local-enable-local-variables' is nil, we do
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1602 not set local variables (though we do notice a mode specified with -*-.)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1603
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1604 `enable-local-variables' is ignored if you run `normal-mode' interactively,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1605 or from Lisp without specifying the optional argument FIND-FILE;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1606 in that case, this function acts as if `enable-local-variables' were t."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (or find-file (funcall (or default-major-mode 'fundamental-mode)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1609 (and (with-trapping-errors
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1610 :operation "File mode specification"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1611 :class 'file-mode-spec
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1612 :error-form nil
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1613 (set-auto-mode)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1614 t)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1615 (with-trapping-errors
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1616 :operation "File local-variables"
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1617 :class 'local-variables
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1618 :error-form nil
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1619 ;; FSF 21.2:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1620 ; (let ((enable-local-variables (or (not find-file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1621 ; enable-local-variables)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1622 ; (hack-local-variables))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 792
diff changeset
1623 (hack-local-variables (not find-file)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1625 ;; END SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1626
1024
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1627 ;; `auto-mode-alist' used to contain entries for modes in core and in packages.
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1628 ;; The applicable entries are now located in the corresponding modes in
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1629 ;; packages, the ones here are for core modes. Ditto for
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1630 ;; `interpreter-mode-alist' below.
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1631 ;; Per Abrahamsen suggested splitting auto-mode-alist to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 ;; several distinct variables such as, in order of precedence,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 ;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 ;; packages and `auto-mode-alist' (which might also be called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 ;; `default-auto-mode-alist') for default stuff, such as some of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 ;; entries below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 (defvar auto-mode-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 '(("\\.te?xt\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 ("\\.el\\'" . emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 ("\\.article\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 ("\\.letter\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 ;; Mailer puts message to be edited in /tmp/Re.... or Message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 ;; #### Unix-specific!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 ("\\`/tmp/Re" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 ("/Message[0-9]*\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 ;; some news reader is reported to use this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 ("^/tmp/fol/" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 ;; .emacs following a directory delimiter in either Unix or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 ;; Windows syntax.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 ("\\.ml\\'" . lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 "Alist of filename patterns vs. corresponding major mode functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 \(NON-NIL stands for anything that is not nil; the value does not matter.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 Visiting a file whose name matches REGEXP specifies FUNCTION as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 mode function to use. FUNCTION will be called, unless it is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 If the element has the form (REGEXP FUNCTION NON-NIL), then after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 calling FUNCTION (if it's not nil), we delete the suffix that matched
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 REGEXP and search the list again for another match.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 (defvar interpreter-mode-alist
1024
ccaf90c5a53a [xemacs-hg @ 2002-10-02 09:29:37 by stephent]
stephent
parents: 988
diff changeset
1666 '(("emacs" . emacs-lisp-mode))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 "Alist mapping interpreter names to major modes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 This alist is used to guess the major mode of a file based on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 contents of the first line. This line often contains something like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 #!/bin/sh
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 but may contain something more imaginative like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 #! /bin/env python
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 eval 'exec perl -w -S $0 ${1+\"$@\"}'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 Each alist element looks like (INTERPRETER . MODE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 The car of each element is a regular expression which is compared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 with the name of the interpreter specified in the first line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 If it matches, mode MODE is selected.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 (defvar binary-file-regexps
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1682 '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 "List of regexps of filenames containing binary (non-text) data.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 ; (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 ; (require 'regexp-opt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 ; (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 ; (format "\\.\\(?:%s\\)\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 ; (regexp-opt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 ; '("tar"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 ; "tgz"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 ; "gz"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 ; "bz2"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 ; "Z"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 ; "o"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 ; "elc"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 ; "png"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 ; "gif"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 ; "tiff"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 ; "jpg"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 ; "jpeg"))))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1702
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 (defvar inhibit-first-line-modes-regexps
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1704 binary-file-regexps
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 "List of regexps; if one matches a file name, don't look for `-*-'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 (defvar inhibit-first-line-modes-suffixes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 When checking `inhibit-first-line-modes-regexps', we first discard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 from the end of the file name anything that matches one of these regexps.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1712 ;; Junk from FSF 21.2. Unnecessary in XEmacs, since `interpreter-mode-alist'
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1713 ;; can have regexps.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1714 ; (defvar auto-mode-interpreter-regexp
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1715 ; "#![ \t]?\\([^ \t\n]*\
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1716 ; /bin/env[ \t]\\)?\\([^ \t\n]+\\)"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1717 ; "Regular expression matching interpreters, for file mode determination.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1718 ; This regular expression is matched against the first line of a file
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1719 ; to determine the file's mode in `set-auto-mode' when Emacs can't deduce
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1720 ; a mode from the file's name. If it matches, the file is assumed to
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1721 ; be interpreted by the interpreter matched by the second group of the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1722 ; regular expression. The mode is then determined as the mode associated
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1723 ; with that interpreter in `interpreter-mode-alist'.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
1724
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 (defvar user-init-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 nil ; set by command-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 "File name including directory of user's initialization file.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 (defun set-auto-mode (&optional just-from-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 "Select major mode appropriate for current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 This checks for a -*- mode tag in the buffer's text,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 compares the filename against the entries in `auto-mode-alist',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 or checks the interpreter that runs this file against
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 `interpreter-mode-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 It does not check for the `mode:' local variable in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 Local Variables section of the file; for that, use `hack-local-variables'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 If `enable-local-variables' is nil, this function does not check for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 -*- mode tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 If the optional argument JUST-FROM-FILE-NAME is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 then we do not set anything but the major mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 and we don't even do that unless it would come from the file name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 ;; Do this by calling the hack-local-variables helper to avoid redundancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 ;; We bind enable-local-variables to nil this time because we're going to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 ;; call hack-local-variables-prop-line again later, "for real." Note that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 ;; this temporary binding does not prevent hack-local-variables-prop-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 ;; from setting the major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 (or (and enable-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 (let ((enable-local-variables nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 (hack-local-variables-prop-line nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 ;; It's not in the -*- line, so check the auto-mode-alist, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 ;; this buffer isn't associated with a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 (null buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 (let ((name (file-name-sans-versions buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 (keep-going t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 (while keep-going
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 (setq keep-going nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 (let ((alist auto-mode-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 (mode nil))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1765
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 ;; Find first matching alist entry.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1767
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1768 ;; #### This is incorrect. In NT, case sensitivity is a volume
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1769 ;; property. For instance, NFS mounts *are* case sensitive.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1770 ;; Need internal function (file-name-case-sensitive f), F
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1771 ;; being file or directory name. - kkm
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 (let ((case-fold-search
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1773 (eq system-type 'windows-nt)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 (while (and (not mode) alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 (if (string-match (car (car alist)) name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 (if (and (consp (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 (nth 2 (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 (setq mode (car (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 name (substring name 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 keep-going t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 (setq mode (cdr (car alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 keep-going nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 (setq alist (cdr alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 (unless just-from-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 ;; If we can't deduce a mode from the file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 ;; look for an interpreter specified in the first line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 (if (and (null mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 (save-excursion ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 (looking-at "#!")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 (let ((firstline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 (goto-char (point-min)) (end-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 (setq alist interpreter-mode-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 (while alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 (if (string-match (car (car alist)) firstline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 (setq mode (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 (setq alist nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 (setq alist (cdr alist)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 (if mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 (if (not (fboundp mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 (let ((name (package-get-package-provider mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 (if name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 (message "Mode %s is not installed. Download package %s" mode name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (message "Mode %s either doesn't exist or is not a known package" mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 (sit-for 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 (error "%s" mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 (unless (and just-from-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 ;; Don't reinvoke major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 (eq mode major-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 ;; Don't lose on minor modes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 (assq mode minor-mode-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 (funcall mode))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 (defvar hack-local-variables-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 "Normal hook run after processing a file's local variables specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 Major modes can use this to examine user-specified local variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 in order to initialize other data structure based on them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 This hook runs even if there were no local variables or if their
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 evaluation was suppressed. See also `enable-local-variables' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 `enable-local-eval'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (defun hack-local-variables (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 "Parse, and bind or evaluate as appropriate, any local variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 for current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 ;; Don't look for -*- if this file name matches any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 ;; of the regexps in inhibit-first-line-modes-regexps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 (if (or (null buffer-file-name) ; don't lose if buffer has no file!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 (not (let ((temp inhibit-first-line-modes-regexps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 (name (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 (file-name-sans-versions buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 (buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 (while (let ((sufs inhibit-first-line-modes-suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 (while (and sufs (not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 (string-match (car sufs) name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 (setq sufs (cdr sufs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 sufs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 (setq name (substring name 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 (while (and temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (not (string-match (car temp) name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (setq temp (cdr temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 temp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 ;; Look for variables in the -*- line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 (hack-local-variables-prop-line force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 ;; Look for "Local variables:" block in last page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 (hack-local-variables-last-page force)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 (run-hooks 'hack-local-variables-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 ;;; Local variables may be specified in the last page of the file (within 3k
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 ;;; from the end of the file and after the last ^L) in the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 ;;; Local variables:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 ;;; variable-name: variable-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 ;;; end:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 ;;; The lines may begin with a common prefix, like ";;; " in the above
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 ;;; example. They may also have a common suffix (" */" for example). In
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 ;;; this form, the local variable "mode" can be used to change the major
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 ;;; mode, and the local variable "eval" can be used to evaluate an arbitrary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 ;;; form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 ;;; Local variables may also be specified in the first line of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 ;;; Embedded in this line are a pair of "-*-" sequences. What lies between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 ;;; them are variable-name/variable-value pairs, like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 ;;; -*- mode: emacs-lisp -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 ;;; or -*- mode: postscript; version-control: never -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 ;;; or -*- tags-file-name: "/foo/bar/TAGS" -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 ;;; The local variable "eval" is not used with this form. For hysterical
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 ;;; reasons, the syntax "-*- modename -*-" is allowed as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 (defun hack-local-variables-p (modeline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 (or (eq enable-local-variables t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (and enable-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (switch-to-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 ;; If we fail to switch in the selected window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 ;; it is probably a minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 ;; So try another window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 (switch-to-buffer-other-window (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 (switch-to-buffer-other-frame (current-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 (or modeline (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 (set-window-start (selected-window) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (y-or-n-p (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 "Set local variables as specified %s of %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 (if modeline "in -*- line" "at end")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 (file-name-nondirectory buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 (concat "buffer " (buffer-name)))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (defun hack-local-variables-last-page (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 ;; Set local variables set in the "Local Variables:" block of the last page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 (if (let ((case-fold-search t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (and (search-forward "Local Variables:" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (or force
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 (hack-local-variables-p nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (let ((continue t)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1915 prefix prefixlen suffix start
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (enable-local-eval enable-local-eval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 ;; The prefix is what comes before "local variables:" in its line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 ;; The suffix is what comes after "local variables:" in its line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 (or (eolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 (setq suffix (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 (progn (end-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (or (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 (setq prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (progn (beginning-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 (if prefix (setq prefixlen (length prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 prefix (regexp-quote prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 (while continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 ;; Look at next local variable spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 (if selective-display (re-search-forward "[\n\C-m]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 ;; Skip the prefix, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 (if prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 (if (looking-at prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 (forward-char prefixlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 (error "Local variables entry is missing the prefix")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 ;; Find the variable name; strip whitespace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 (skip-chars-forward " \t")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1942 (setq start (point))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 (skip-chars-forward "^:\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 (if (eolp) (error "Missing colon in local variables entry"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 (skip-chars-backward " \t")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1946 (let* ((str (buffer-substring start (point)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 (var (read str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 ;; Setting variable named "end" means end of list.
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
1950 (if (equalp str "end")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 (setq continue nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 ;; Otherwise read the variable value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 (skip-chars-forward "^:")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 (setq val (read (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 (skip-chars-backward "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 (or (if suffix (looking-at suffix) (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 (error "Local variables entry is terminated incorrectly"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 ;; Set the variable. "Variables" mode and eval are funny.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 (hack-one-local-variable var val))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 ;; jwz - New Version 20.1/19.15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 (defun hack-local-variables-prop-line (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 ;; Set local variables specified in the -*- line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 ;; Returns t if mode was set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 (let ((result nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 (skip-chars-forward " \t\n\r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 (let ((end (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 ;; If the file begins with "#!"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 ;; (un*x exec interpreter magic), look
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 ;; for mode frobs in the first two
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 ;; lines. You cannot necessarily
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 ;; put them in the first line of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 ;; such a file without screwing up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 ;; the interpreter invocation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 (end-of-line (and (looking-at "^#!") 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 ;; Parse the -*- line into the `result' alist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 (cond ((not (search-forward "-*-" end t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 ;; doesn't have one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 (setq force t))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1985 ((looking-at "[ \t]*\\([^ \t\n\r:;]+?\\)\\([ \t]*-\\*-\\)")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 ;; Antiquated form: "-*- ModeName -*-".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 (setq result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 (list (cons 'mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 (intern (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 (match-end 1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 ;; (last ";" is optional).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 (if (search-forward "-*-" end t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 (setq end (- (point) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 (error "-*- not terminated before end of line")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 (while (< (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 (error "malformed -*- line"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 (goto-char (match-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 ;; There used to be a downcase here,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 ;; but the manual didn't say so,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 ;; and people want to set var names that aren't all lc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (let ((key (intern (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 (val (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 (narrow-to-region (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 (read (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 ;; Case sensitivity! Icepicks in my forehead!
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 793
diff changeset
2014 (if (equalp (symbol-name key) "mode")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 (setq key 'mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 (setq result (cons (cons key val) result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 (skip-chars-forward " \t;")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 (setq result (nreverse result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 (let ((set-any-p (or force
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 ;; It's OK to force null specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 (null result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 ;; It's OK to force mode-only specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 (let ((remaining result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 (mode-specs-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 (while remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 (if (eq (car (car remaining)) 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 (setq remaining (cdr remaining))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 ;; Otherwise, we have a real local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 (setq mode-specs-only nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 remaining nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 mode-specs-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 ;; Otherwise, check.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 (hack-local-variables-p t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 (mode-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 (while result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 (let ((key (car (car result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 (val (cdr (car result))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 (cond ((eq key 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 (setq mode-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 (let ((mode (intern (concat (downcase (symbol-name val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 "-mode"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 ;; Without this guard, `normal-mode' would potentially run
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 ;; the major mode function twice: once via `set-auto-mode'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 ;; and once via `hack-local-variables'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 (if (not (eq mode major-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 (funcall mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 (set-any-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 (hack-one-local-variable key val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 (setq result (cdr result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 mode-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2057 ;; BEGIN SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2058
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 (defconst ignored-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 (list 'enable-local-eval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 "Variables to be ignored in a file's local variable spec.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 ;; Get confirmation before setting these variables as locals in a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 (put 'debugger 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 (put 'enable-local-eval 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 (put 'ignored-local-variables 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 (put 'eval 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 (put 'file-name-handler-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 (put 'minor-mode-map-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 (put 'after-load-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 (put 'buffer-file-name 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 (put 'buffer-auto-save-file-name 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 (put 'buffer-file-truename 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 (put 'exec-path 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 (put 'load-path 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 (put 'exec-directory 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 (put 'process-environment 'risky-local-variable t)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2078 (put 'dabbrev-case-fold-search 'risky-local-variable t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2079 (put 'dabbrev-case-replace 'risky-local-variable t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 (put 'outline-level 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 (put 'rmail-output-file-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 ;; This one is safe because the user gets to check it before it is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 (put 'compile-command 'safe-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2087 (defun hack-one-local-variable-quotep (exp)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2088 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2089
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 (defun hack-one-local-variable (var val)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2091 "\"Set\" one variable in a local variables spec.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2092 A few variable names are treated specially."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 (cond ((eq var 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 (funcall (intern (concat (downcase (symbol-name val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 "-mode"))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2096 ((eq var 'coding)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2097 ;; We have already handled coding: tag in set-auto-coding.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2098 nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 ((memq var ignored-local-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 ;; "Setting" eval means either eval it or do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 ;; Likewise for setting hook variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 ((or (get var 'risky-local-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 (and
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2105 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 (symbol-name var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 (not (get var 'safe-local-variable))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2108 ;; Permit evalling a put of a harmless property.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2109 ;; if the args do nothing tricky.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2110 (if (or (and (eq var 'eval)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2111 (consp val)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2112 (eq (car val) 'put)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2113 (hack-one-local-variable-quotep (nth 1 val))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2114 (hack-one-local-variable-quotep (nth 2 val))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2115 ;; Only allow safe values of lisp-indent-hook;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2116 ;; not functions.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2117 (or (numberp (nth 3 val))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2118 (equal (nth 3 val) ''defun))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2119 (memq (nth 1 (nth 2 val))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2120 '(lisp-indent-hook)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2121 ;; Permit eval if not root and user says ok.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2122 (and (not (zerop (user-uid)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2123 (or (eq enable-local-eval t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2124 (and enable-local-eval
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2125 (save-window-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2126 (switch-to-buffer (current-buffer))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2127 (save-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2128 (beginning-of-line)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2129 (set-window-start (selected-window) (point)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2130 (setq enable-local-eval
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2131 (y-or-n-p (format "Process `eval' or hook local variables in %s? "
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2132 (if buffer-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2133 (concat "file " (file-name-nondirectory buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2134 (concat "buffer " (buffer-name)))))))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 (if (eq var 'eval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 (save-excursion (eval val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 (make-local-variable var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 (set var val))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2139 (message "Ignoring `eval:' in the local variables list")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 ;; Ordinary variable, really set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 (t (make-local-variable var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 (set var val))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2143
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2144 (defun find-coding-system-magic-cookie-in-file (file)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2145 "Look for the coding-system magic cookie in FILE.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2146 The coding-system magic cookie is either the local variable specification
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2147 -*- ... coding: ... -*- on the first line, or the exact string
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2148 \";;;###coding system: \" somewhere within the first 3000 characters
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2149 of the file. If found, the coding system name (as a string) is returned;
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2150 otherwise nil is returned. Note that it is extremely unlikely that
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2151 either such string would occur coincidentally as the result of encoding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2152 some characters in a non-ASCII charset, and that the spaces make it
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2153 even less likely since the space character is not a valid octet in any
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2154 ISO 2022 encoding of most non-ASCII charsets."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2155 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2156 (with-temp-buffer
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2157 (let ((coding-system-for-read 'raw-text))
2434
ba1cb56059fb [xemacs-hg @ 2004-12-12 02:47:06 by ben]
ben
parents: 2116
diff changeset
2158 (insert-file-contents file nil 0 3000))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2159 (goto-char (point-min))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2160 (or (and (looking-at
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2161 "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2162 (buffer-substring (match-beginning 1) (match-end 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2163 ;; (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2164 ;; (let (start end)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2165 ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2166 ;; (setq start (match-end 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2167 ;; (re-search-forward "\n;+[ \t]*End:")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2168 ;; (setq end (match-beginning 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2169 ;; (save-restriction
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2170 ;; (narrow-to-region start end)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2171 ;; (goto-char start)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2172 ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2173 ;; )
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2174 ;; (let ((codesys
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2175 ;; (intern (buffer-substring
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2176 ;; (match-beginning 1)(match-end 1)))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2177 ;; (if (find-coding-system codesys) codesys))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2178 ;; )))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2179 (let ((case-fold-search nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2180 (if (search-forward
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2181 ";;;###coding system: " (+ (point-min) 3000) t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2182 (let ((start (point))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2183 (end (progn
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2184 (skip-chars-forward "^ \t\n\r")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2185 (point))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2186 (if (> end start) (buffer-substring start end))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2187 )))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2188 ))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2190
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 (defcustom change-major-mode-with-file-name t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 "*Non-nil means \\[write-file] should set the major mode from the file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 However, the mode will not be changed if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 \(1) a local variables list or the `-*-' line specifies a major mode, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 \(2) the current major mode is a \"special\" mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 \ not suitable for ordinary files, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 \(3) the new file name does not particularly specify any mode."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 (defun set-visited-file-name (filename &optional no-query along-with-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 "Change name of file visited in current buffer to FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 The next time the buffer is saved it will go in the newly specified file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 nil or empty string as argument means make buffer not be visiting any file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 Remember to delete the initial contents of the minibuffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 if you wish to pass an empty string as the argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 The optional second argument NO-QUERY, if non-nil, inhibits asking for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 confirmation in the case where another buffer is already visiting FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 The optional third argument ALONG-WITH-FILE, if non-nil, means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 the old visited file has been renamed to the new name FILENAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 (interactive "FSet visited file name: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 (if (buffer-base-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 (error "An indirect buffer cannot visit a file"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 (let (truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 (if (string-equal filename "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 (expand-file-name filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 (setq truename (file-truename filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 ;; #### Do we need to check if truename is non-nil?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (if find-file-use-truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 (setq filename truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 (let ((buffer (and filename (find-buffer-visiting filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 (and buffer (not (eq buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 (not no-query)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 (error "Aborted")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 (or (equal filename buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 (and filename (lock-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 (unlock-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 (setq buffer-file-name filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 (if filename ; make buffer name reflect filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 (let ((new-name (file-name-nondirectory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 (if (string= new-name "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 (error "Empty file name"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 (setq default-directory (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 (or (string= new-name (buffer-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 (rename-buffer new-name t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 (setq buffer-backed-up nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 (or along-with-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 (clear-visited-file-modtime))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 (compute-buffer-file-truename) ; insert-file-contents does this too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 ; ;; Abbreviate the file names of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 ; (if truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 ; (setq buffer-file-truename (abbreviate-file-name truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 ; (if find-file-visit-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 ; (setq buffer-file-name buffer-file-truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 (setq buffer-file-number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 (nthcdr 10 (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 ;; write-file-hooks is normally used for things like ftp-find-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 ;; that visit things that are not local files as if they were files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 ;; Changing to visit an ordinary local file instead should flush the hook.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 (kill-local-variable 'write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 (kill-local-variable 'after-save-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 (kill-local-variable 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 (kill-local-variable 'write-file-data-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 (kill-local-variable 'revert-buffer-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 (kill-local-variable 'backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 ;; If buffer was read-only because of version control,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 ;; that reason is gone now, so make it writable.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2271 (if-boundp 'vc-mode
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2272 (progn
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2273 (if vc-mode
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2274 (setq buffer-read-only nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2275 (kill-local-variable 'vc-mode)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 ;; Turn off backup files for certain file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 ;; Since this is a permanent local, the major mode won't eliminate it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 (and buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 (not (funcall backup-enable-predicate buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 (make-local-variable 'backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 (setq backup-inhibited t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 (let ((oauto buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 ;; If auto-save was not already on, turn it on if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 (if (not buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 (and buffer-file-name auto-save-default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 (auto-save-mode t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 ;; If auto save is on, start using a new name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 ;; We deliberately don't rename or delete the old auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 ;; for the old visited file name. This is because perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 ;; the user wants to save the new state and then compare with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 ;; previous state from the auto save file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 (make-auto-save-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 ;; Rename the old auto save file if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 (and oauto buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 (file-exists-p oauto)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 (rename-file oauto buffer-auto-save-file-name t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 (not along-with-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 (set-buffer-modified-p t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 ;; Update the major mode, if the file name determines it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 ;; Don't change the mode if it is special.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 (or (not change-major-mode-with-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 (get major-mode 'mode-class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 ;; Don't change the mode if the local variable list specifies it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 (hack-local-variables t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 (set-auto-mode t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 (error nil))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2311 ;; #### ?? not in FSF.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 (run-hooks 'after-set-visited-file-name-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 (defun write-file (filename &optional confirm codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 "Write current buffer into file FILENAME.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2316 This makes the buffer visit that file, and marks it as not modified.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2317
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2318 If you specify just a directory name as FILENAME, that means to use
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2319 the default file name but in that directory. You can also yank
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2320 the default file name into the minibuffer to edit it, using M-n.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2321
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2322 If the buffer is not already visiting a file, the default file name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2323 for the output file is the buffer name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2324
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2325 If optional second arg CONFIRM is non-nil, this function
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2326 asks for confirmation before overwriting an existing file.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2327 Interactively, this is always the case.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
2328
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
2329 Optional third argument specifies the coding system to use when encoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
2330 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
2331 the coding system."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 ;; (interactive "FWrite file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 (list (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (read-file-name "Write file: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 nil nil nil nil)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2337 (read-file-name "Write file: " default-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2338 (expand-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2339 (file-name-nondirectory (buffer-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2340 default-directory)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2341 nil nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 t
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
2343 (if current-prefix-arg (read-coding-system "Coding system: "))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 (and (eq (current-buffer) mouse-grabbed-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 (error "Can't write minibuffer window"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 (or (null filename) (string-equal filename "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 ;; If arg is just a directory,
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2349 ;; use the default file name, but in that directory.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2350 (if (file-directory-p filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 (setq filename (concat (file-name-as-directory filename)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2352 (file-name-nondirectory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2353 (or buffer-file-name (buffer-name))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 (and confirm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 (file-exists-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 (error "Canceled")))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2358 (set-visited-file-name filename (not confirm))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (set-buffer-modified-p t)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2360 ;; Make buffer writable if file is writable.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2361 (and buffer-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2362 (file-writable-p buffer-file-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2363 (setq buffer-read-only nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 (let ((buffer-file-coding-system (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 (save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 (save-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2369
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 (defun backup-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 "Make a backup of the disk file visited by the current buffer, if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 This is normally done before saving the buffer the first time.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2373 If the value is non-nil, it is the result of `file-modes' on the original
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2374 file; this means that the caller, after saving the buffer, should change
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2375 the modes of the new file to agree with the old modes.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2376
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2377 A backup may be done by renaming or by copying; see documentation of
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2378 variable `make-backup-files'. If it's done by renaming, then the file is
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2379 no longer accessible under its old name."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 (funcall handler 'backup-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 (if (and make-backup-files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 (not backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 (not buffer-backed-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 (file-exists-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 '(?- ?l)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 (let ((real-file-name buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 backup-info backupname targets setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 ;; If specified name is a symbolic link, chase it to the target.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 ;; Thus we make the backups in the directory where the real file is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (setq real-file-name (file-chase-links real-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 (setq backup-info (find-backup-file-name real-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 backupname (car backup-info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 targets (cdr backup-info))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 ;;; (if (file-directory-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 ;;; (error "Cannot save buffer in directory %s" buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 (if backup-info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 (let ((delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 ;; If have old versions to maybe delete,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 ;; ask the user to confirm now, before doing anything.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2405 ;; But don't actually delete till later.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 (and targets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 (or (eq delete-old-versions t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 (eq delete-old-versions nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 (or delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 (y-or-n-p (format "Delete excess backup versions of %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 real-file-name))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 ;; Actually write the back up file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 (if (or file-precious-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 ; (file-symlink-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 backup-by-copying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 (and backup-by-copying-when-linked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 (> (file-nlinks real-file-name) 1))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2419 (and (or backup-by-copying-when-mismatch
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2420 (integerp backup-by-copying-when-privileged-mismatch))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 (let ((attr (file-attributes real-file-name)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2422 (and (or backup-by-copying-when-mismatch
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2423 (and (integerp (nth 2 attr))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2424 (integerp backup-by-copying-when-privileged-mismatch)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2425 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2426 (or (nth 9 attr)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2427 (not (file-ownership-preserved-p real-file-name)))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 (copy-file real-file-name backupname t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 ;; If copying fails because file BACKUPNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 ;; is not writable, delete that file and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 (if (and (file-exists-p backupname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 (not (file-writable-p backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 (delete-file backupname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 (copy-file real-file-name backupname t t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 ;; rename-file should delete old backup.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 (rename-file real-file-name backupname t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 (setq setmodes (file-modes backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 (file-error
2710
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2441 ;; If trouble writing the backup, write
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2442 ;; it in `auto-save-directory'. Fall
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2443 ;; back to $HOME if that's not possible.
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2444 (setq backupname
2710
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2445 (expand-file-name "%backup%~"
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2446 (or (when (and auto-save-directory
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2447 (file-writable-p auto-save-directory))
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2448 auto-save-directory)
54fd042e254c [xemacs-hg @ 2005-04-03 23:57:36 by youngs]
youngs
parents: 2671
diff changeset
2449 (getenv "HOME"))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2450 (lwarn 'file 'alert "Cannot write backup file; backing up in %s"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2451 (file-name-nondirectory backupname))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 (sleep-for 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 (copy-file real-file-name backupname t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 ;; If copying fails because file BACKUPNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 ;; is not writable, delete that file and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 (if (and (file-exists-p backupname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 (not (file-writable-p backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 (delete-file backupname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 (copy-file real-file-name backupname t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 (setq buffer-backed-up t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 ;; Now delete the old versions, if desired.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 (if delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 (while targets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 (ignore-file-errors (delete-file (car targets)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 (setq targets (cdr targets))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 (file-error nil)))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 (defun file-name-sans-versions (name &optional keep-backup-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 "Return FILENAME sans backup versions or strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 This is a separate procedure so your site-init or startup file can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 redefine it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 If the optional argument KEEP-BACKUP-VERSION is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 we do not remove backup version numbers, only true file version numbers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (funcall handler 'file-name-sans-versions name keep-backup-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 (substring name 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 (if keep-backup-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 (length name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 (or (string-match "\\.~[0-9.]+~\\'" name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 (and pos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 ;; #### - is this filesystem check too paranoid?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 (file-exists-p (substring name 0 pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 (string-match "~\\'" name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 (length name)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 (defun file-ownership-preserved-p (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 "Return t if deleting FILE and rewriting it would preserve the owner."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 (funcall handler 'file-ownership-preserved-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 (let ((attributes (file-attributes file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 ;; Return t if the file doesn't exist, since it's true that no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 ;; information would be lost by an (attempted) delete and create.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 (or (null attributes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 (= (nth 2 attributes) (user-uid)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 (defun file-name-sans-extension (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 "Return FILENAME sans final \"extension\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 The extension, in a file name, is the part that follows the last `.'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 (if (string-match "\\.[^.]*\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 (if (setq directory (file-name-directory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 (expand-file-name (substring file 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 (substring file 0 (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 (defun file-name-extension (filename &optional period)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 "Return FILENAME's final \"extension\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 The extension, in a file name, is the part that follows the last `.'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 Return nil for extensionless file names such as `foo'.
3061
fd1acd2f457a [xemacs-hg @ 2005-11-13 07:39:26 by ben]
ben
parents: 2718
diff changeset
2521 Return the empty string for file names such as `foo'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 If PERIOD is non-nil, then the returned value includes the period
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 that delimits the extension, and if FILENAME has no extension,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 the value is \"\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 (if (string-match "\\.[^.]*\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 (substring file (+ (match-beginning 0) (if period 0 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 (if period
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 "")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2533 (defcustom make-backup-file-name-function nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2534 "A function to use instead of the default `make-backup-file-name'.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2535 A value of nil gives the default `make-backup-file-name' behaviour.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2536
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2537 This could be buffer-local to do something special for specific
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2538 files. If you define it, you may need to change `backup-file-name-p'
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2539 and `file-name-sans-versions' too.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2540
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2541 See also `backup-directory-alist'."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2542 :group 'backup
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2543 :type '(choice (const :tag "Default" nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2544 (function :tag "Your function")))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2545
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2546 (defcustom backup-directory-alist nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2547 "Alist of filename patterns and backup directory names.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2548 Each element looks like (REGEXP . DIRECTORY). Backups of files with
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2549 names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2550 relative or absolute. If it is absolute, so that all matching files
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2551 are backed up into the same directory, the file names in this
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2552 directory will be the full name of the file backed up with all
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2553 directory separators changed to `!' to prevent clashes. This will not
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2554 work correctly if your filesystem truncates the resulting name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2555
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2556 For the common case of all backups going into one directory, the alist
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2557 should contain a single element pairing \".\" with the appropriate
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2558 directory name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2559
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2560 If this variable is nil, or it fails to match a filename, the backup
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2561 is made in the original file's directory.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2562
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2563 On MS-DOS filesystems without long names this variable is always
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2564 ignored."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2565 :group 'backup
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2566 :type '(repeat (cons (regexp :tag "Regexp matching filename")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2567 (directory :tag "Backup directory name"))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2568
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 (defun make-backup-file-name (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 "Create the non-numeric backup file name for FILE.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2571 Normally this will just be the file's name with `~' appended.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2572 Customization hooks are provided as follows.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2573
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2574 If the variable `make-backup-file-name-function' is non-nil, its value
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2575 should be a function which will be called with FILE as its argument;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2576 the resulting name is used.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2577
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2578 Otherwise a match for FILE is sought in `backup-directory-alist'; see
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2579 the documentation of that variable. If the directory for the backup
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2580 doesn't exist, it is created."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2581 (if make-backup-file-name-function
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2582 (funcall make-backup-file-name-function file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2583 ; (if (and (eq system-type 'ms-dos)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2584 ; (not (msdos-long-file-names)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2585 ; (let ((fn (file-name-nondirectory file)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2586 ; (concat (file-name-directory file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2587 ; (or (and (string-match "\\`[^.]+\\'" fn)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2588 ; (concat (match-string 0 fn) ".~"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2589 ; (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2590 ; (concat (match-string 0 fn) "~")))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2591 (concat (make-backup-file-name-1 file) "~")))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2592
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2593 (defun make-backup-file-name-1 (file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2594 "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2595 (let ((alist backup-directory-alist)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2596 elt backup-directory dir-sep-string)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2597 (while alist
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2598 (setq elt (pop alist))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2599 (if (string-match (car elt) file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2600 (setq backup-directory (cdr elt)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2601 alist nil)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2602 (if (null backup-directory)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2603 file
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2604 (unless (file-exists-p backup-directory)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2605 (condition-case nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2606 (make-directory backup-directory 'parents)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2607 (file-error file)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2608 (if (file-name-absolute-p backup-directory)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2609 (progn
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2610 (when (memq system-type '(windows-nt ms-dos))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2611 ;; Normalize DOSish file names: convert all slashes to
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2612 ;; directory-sep-char, downcase the drive letter, if any,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2613 ;; and replace the leading "x:" with "/drive_x".
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2614 (or (file-name-absolute-p file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2615 (setq file (expand-file-name file))) ; make defaults explicit
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2616 ;; Replace any invalid file-name characters (for the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2617 ;; case of backing up remote files).
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2618 (setq file (expand-file-name (convert-standard-filename file)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2619 (setq dir-sep-string (char-to-string directory-sep-char))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2620 (if (eq (aref file 1) ?:)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2621 (setq file (concat dir-sep-string
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2622 "drive_"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2623 (char-to-string (downcase (aref file 0)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2624 (if (eq (aref file 2) directory-sep-char)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2625 ""
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2626 dir-sep-string)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2627 (substring file 2)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2628 ;; Make the name unique by substituting directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2629 ;; separators. It may not really be worth bothering about
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2630 ;; doubling `!'s in the original name...
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2631 (expand-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2632 (subst-char-in-string
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2633 directory-sep-char ?!
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2634 (replace-regexp-in-string "!" "!!" file))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2635 backup-directory))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2636 (expand-file-name (file-name-nondirectory file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2637 (file-name-as-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2638 (expand-file-name backup-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2639 (file-name-directory file))))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 (defun backup-file-name-p (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 "Return non-nil if FILE is a backup file name (numeric or not).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 This is a separate function so you can redefine it for customization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 You may need to redefine `file-name-sans-versions' as well."
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2645 (string-match "~\\'" file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2647 (defvar backup-extract-version-start)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2648
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 ;; This is used in various files.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2650 ;; The usage of backup-extract-version-start is not very clean,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2651 ;; but I can't see a good alternative, so as of now I am leaving it alone.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 (defun backup-extract-version (fn)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2653 "Given the name of a numeric backup file, FN, return the backup number.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2654 Uses the free variable `backup-extract-version-start', whose value should be
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 the index in the name where the version number begins."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2656 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2657 (= (match-beginning 0) backup-extract-version-start))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2658 (string-to-int (substring fn backup-extract-version-start -1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2661 ;; [[ FSF 21.2 says:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2662 ;; I believe there is no need to alter this behavior for VMS;
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2663 ;; since backup files are not made on VMS, it should not get called. ]]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 (defun find-backup-file-name (fn)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2665 "Find a file name for a backup file FN, and suggestions for deletions.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 Value is a list whose car is the name for the backup file
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2667 and whose cdr is a list of old versions to consider deleting now.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2668 If the value is nil, don't make a backup.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2669 Uses `backup-directory-alist' in the same way as does
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2670 `make-backup-file-name'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 ;; Run a handler for this function so that ange-ftp can refuse to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 (funcall handler 'find-backup-file-name fn)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2675 (if (or (eq version-control 'never)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2676 ;; We don't support numbered backups on plain MS-DOS
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2677 ;; when long file names are unavailable.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2678 ; (and (eq system-type 'ms-dos)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2679 ; (not (msdos-long-file-names)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2680 )
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 (list (make-backup-file-name fn))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2682 (let* ((basic-name (make-backup-file-name-1 fn))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2683 (base-versions (concat (file-name-nondirectory basic-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2684 ".~"))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2685 (backup-extract-version-start (length base-versions))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 (high-water-mark 0)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2687 (number-to-delete 0)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2688 possibilities deserve-versions-p versions)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 (setq possibilities (file-name-all-completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 base-versions
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2692 (file-name-directory basic-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2693 versions (sort (mapcar #'backup-extract-version
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2694 possibilities)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2695 #'<)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2696 high-water-mark (apply 'max 0 versions)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 deserve-versions-p (or version-control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 (> high-water-mark 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 number-to-delete (- (length versions)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2700 kept-old-versions
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2701 kept-new-versions
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2702 -1))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2703 (file-error (setq possibilities nil)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 (if (not deserve-versions-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 (list (make-backup-file-name fn))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2706 (cons (format "%s.~%d~" basic-name (1+ high-water-mark))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 (if (and (> number-to-delete 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 ;; Delete nothing if there is overflow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 ;; in the number of versions to keep.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 (>= (+ kept-new-versions kept-old-versions -1) 0))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2711 (mapcar (lambda (n)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2712 (format "%s.~%d~" basic-name n))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 (let ((v (nthcdr kept-old-versions versions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 (rplacd (nthcdr (1- number-to-delete) v) ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 v))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 (defun file-nlinks (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 "Return number of names file FILENAME has."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 (car (cdr (file-attributes filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 (defun file-relative-name (filename &optional directory)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2722 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 This function returns a relative file name which is equivalent to FILENAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 when used with that default directory as the default.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2725 If this is impossible (which can happen on MS Windows when the file name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2726 and directory use different drive names) then it returns FILENAME."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 (let ((fname (expand-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 (setq directory (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 (expand-file-name (or directory default-directory))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 ;; drive names, they can't be relative, so return the absolute name.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2733 (if (and (eq system-type 'windows-nt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 (not (string-equal (substring fname 0 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 (substring directory 0 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 (let ((ancestor ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 (fname-dir (file-name-as-directory fname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 (while (and (not (string-match (concat "^" (regexp-quote directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 fname-dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 (not (string-match (concat "^" (regexp-quote directory)) fname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 (setq directory (file-name-directory (substring directory 0 -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 ancestor (if (equal ancestor ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 ".."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 (concat "../" ancestor))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 ;; Now ancestor is empty, or .., or ../.., etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 (if (string-match (concat "^" (regexp-quote directory)) fname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 ;; We matched within FNAME's directory part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 ;; Add the rest of FNAME onto ANCESTOR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 (let ((rest (substring fname (match-end 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 (if (and (equal ancestor ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 (not (equal rest "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 ;; But don't bother with ANCESTOR if it would give us `./'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 (concat (file-name-as-directory ancestor) rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 ;; We matched FNAME's directory equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 ancestor))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 (defun save-buffer (&optional args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 "Save current buffer in visited file if modified. Versions described below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 By default, makes the previous version into a backup file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 if previously requested or if this is the first save.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2763 With 1 \\[universal-argument], marks this version
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 to become a backup when the next save is done.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2765 With 2 \\[universal-argument]'s,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 unconditionally makes the previous version into a backup file.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2767 With 3 \\[universal-argument]'s, marks this version
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2768 to become a backup when the next save is done,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2769 and unconditionally makes the previous version into a backup file.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2770
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2771 With argument of 0, never make the previous version into a backup file.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 If a file's name is FOO, the names of its numbered backup versions are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 Numeric backups (rather than FOO~) will be made if value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 `version-control' is not the atom `never' and either there are already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 numeric versions of the file being backed up, or `version-control' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 We don't want excessive versions piling up, so there are variables
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2780 `kept-old-versions', which tells Emacs how many oldest versions to keep,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 and `kept-new-versions', which tells how many newest versions to keep.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 Defaults are 2 old versions and 2 new.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 `dired-kept-versions' controls dired's clean-directory (.) command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 If `delete-old-versions' is nil, system will query user
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2785 before trimming versions. Otherwise it does it silently.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2786
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2787 If `vc-make-backup-files' is nil, which is the default,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2788 no backup files are made for files managed by version control.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2789 (This is because the version control system itself records previous versions.)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2790
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2791 See the subroutine `basic-save-buffer' for more information."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 (let ((modp (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 (large (> (buffer-size) 50000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 (make-backup-files (or (and make-backup-files (not (eq args 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 (memq args '(16 64)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2798 (if (and modp large (buffer-file-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2799 (display-message 'progress (format "Saving file %s..."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2800 (buffer-file-name))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 (basic-save-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 (defun delete-auto-save-file-if-necessary (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2806 Normally delete only if the file was written by this XEmacs since
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2807 the last real save, but optional arg FORCE non-nil means delete anyway."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 (and buffer-auto-save-file-name delete-auto-save-files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 (not (string= buffer-file-name buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 (or force (recent-auto-save-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 (ignore-file-errors (delete-file buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 (set-buffer-auto-saved))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 ;; XEmacs change (from Sun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 ;; used to communicate with continue-save-buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 (defvar continue-save-buffer-hooks-tail nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 ;; Not in FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 (defun basic-write-file-data (realname truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 ;; call the hooks until the bytes are put
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 ;; call write-region as a last resort
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 (let ((region-written nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 (hooks write-file-data-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 (while (and hooks (not region-written))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 (setq region-written (funcall (car hooks) realname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 (if (not region-written)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 (write-region (point-min) (point-max) realname nil t truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2831 ; (defvar auto-save-hook nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2832 ; "Normal hook run just before auto-saving.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2833
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 (put 'after-save-hook 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 (defvar after-save-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 "Normal hook that is run after a buffer is saved to its file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 These hooks are considered to pertain to the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 So this list is cleared if you change the visited file name.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2840 (defvar save-buffer-coding-system nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2841 "If non-nil, use this coding system for saving the buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2842 More precisely, use this coding system in place of the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2843 value of `buffer-file-coding-system', when saving the buffer.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2844 Calling `write-region' for any purpose other than saving the buffer
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2845 will still use `buffer-file-coding-system'; this variable has no effect
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2846 in such cases.")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2847
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2848 (make-variable-buffer-local 'save-buffer-coding-system)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2849 (put 'save-buffer-coding-system 'permanent-local t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2850
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 (defun files-fetch-hook-value (hook)
4156
346788f5aa64 [xemacs-hg @ 2007-08-31 08:34:25 by didierv]
didierv
parents: 4024
diff changeset
2852 (let ((localval (copy-list (symbol-value hook)))
346788f5aa64 [xemacs-hg @ 2007-08-31 08:34:25 by didierv]
didierv
parents: 4024
diff changeset
2853 (globalval (copy-list (default-value hook))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 (if (memq t localval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 (setq localval (append (delq t localval) (delq t globalval))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 localval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 (defun basic-save-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 "Save the current buffer in its visited file, if it has been modified.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2860 The hooks `write-contents-hooks', `local-write-file-hooks' and
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2861 `write-file-hooks' get a chance to do the job of saving; if they do not,
2116
ce294639d321 [xemacs-hg @ 2004-06-06 23:58:40 by adrian]
adrian
parents: 2103
diff changeset
2862 then the buffer is saved in the visited file in the usual way.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2863 After saving the buffer, this function runs `after-save-hook'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 (interactive)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2865 (save-current-buffer
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 ;; In an indirect buffer, save its base buffer instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 (if (buffer-base-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 (set-buffer (buffer-base-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 (if (buffer-modified-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 (let ((recent-save (recent-auto-save-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 ;; If buffer has no file name, ask user for one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 (or buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 (let ((filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 (read-file-name "File to save in: ") nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 (and (file-exists-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 (or (y-or-n-p (format "File `%s' exists; overwrite? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 (error "Canceled")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 (set-visited-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 (or (verify-visited-file-modtime (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 (not (file-exists-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 (format "%s has changed since visited or saved. Save anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 (file-name-nondirectory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 (error "Save not confirmed"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 (widen)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2889 (save-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2890 (and (> (point-max) 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2891 (not find-file-literally)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2892 (not (eq (char-after (1- (point-max))) ?\n))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2893 (not (and (eq selective-display t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2894 (eq (char-after (1- (point-max))) ?\r)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2895 (or (eq require-final-newline t)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2896 (and require-final-newline
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2897 (y-or-n-p
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2898 (format "Buffer %s does not end in newline. Add one? "
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2899 (buffer-name)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2900 (save-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2901 (goto-char (point-max))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2902 (insert ?\n))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2903
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2904 ;; Support VC version backups.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2905 (if-fboundp 'vc-before-save
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2906 (vc-before-save))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2907
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2908 ;; Run the write-file-hooks until one returns non-nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 ;; Bind after-save-hook to nil while running the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 ;; write-file-hooks so that if this function is called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 ;; recursively (from inside a write-file-hook) the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 ;; after-hooks will only get run once (from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 ;; outermost call).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 ;; Ugh, have to duplicate logic of run-hook-with-args-until-success
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 (files-fetch-hook-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 (files-fetch-hook-value 'write-file-hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 (after-save-hook nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 (local-write-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 (write-contents-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 (write-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 (while (and hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 (let ((continue-save-buffer-hooks-tail hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 (not (setq done (funcall (car hooks))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 (setq hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 ;; If a hook returned t, file is already "written".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 ;; Otherwise, write it the usual way now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 (if (not done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 (basic-save-buffer-1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 ;; XEmacs: next two clauses (buffer-file-number setting and
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2934 ;; set-file-modes) moved into basic-save-buffer-1 for use by
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2935 ;; continue-save-buffer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 ;; If the auto-save file was recent before this command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 ;; delete it now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 (delete-auto-save-file-if-necessary recent-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 ;; Support VC `implicit' locking.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2941 (if-fboundp 'vc-after-save
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2942 (vc-after-save))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 (run-hooks 'after-save-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 (display-message 'no-log "(No changes need to be saved)"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 ;; This does the "real job" of writing a buffer into its visited file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 ;; and making a backup file. This is what is normally done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 ;; but inhibited if one of write-file-hooks returns non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 ;; It returns a value to store in setmodes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 (defun basic-save-buffer-1 ()
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2951 (if save-buffer-coding-system
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2952 (let ((coding-system-for-write save-buffer-coding-system))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2953 (basic-save-buffer-2))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2954 (basic-save-buffer-2)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2955
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2956 (defun basic-save-buffer-2 ()
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 (let (setmodes tempsetmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 (if (not (file-writable-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 (let ((dir (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 (if (not (file-directory-p dir))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2961 (if (file-exists-p dir)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2962 (error "%s is not a directory" dir)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
2963 (error "%s: no such directory" buffer-file-name))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 (if (not (file-exists-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 (error "Directory %s write-protected" dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 (if (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 (format "File %s is write-protected; try to save anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 (file-name-nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 (setq tempsetmodes t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 "Attempt to save to a file which you aren't allowed to write"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 (or buffer-backed-up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 (setq setmodes (backup-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 (let ((dir (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 (if (and file-precious-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 (file-writable-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 ;; If file is precious, write temp name, then rename it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 ;; This requires write access to the containing dir,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 ;; which is why we don't try it if we don't have that access.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 (let ((realname buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 tempname nogood i succeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 (old-modtime (visited-file-modtime)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 (setq i 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 (setq nogood t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 ;; Find the temporary name to write under.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 (while nogood
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 (setq tempname (format "%s#tmp#%d" dir i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 (setq nogood (file-exists-p tempname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (setq i (1+ i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 (progn (clear-visited-file-modtime)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 (write-region (point-min) (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 tempname nil realname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 (setq succeed t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 ;; If writing the temp file fails,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 ;; delete the temp file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 (or succeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 (progn
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3001 (ignore-file-errors
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3002 (delete-file tempname))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 (set-visited-file-modtime old-modtime))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 ;; Since we have created an entirely new file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 ;; and renamed it, make sure it gets the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 ;; right permission bits set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 (setq setmodes (file-modes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 ;; We succeeded in writing the temp file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 ;; so rename it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 (rename-file tempname buffer-file-name t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 ;; If file not writable, see if we can make it writable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 ;; temporarily while we write it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 ;; But no need to do so if we have just backed it up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 ;; (setmodes is set) because that says we're superseding.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 (cond ((and tempsetmodes (not setmodes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 ;; Change the mode back, after writing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 (setq setmodes (file-modes buffer-file-name))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3018 (set-file-modes buffer-file-name (logior setmodes 128))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 (basic-write-file-data buffer-file-name buffer-file-truename)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3020 ;; #### FSF 21.2. We don't have last-coding-system-used.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3021 ; ;; Now we have saved the current buffer. Let's make sure
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3022 ; ;; that buffer-file-coding-system is fixed to what
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3023 ; ;; actually used for saving by binding it locally.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3024 ; (if save-buffer-coding-system
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3025 ; (setq save-buffer-coding-system last-coding-system-used)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3026 ; (setq buffer-file-coding-system last-coding-system-used))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 (setq buffer-file-number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 (nth 10 (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 (if setmodes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 (set-file-modes buffer-file-name setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 (error nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 ;; XEmacs change, from Sun
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 (defun continue-save-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 "Provide a clean way for a write-file-hook to wrap AROUND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 the execution of the remaining hooks and writing to disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 Do not call this function except from a functions
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3041 on the `write-file-hooks' or `write-contents-hooks' list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 A hook that calls this function must return non-nil,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3043 to signal completion to its caller. `continue-save-buffer'
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 always returns non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 (let ((hooks (cdr (or continue-save-buffer-hooks-tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 "continue-save-buffer called outside a write-file-hook!"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 (done nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 ;; Do something like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 ;; (let ((write-file-hooks hooks)) (basic-save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 ;; First run the rest of the hooks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 (while (and hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 (let ((continue-save-buffer-hooks-tail hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 (not (setq done (funcall (car hooks))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 (setq hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 ;; If a hook returned t, file is already "written".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 (if (not done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 (basic-save-buffer-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 'continue-save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 (defcustom save-some-buffers-query-display-buffer t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3067 (defun save-some-buffers (&optional arg pred)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 "Save some modified file-visiting buffers. Asks user about each one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 Optional argument (the prefix) non-nil means save all with no questions.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3070 Optional second argument PRED determines which buffers are considered:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3071 If PRED is nil, all the file-visiting buffers are considered.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3072 If PRED is t, then certain non-file buffers will also be considered.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3073 If PRED is a zero-argument function, it indicates for each buffer whether
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3074 to consider it or not when called with that buffer current."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 ;; `delete-other-windows' can bomb during autoloads generation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 ;; guard it well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 (if (or noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 (eq (selected-window) (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 (not save-some-buffers-query-display-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 ;; If playing with windows is unsafe or undesired, just do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 ;; usual drill.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3084 (save-some-buffers-1 arg pred nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 ;; Else, protect the windows.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 (when (save-window-excursion
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3087 (save-some-buffers-1 arg pred t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 ;; Force redisplay.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 (sit-for 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 ;; XEmacs - do not use queried flag
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3092 (defun save-some-buffers-1 (arg pred switch-buffer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 (let* ((switched nil)
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3094 (last-buffer nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 (files-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 (map-y-or-n-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 (lambda (buffer)
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3098 (prog1
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3099 (and (buffer-modified-p buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3100 (not (buffer-base-buffer buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3101 ;; XEmacs addition:
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3102 (not (symbol-value-in-buffer 'save-buffers-skip buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3103 (or
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3104 (buffer-file-name buffer)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3105 (and pred
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3106 (progn
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3107 (set-buffer buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3108 (and buffer-offer-save (> (buffer-size) 0)))))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3109 (or (not (functionp pred))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3110 (with-current-buffer buffer (funcall pred)))
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3111 (if arg
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3112 t
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3113 ;; #### We should provide a per-buffer means to
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3114 ;; disable the switching. For instance, you might
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3115 ;; want to turn it off for buffers the contents of
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3116 ;; which is meaningless to humans, such as
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3117 ;; `.newsrc.eld'.
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3118 (when (and switch-buffer
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3119 ;; map-y-or-n-p is displaying help
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3120 (not (eq last-buffer buffer)))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3121 (unless (one-window-p)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3122 (delete-other-windows))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3123 (setq switched t)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3124 ;; #### Consider using `display-buffer' here for 21.1!
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3125 ;;(display-buffer buffer nil (selected-frame)))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3126 (switch-to-buffer buffer t))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3127 (if (buffer-file-name buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3128 (format "Save file %s? "
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3129 (buffer-file-name buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3130 (format "Save buffer %s? "
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3131 (buffer-name buffer)))))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
3132 (setq last-buffer buffer)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 (lambda (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 (save-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 (buffer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 '("buffer" "buffers" "save")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 ;;instead of this we just say "yes all", "no all", etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 ;;"save all the rest"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 ;;"save only this buffer" "save no more buffers")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 ;; this is rather bogus. --ben
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 ;; (it makes the dialog box too big, and you get an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 ;; "wrong type argument: framep, nil" when you hit q after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 ;; choosing the option from the dialog box)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 ;; We should fix the dialog box rather than disabling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 ;; this! --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 (list (list ?\C-r (lambda (buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 ;; #### FSF has an EXIT-ACTION argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 ;; to `view-buffer'.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3153 (view-buffer buf
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3154 ; (function
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3155 ; (lambda (ignore)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3156 ; (exit-recursive-edit))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3157 )
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3158 (with-boundp 'view-exit-action
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3159 (setq view-exit-action
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3160 (lambda (ignore)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3161 (exit-recursive-edit))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 (recursive-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 ;; Return nil to ask about BUF again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 nil)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3165 "%_Display Buffer"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 (abbrevs-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 (and save-abbrevs abbrevs-changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 (if (or arg
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3170 (eq save-abbrevs 'silently)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 (write-abbrev-file nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 ;; Don't keep bothering user if he says no.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 (setq abbrevs-changed nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (or (> files-done 0) abbrevs-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 (display-message 'no-log "(No files need saving)"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 switched))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3181
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 (defun not-modified (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 "Mark current buffer as unmodified, not needing to be saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 It is not a good idea to use this function in Lisp programs, because it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 (if arg ;; rewritten for I18N3 snarfing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 (display-message 'command "Modification-flag set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 (display-message 'command "Modification-flag cleared"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 (set-buffer-modified-p arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 (defun toggle-read-only (&optional arg)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3195 "Change whether this buffer is visiting its file read-only.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3196 With arg, set read-only iff arg is positive.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3197 If visiting file read-only and `view-read-only' is non-nil, enter view mode."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3198 (interactive "P")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3199 (cond
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3200 ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3201 (not buffer-read-only))) ; If buffer-read-only is set correctly,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3202 nil) ; do nothing.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3203 ;; Toggle.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3204 ((and buffer-read-only view-minor-mode)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3205 ;(View-exit-and-edit)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3206 (view-mode)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3207 (make-local-variable 'view-read-only)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3208 (setq view-read-only t)) ; Must leave view mode.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3209 ((and (not buffer-read-only) view-read-only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3210 (not (eq (get major-mode 'mode-class) 'special)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3211 ;(view-mode-enter)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3212 (view-mode))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3213 (t (setq buffer-read-only (not buffer-read-only))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3214 (force-mode-line-update))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 (defun insert-file (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 "Insert contents of file FILENAME into buffer after point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 Set mark after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3220 Optional second argument specifies the coding system to use when decoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3221 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3222 the coding system.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3224 This function is meant for the user to run interactively. Don't call it
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3225 from programs! Use `insert-file-contents' instead. \(Its calling sequence
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3226 is different; see its documentation)."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 (interactive "*fInsert file: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 (if (file-directory-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 (signal 'file-error (list "Opening input file" "file is a directory"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 (let ((tem
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 (insert-file-contents filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 (insert-file-contents filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 (push-mark (+ (point) (car (cdr tem))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 (defun append-to-file (start end filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 "Append the contents of the region to the end of file FILENAME.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3241 When called from a function, expects three arguments, START, END and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3242 FILENAME. START and END are buffer positions saying what text to write.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3243 Optional fourth argument specifies the coding system to use when encoding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3244 the file. Interactively, with a prefix argument, you will be prompted for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3245 the coding system."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 (interactive "r\nFAppend to file: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 (let ((buffer-file-coding-system (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 (write-region start end filename t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 (write-region start end filename t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 (defun file-newest-backup (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 "Return most recent backup file for FILENAME or nil if no backups exist."
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3254 ;; `make-backup-file-name' will get us the right directory for
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3255 ;; ordinary or numeric backups. It might create a directory for
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3256 ;; backups as a side-effect, according to `backup-directory-alist'.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3257 (let* ((filename (file-name-sans-versions
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3258 (make-backup-file-name filename)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 (file (file-name-nondirectory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 (dir (file-name-directory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 (comp (file-name-all-completions file dir))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3262 (newest nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3263 tem)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 (while comp
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3265 (setq tem (pop comp))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3266 (cond ((and (backup-file-name-p tem)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3267 (string= (file-name-sans-versions tem) file))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3268 (setq tem (concat dir tem))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3269 (if (or (null newest)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3270 (file-newer-than-file-p tem newest))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3271 (setq newest tem)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 newest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 (defun rename-uniquely ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 "Rename current buffer to a similar name not already taken.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 This function is useful for creating multiple shell process buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 or multiple mail buffers, etc."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 (save-match-data
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3280 (let ((base-name (buffer-name)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3281 (and (string-match "<[0-9]+>\\'" base-name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3282 (not (and buffer-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3283 (string= base-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3284 (file-name-nondirectory buffer-file-name))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3285 ;; If the existing buffer name has a <NNN>,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3286 ;; which isn't part of the file name (if any),
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3287 ;; then get rid of that.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3288 (setq base-name (substring base-name 0 (match-beginning 0))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3289 (rename-buffer (generate-new-buffer-name base-name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3290 (force-mode-line-update))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 (defun make-directory-path (path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 "Create all the directories along path that don't exist yet."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 (interactive "Fdirectory path to create: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 (make-directory path t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 (defun make-directory (dir &optional parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 "Create the directory DIR and any nonexistent parent dirs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 Interactively, the default choice of directory to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 is the current default directory for file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 That is useful when you have visited a file in a nonexistent directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 Noninteractively, the second (optional) argument PARENTS says whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 to create parent directories if they don't exist."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 (interactive (list (let ((current-prefix-arg current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 (read-directory-name "Create directory: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 (let ((handler (find-file-name-handler dir 'make-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 (funcall handler 'make-directory dir parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 (if (not parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 (make-directory-internal dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 (let ((dir (directory-file-name (expand-file-name dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 create-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 (while (not (file-exists-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 (setq create-list (cons dir create-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 dir (directory-file-name (file-name-directory dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 (while create-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 (make-directory-internal (car create-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 (setq create-list (cdr create-list))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 (put 'revert-buffer-function 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 (defvar revert-buffer-function nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 "Function to use to revert this buffer, or nil to do the default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 The function receives two arguments IGNORE-AUTO and NOCONFIRM,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 which are the arguments that `revert-buffer' received.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 (defvar revert-buffer-insert-file-contents-function nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 "Function to use to insert contents when reverting this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 Gets two args, first the nominal file name to use,
849
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3332 and second, t if reading the auto-save file.
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3333 If the current buffer contents are to be discarded, the function must do
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3334 so itself.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3335
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3336 The function you specify is responsible for updating (or preserving) point.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 (defvar before-revert-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 "Normal hook for `revert-buffer' to run before reverting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 If `revert-buffer-function' is used to override the normal revert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 mechanism, this hook is not used.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 (defvar after-revert-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 "Normal hook for `revert-buffer' to run after reverting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 Note that the hook value that it runs is the value that was in effect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 before reverting; that makes a difference if you have buffer-local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 hook functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 If `revert-buffer-function' is used to override the normal revert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 mechanism, this hook is not used.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 (defvar revert-buffer-internal-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 "Don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3355 ;; END SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3356
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 "Replace the buffer text with the text of the visited file on disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 This undoes all changes since the file was visited or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 With a prefix argument, offer to revert from latest auto-save file, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 that is more recent than the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362
849
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3363 This command also refreshes certain special buffers that contain text
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3364 which doesn't come from a file, but reflects some other data base
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3365 instead: for example, Dired buffers and buffer-list buffers. This is
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3366 implemented by having the modes set `revert-buffer-function'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 When called from Lisp, the first argument is IGNORE-AUTO; only offer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 to revert from the auto-save file when this is nil. Note that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 sense of this argument is the reverse of the prefix argument, for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 sake of backward compatibility. IGNORE-AUTO is optional, defaulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 Optional second argument NOCONFIRM means don't ask for confirmation at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 Optional third argument PRESERVE-MODES non-nil means don't alter
849
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3378 the buffer's modes. Otherwise, reinitialize them using `normal-mode'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 If the value of `revert-buffer-function' is non-nil, it is called to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 do all the work for this command. Otherwise, the hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 `before-revert-hook' and `after-revert-hook' are run at the beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 and the end, and if `revert-buffer-insert-file-contents-function' is
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3384 non-nil, it is called instead of rereading visited file contents.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3385
849
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3386 If the buffer-modified flag is nil, and we are not reverting from an
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3387 auto-save file, then compare the contents of the buffer and the file.
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3388 Revert only if they differ."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 ;; I admit it's odd to reverse the sense of the prefix argument, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 ;; there is a lot of code out there which assumes that the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 ;; argument should be t to avoid consulting the auto-save file, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 ;; there's no straightforward way to encourage authors to notice a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 ;; reversal of the argument sense. So I'm just changing the user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 ;; interface, but leaving the programmatic interface the same.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 (interactive (list (not current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 (if revert-buffer-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 (funcall revert-buffer-function ignore-auto noconfirm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 (let* ((opoint (point))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3400 (newbuf nil)
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 863
diff changeset
3401 (found nil)
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3402 (delay-prompt nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 (auto-save-p (and (not ignore-auto)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 (recent-auto-save-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 (file-readable-p buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 (y-or-n-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 (file-name (if auto-save-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 (cond ((null file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 (error "Buffer does not seem to be associated with any file"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 ((or noconfirm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 (and (not (buffer-modified-p))
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 863
diff changeset
3416 (dolist (rx revert-without-query found)
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 863
diff changeset
3417 (when (string-match rx file-name)
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 863
diff changeset
3418 (setq found t))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3419 ;; If we might perform an optimized revert then we
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3420 ;; want to delay prompting in case we don't need to
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3421 ;; do it at all
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3422 (and (not auto-save-p)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3423 (not (buffer-modified-p))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3424 (setq delay-prompt t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 (yes-or-no-p (format "Revert buffer from file %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 (run-hooks 'before-revert-hook)
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3428 ;; Only perform our optimized revert if nothing obvious
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3429 ;; has changed.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3430 (cond ((or auto-save-p
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3431 (buffer-modified-p)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3432 (and (setq newbuf (revert-buffer-internal
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3433 file-name))
988
5df795348f45 [xemacs-hg @ 2002-09-01 22:13:52 by andyp]
andyp
parents: 863
diff changeset
3434 (or noconfirm found
838
bf645ed7cfe3 [xemacs-hg @ 2002-05-14 09:28:06 by ben]
ben
parents: 826
diff changeset
3435 (and delay-prompt
bf645ed7cfe3 [xemacs-hg @ 2002-05-14 09:28:06 by ben]
ben
parents: 826
diff changeset
3436 (yes-or-no-p
bf645ed7cfe3 [xemacs-hg @ 2002-05-14 09:28:06 by ben]
ben
parents: 826
diff changeset
3437 (format "Revert buffer from file %s? "
bf645ed7cfe3 [xemacs-hg @ 2002-05-14 09:28:06 by ben]
ben
parents: 826
diff changeset
3438 file-name))))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3439 ;; If file was backed up but has changed since,
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3440 ;; we should make another backup.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3441 (and (not auto-save-p)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3442 (not (verify-visited-file-modtime (current-buffer)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3443 (setq buffer-backed-up nil))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3444 ;; Get rid of all undo records for this buffer.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3445 (or (eq buffer-undo-list t)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3446 (setq buffer-undo-list nil))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3447 ;; Effectively copy the after-revert-hook status,
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3448 ;; since after-find-file will clobber it.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3449 (let ((global-hook (default-value 'after-revert-hook))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3450 (local-hook-p (local-variable-p 'after-revert-hook
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3451 (current-buffer)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3452 (local-hook (and (local-variable-p 'after-revert-hook
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3453 (current-buffer))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3454 after-revert-hook)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3455 (let (buffer-read-only
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3456 ;; Don't make undo records for the reversion.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3457 (buffer-undo-list t))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3458 (if revert-buffer-insert-file-contents-function
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3459 (funcall revert-buffer-insert-file-contents-function
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3460 file-name auto-save-p)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3461 (if (not (file-exists-p file-name))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3462 (error "File %s no longer exists!" file-name))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3463 ;; Bind buffer-file-name to nil
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3464 ;; so that we don't try to lock the file.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3465 (let ((buffer-file-name nil))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3466 (or auto-save-p
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3467 (unlock-buffer)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3468 (widen)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3469 ;; When reading in an autosave, it's encoded using
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3470 ;; `escape-quoted', so we need to use it. (It is always
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3471 ;; safe to specify `escape-quoted':
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3472 ;;
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3473 ;; 1. If file-coding but no Mule, `escape-quoted' is
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3474 ;; aliased to `binary'.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3475 ;; 2. If no file-coding, all coding systems devolve into
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3476 ;; `binary'.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3477 ;; 3. ASCII and ISO8859-1 are encoded the same in both
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3478 ;; `binary' and `escape-quoted', so they will be
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3479 ;; compatible for the most part.)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3480 ;;
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3481 ;; Otherwise, use coding-system-for-read if explicitly
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3482 ;; given (e.g. the "Revert Buffer with Specified
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3483 ;; Encoding" menu entries), or use the coding system
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3484 ;; that the file was loaded as.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3485 (let* ((coding-system-for-read
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3486 (if auto-save-p 'escape-quoted
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3487 (or coding-system-for-read
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3488 buffer-file-coding-system-when-loaded)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3489 ;; If the bfcs wasn't changed from its original
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3490 ;; value (other than possible EOL change), then we
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3491 ;; should update it for the new coding system.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3492 (should-update-bfcs
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3493 (eq (coding-system-base
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3494 buffer-file-coding-system-when-loaded)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3495 (coding-system-base
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3496 buffer-file-coding-system)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3497 (old-bfcs buffer-file-coding-system)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3498 ;; But if the EOL was changed, match it in the new
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3499 ;; value of bfcs.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3500 (adjust-eol
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3501 (and should-update-bfcs
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3502 (not
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3503 (eq (get-coding-system
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3504 buffer-file-coding-system-when-loaded)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3505 (get-coding-system
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3506 buffer-file-coding-system))))))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3507 (insert-file-contents file-name (not auto-save-p)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3508 nil nil t)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3509 (when should-update-bfcs
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3510 (setq buffer-file-coding-system old-bfcs)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3511 (set-buffer-file-coding-system
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3512 (if adjust-eol
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3513 (coding-system-base
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3514 buffer-file-coding-system-when-loaded)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3515 buffer-file-coding-system-when-loaded)
4024
f901409b074b [xemacs-hg @ 2007-06-21 23:27:13 by aidan]
aidan
parents: 3714
diff changeset
3516 (not adjust-eol) t)))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3517 (goto-char (min opoint (point-max)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3518 ;; Recompute the truename in case changes in symlinks
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3519 ;; have changed the truename.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3520 ;;XEmacs: already done by insert-file-contents
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3521 ;;(setq buffer-file-truename
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3522 ;;(abbreviate-file-name (file-truename buffer-file-name)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3523 (after-find-file nil nil t t preserve-modes)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3524 ;; Run after-revert-hook as it was before we reverted.
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3525 (setq-default revert-buffer-internal-hook global-hook)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3526 (if local-hook-p
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3527 (progn
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3528 (make-local-variable 'revert-buffer-internal-hook)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3529 (setq revert-buffer-internal-hook local-hook))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3530 (kill-local-variable 'revert-buffer-internal-hook))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3531 (run-hooks 'revert-buffer-internal-hook)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3532 ((null newbuf)
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3533 ;; The resultant buffer is identical, alter
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3534 ;; modtime, update mods and exit
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3535 (set-visited-file-modtime)
2030
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3536 (after-find-file nil nil t t t)
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3537 ;; We preserved modes above so fixup the local
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3538 ;; variables manually
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3539 (condition-case err
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3540 (hack-local-variables)
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3541 (error (lwarn 'local-variables 'warning
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3542 "File local-variables error: %s"
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3543 (error-message-string err)))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3544 (t t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546
2030
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3547 ;; #### wouldn't something like `revert-buffer-compare-with-file' be a
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3548 ;; better name?
488b2f76d852 [xemacs-hg @ 2004-04-19 08:54:47 by stephent]
stephent
parents: 1745
diff changeset
3549 ;; #### why is the argument optional?
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3550 (defun revert-buffer-internal (&optional file-name)
849
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3551 "Read contents of FILE-NAME into a buffer, and compare to current buffer.
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3552 Return nil if identical, and the new buffer if different."
503b6a57cf47 [xemacs-hg @ 2002-05-21 10:29:07 by stephent]
stephent
parents: 844
diff changeset
3553
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3554 (let* ((newbuf (get-buffer-create " *revert*"))
3714
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3555 bmin bmax
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3556 ;; #### b-f-c-s is _not necessarily_ the coding system that
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3557 ;; was used to read in the file. See its docstring.
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3558 (coding-system buffer-file-coding-system))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3559 (save-excursion
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3560 (set-buffer newbuf)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3561 (with-obsolete-variable '(before-change-function after-change-function)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3562 (let (buffer-read-only
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3563 (buffer-undo-list t)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3564 after-change-function
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3565 after-change-functions
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3566 before-change-function
3638
305157cf3ebb [xemacs-hg @ 2006-10-27 19:07:32 by aidan]
aidan
parents: 3061
diff changeset
3567 before-change-functions
3714
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3568 (coding-system-for-read coding-system)
cee87f8de64b [xemacs-hg @ 2006-11-30 07:29:34 by michaels]
michaels
parents: 3638
diff changeset
3569 )
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3570 (if revert-buffer-insert-file-contents-function
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3571 (funcall revert-buffer-insert-file-contents-function
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3572 file-name nil)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3573 (if (not (file-exists-p file-name))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3574 (error "File %s no longer exists!" file-name))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3575 (widen)
863
42375619fa45 [xemacs-hg @ 2002-06-04 06:03:59 by andyp]
andyp
parents: 851
diff changeset
3576 (insert-file-contents file-name nil nil nil t)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3577 (setq bmin (point-min)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 819
diff changeset
3578 bmax (point-max))))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3579 (if (not (and (eq bmin (point-min))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3580 (eq bmax (point-max))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3581 (eq (compare-buffer-substrings
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3582 newbuf bmin bmax (current-buffer) bmin bmax) 0)))
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3583 newbuf
863
42375619fa45 [xemacs-hg @ 2002-06-04 06:03:59 by andyp]
andyp
parents: 851
diff changeset
3584 (and (kill-buffer newbuf) nil))))
819
6504113e7c2d [xemacs-hg @ 2002-04-25 18:03:23 by andyp]
andyp
parents: 801
diff changeset
3585
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3586 ;; BEGIN SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3587
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3588 (defvar recover-file-diff-program "diff"
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3589 "Absolute or relative name of the `diff' program used by `recover-file'.")
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3590 (defvar recover-file-diff-arguments '("-c")
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3591 "List of arguments (switches) to pass to `diff' by `recover-file'.")
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3592
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 (defun recover-file (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 "Visit file FILE, but get contents from its last auto-save file."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 ;; Actually putting the file name in the minibuffer should be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 ;; only rarely.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 ;; Not just because users often use the default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 (interactive "FRecover file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 (setq file (expand-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 (let ((handler (or (find-file-name-handler file 'recover-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 (find-file-name-handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 (let ((buffer-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 (make-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 'recover-file))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 (funcall handler 'recover-file file)
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3607 (if (auto-save-file-name-p (file-name-nondirectory file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 (error "%s is an auto-save file" file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 (let ((file-name (let ((buffer-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 (make-auto-save-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 (cond ((if (file-exists-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 (not (file-newer-than-file-p file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 (not (file-exists-p file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 (error "Auto-save file %s not current" file-name))
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3615 (t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3616 (save-window-excursion
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3617 ;; XEmacs change: use insert-directory instead of
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3618 ;; calling ls directly. Add option for diff.
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3619 (with-output-to-temp-buffer "*Directory*"
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3620 (buffer-disable-undo standard-output)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3621 (save-excursion
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3622 (let ((switches
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3623 (declare-boundp dired-listing-switches)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3624 (if (file-symlink-p file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3625 (setq switches (concat switches "L")))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3626 (set-buffer standard-output)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3627 ;; XEmacs had the following line, not in FSF.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3628 (setq default-directory (file-name-directory file))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3629 ;; Use insert-directory-safely, not insert-directory,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3630 ;; because these files might not exist. In particular,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3631 ;; FILE might not exist if the auto-save file was for
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3632 ;; a buffer that didn't visit a file, such as "*mail*".
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3633 ;; The code in v20.x called `ls' directly, so we need
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3634 ;; to emulate what `ls' did in that case.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3635 (insert-directory-safely file switches)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3636 (insert-directory-safely file-name switches))))
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3637 (block nil
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3638 (while t
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3639 (case (get-user-response
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3640 nil
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3641 ;; Formerly included file name. Useless now that
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3642 ;; we display an ls of the files, and potentially
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3643 ;; fills up the minibuffer, esp. with autosaves
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3644 ;; all in one directory.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3645 "Recover auto save file? "
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3646 '(("yes" "%_Yes" yes)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3647 ("no" "%_No" no)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3648 ("diff" "%_Diff" diff)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3649 (no (error "Recover-file cancelled."))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3650 (yes
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3651 (switch-to-buffer (find-file-noselect file t))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3652 (let ((buffer-read-only nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3653 ;; Keep the current buffer-file-coding-system.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3654 (coding-system buffer-file-coding-system)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3655 ;; Auto-saved file shoule be read without any code conversion.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3656 (coding-system-for-read 'escape-quoted))
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3657 (erase-buffer)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3658 (insert-file-contents file-name nil)
4024
f901409b074b [xemacs-hg @ 2007-06-21 23:27:13 by aidan]
aidan
parents: 3714
diff changeset
3659 (set-buffer-file-coding-system coding-system
f901409b074b [xemacs-hg @ 2007-06-21 23:27:13 by aidan]
aidan
parents: 3714
diff changeset
3660 nil t))
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3661 (after-find-file nil nil t)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3662 (return nil))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3663 (diff
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3664 ;; rather than just diff the two files (which would
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3665 ;; be easy), we have to deal with the fact that
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3666 ;; they may be in different formats, since
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3667 ;; auto-saves are always in escape-quoted. so, we
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3668 ;; read the file into a buffer (#### should we look
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3669 ;; at or use a file if it's already in a buffer?
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3670 ;; maybe we would find hints as to the encoding of
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3671 ;; the file?), then we save the resulting buffer in
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3672 ;; escape-quoted, do the diff (between two files
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3673 ;; both in escape-quoted) and read in the results
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3674 ;; using coding system escape-quoted. That way, we
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3675 ;; should get what's correct most of the time.
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3676 (let ((buffer (generate-new-buffer "*recover*"))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3677 (temp
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3678 (make-temp-name
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3679 (concat (file-name-as-directory
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3680 (temp-directory))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3681 (file-name-nondirectory file) "-"))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3682 (unwind-protect
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3683 (progn
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3684 (save-current-buffer
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3685 (set-buffer buffer)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3686 (insert-file-contents file)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3687 (let ((coding-system-for-write
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3688 'escape-quoted))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3689 (write-region (point-min) (point-max)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3690 temp nil 'silent)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3691 (with-output-to-temp-buffer "*Autosave Diff*"
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3692 (buffer-disable-undo standard-output)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3693 (let ((coding-system-for-read
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3694 'escape-quoted))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3695 (condition-case ferr
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3696 (apply #'call-process
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3697 recover-file-diff-program
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3698 nil standard-output nil
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3699 (append
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3700 recover-file-diff-arguments
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3701 (list temp file-name)))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3702 (io-error
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3703 (save-excursion
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3704 (let ((switches
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3705 (declare-boundp
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3706 dired-listing-switches)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3707 (if (file-symlink-p file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3708 (setq switches (concat switches "L")))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3709 (set-buffer standard-output)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3710 ;; XEmacs had the following line, not in FSF.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3711 (setq default-directory (file-name-directory file))
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3712 ;; Use insert-directory-safely,
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3713 ;; not insert-directory, because
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3714 ;; these files might not exist.
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3715 ;; In particular, FILE might not
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3716 ;; exist if the auto-save file
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3717 ;; was for a buffer that didn't
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3718 ;; visit a file, such as
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3719 ;; "*mail*". The code in v20.x
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3720 ;; called `ls' directly, so we
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3721 ;; need to emulate what `ls' did
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3722 ;; in that case.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3723 (insert-directory-safely file switches)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3724 (insert-directory-safely file-name switches))
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3725 (terpri)
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3726 (princ "Error during diff: ")
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3727 (display-error ferr
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3728 standard-output)))))))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3729 (ignore-errors (kill-buffer buffer))
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3730 (ignore-file-errors
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 838
diff changeset
3731 (delete-file temp)))))))))))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 (defun recover-session ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 "Recover auto save files from a previous Emacs session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 This command first displays a Dired buffer showing you the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736 previous sessions that you could recover from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 To choose one, move point to the proper line and then type C-c C-c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 Then you'll be asked about a number of files to recover."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 (unless (fboundp 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 (error "recover-session requires dired"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 (if (null auto-save-list-file-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 "You set `auto-save-list-file-prefix' to disable making session files"))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3745 (let ((dir (file-name-directory auto-save-list-file-prefix)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3746 (unless (file-directory-p dir)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3747 (make-directory dir t)))
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3748 (let* ((auto-save-list-dir
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3749 (file-name-directory auto-save-list-file-prefix))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3750 (files (directory-files
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3751 auto-save-list-dir
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3752 t
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3753 (concat "^" (regexp-quote (file-name-nondirectory
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3754 auto-save-list-file-prefix)))))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3755 (files (sort (delete-if-not #'Recover-session-files-from-auto-save-list-file
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3756 files) #'file-newer-than-file-p)))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3757 (unless files
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3758 (error "No sessions can be recovered now"))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3759 (declare-fboundp (dired (cons auto-save-list-dir files)))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3760 (save-excursion
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3761 (goto-char (point-min))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3762 (or (looking-at "Move to the session you want to recover,")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3763 (let ((inhibit-read-only t))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3764 (delete-matching-lines "^[ \t]*total.*$")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3765 (insert "Move to the session you want to recover,\n"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3766 "then type C-c C-c to select it.\n\n"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3767 "You can also delete some of these files;\n"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3768 "type d on a line to mark that file for deletion.\n\n"))))
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3769 (use-local-map (let ((map (make-sparse-keymap)))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3770 (set-keymap-parents map (list (current-local-map)))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3771 map))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3772 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3774 (defun Recover-session-files-from-auto-save-list-file (file)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3775 "Return the auto save files in list file FILE that are current."
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3776 (let (files
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 (buffer (get-buffer-create " *recover*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 ;; Read in the auto-save-list file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 (erase-buffer)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3783 (let ((coding-system-for-read 'escape-quoted))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 727
diff changeset
3784 (insert-file-contents file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 ;; Loop thru the text of that file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 ;; and get out the names of the files to recover.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 (while (not (eobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 (let (thisfile autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 (if (eolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 ;; This is a pair of lines for a non-file-visiting buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 ;; Get the auto-save file name and manufacture
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 ;; a "visited file name" from that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 (setq autofile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 (setq thisfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 (substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 (file-name-nondirectory autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 1 -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 (file-name-directory autofile)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 ;; This pair of lines is a file-visiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 ;; buffer. Use the visited file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 (setq thisfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 (point) (progn (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 (setq autofile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 (point) (progn (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 (forward-line 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 ;; Ignore a file if its auto-save file does not exist now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 (if (file-exists-p autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 (setq files (cons thisfile files)))))
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3822 (setq files (nreverse files)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 (kill-buffer buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3825 (defun recover-session-finish ()
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3826 "Choose one saved session to recover auto-save files from.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3827 This command is used in the special Dired buffer created by
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3828 \\[recover-session]."
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3829 (interactive)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3830 ;; Get the name of the session file to recover from.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3831 (let ((file (declare-fboundp (dired-get-filename))))
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3832 (declare-fboundp (dired-unmark 1))
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3833 ;; #### dired-do-flagged-delete in FSF.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3834 ;; This version is for ange-ftp
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1337
diff changeset
3835 ;;(declare-fboundp (dired-do-deletions t))
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3836 ;; This version is for efs
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3837 (declare-fboundp (dired-expunge-deletions))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3838 (let ((files (Recover-session-files-from-auto-save-list-file file)))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3839 ;; The file contains a pair of line for each auto-saved buffer.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3840 ;; The first line of the pair contains the visited file name
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3841 ;; or is empty if the buffer was not visiting a file.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3842 ;; The second line is the auto-save file name.
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3843 (if files
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3844 (map-y-or-n-p "Recover %s? "
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3845 (lambda (file)
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3846 (condition-case nil
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3847 (save-excursion (recover-file file))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3848 (error
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3849 (lwarn 'recover 'alert
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3850 "Failed to recover `%s'" file))))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3851 files
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3852 '("file" "files" "recover"))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3853 (message "No files can be recovered from this session now")))))
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 849
diff changeset
3854
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 (defun kill-some-buffers (&optional list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 "For each buffer in LIST, ask whether to kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 LIST defaults to all existing live buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 (if (null list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 (setq list (buffer-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 (while list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 (let* ((buffer (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 (name (buffer-name buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 (and (not (string-equal name ""))
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3865 (not (eq (aref name 0) ?\ ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 (if (buffer-modified-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 (gettext "Buffer %s is unmodified. Kill? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 (kill-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 (setq list (cdr list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 (defun auto-save-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 "Toggle auto-saving of contents of current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 With prefix argument ARG, turn auto-saving on if positive, else off."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 (and (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 (or (not buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 ;; If autosave is off because buffer has shrunk,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 ;; then toggling should turn it on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 (< buffer-saved-size 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 (if (and buffer-file-name auto-save-visited-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 (not buffer-read-only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 (make-auto-save-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890 ;; If -1 was stored here, to temporarily turn off saving,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 ;; turn it back on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 (and (< buffer-saved-size 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 (setq buffer-saved-size 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 (if buffer-auto-save-file-name ;; rewritten for I18N3 snarfing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 (display-message 'command "Auto-save on (in this buffer)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 (display-message 'command "Auto-save off (in this buffer)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 (defun rename-auto-save-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 "Adjust current buffer's auto save file name for current conditions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 Also rename any existing auto save file, if it was made in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 (let ((osave buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 (make-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 (if (and osave buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907 (not (string= buffer-auto-save-file-name buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 (not (string= buffer-auto-save-file-name osave))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 (file-exists-p osave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 (recent-auto-save-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 (rename-file osave buffer-auto-save-file-name t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3913 ;; END SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3914
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3915 ;; make-auto-save-file-name and auto-save-file-name-p are now only in
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3916 ;; auto-save.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3919 ;; BEGIN SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3920
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 (defun wildcard-to-regexp (wildcard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 "Given a shell file name pattern WILDCARD, return an equivalent regexp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 The generated regexp will match a filename iff the filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 matches that wildcard according to shell rules. Only wildcards known
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 by `sh' are supported."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 (let* ((i (string-match "[[.*+\\^$?]" wildcard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 ;; Copy the initial run of non-special characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 (result (substring wildcard 0 i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 (len (length wildcard)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 ;; If no special characters, we're almost done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 (if i
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932 (while (< i len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 (let ((ch (aref wildcard i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 (setq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 (concat result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 (cond
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3939 ((and (eq ch ?\[)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3940 (< (1+ i) len)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3941 (eq (aref wildcard (1+ i)) ?\]))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
3942 "\\[")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 ((eq ch ?\[) ; [...] maps to regexp char class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948 ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 (if (eq (aref wildcard i) ?\])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 "[^]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955 "[^")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 ((eq (aref wildcard i) ?^)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 ;; Found "[^". Insert a `\0' character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 ;; (which cannot happen in a filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 ;; into the character class, so that `^'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 ;; is not the first character after `[',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 ;; and thus non-special in a regexp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 "[\000^"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 ((eq (aref wildcard i) ?\])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 ;; I don't think `]' can appear in a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 ;; character class in a wildcard, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 ;; let's be general here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 "[]"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 (t "["))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 (prog1 ; copy everything upto next `]'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 (substring wildcard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 i
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 (setq j (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 "]" wildcard i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 (setq i (if j (1- j) (1- len)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 ((eq ch ?.) "\\.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 ((eq ch ?*) "[^\000]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 ((eq ch ?+) "\\+")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 ((eq ch ?^) "\\^")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 ((eq ch ?$) "\\$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 ((eq ch ?\\) "\\\\") ; probably cannot happen...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 ((eq ch ??) "[^\000]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 (t (char-to-string ch)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 (setq i (1+ i)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 ;; Shell wildcards should match the entire filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 ;; not its part. Make the regexp say so.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 (concat "\\`" result "\\'")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 (defcustom list-directory-brief-switches "-CF"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 "*Switches for list-directory to pass to `ls' for brief listing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 :group 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 (defcustom list-directory-verbose-switches "-l"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 "*Switches for list-directory to pass to `ls' for verbose listing,"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 :group 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4002 (defun file-expand-wildcards (pattern &optional full)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4003 "Expand wildcard pattern PATTERN.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4004 This returns a list of file names which match the pattern.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4005
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4006 If PATTERN is written as an absolute relative file name,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4007 the values are absolute also.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4008
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4009 If PATTERN is written as a relative file name, it is interpreted
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4010 relative to the current default directory, `default-directory'.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4011 The file names returned are normally also relative to the current
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4012 default directory. However, if FULL is non-nil, they are absolute."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4013 (let* ((nondir (file-name-nondirectory pattern))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4014 (dirpart (file-name-directory pattern))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4015 ;; A list of all dirs that DIRPART specifies.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4016 ;; This can be more than one dir
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4017 ;; if DIRPART contains wildcards.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4018 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4019 (mapcar 'file-name-as-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4020 (file-expand-wildcards (directory-file-name dirpart)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4021 (list dirpart)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4022 contents)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4023 (while dirs
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4024 (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4025 (file-directory-p (directory-file-name (car dirs))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4026 (let ((this-dir-contents
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4027 ;; Filter out "." and ".."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4028 (delq nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4029 (mapcar #'(lambda (name)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4030 (unless (string-match "\\`\\.\\.?\\'"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4031 (file-name-nondirectory name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4032 name))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4033 (directory-files (or (car dirs) ".") full
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4034 (wildcard-to-regexp nondir))))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4035 (setq contents
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4036 (nconc
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4037 (if (and (car dirs) (not full))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4038 (mapcar (function (lambda (name) (concat (car dirs) name)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4039 this-dir-contents)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4040 this-dir-contents)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4041 contents))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4042 (setq dirs (cdr dirs)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4043 contents))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4044
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 (defun list-directory (dirname &optional verbose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 "Display a list of files in or matching DIRNAME, a la `ls'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 DIRNAME is globbed by the shell if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 Actions controlled by variables `list-directory-brief-switches'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 and `list-directory-verbose-switches'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 (interactive (let ((pfx current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 (list (read-file-name (if pfx (gettext "List directory (verbose): ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 (gettext "List directory (brief): "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 nil default-directory nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 pfx)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056 (let ((switches (if verbose list-directory-verbose-switches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 list-directory-brief-switches)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 (or dirname (setq dirname default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 (setq dirname (expand-file-name dirname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 (with-output-to-temp-buffer "*Directory*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 (buffer-disable-undo standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 (princ "Directory ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 (princ dirname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 (terpri)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 (set-buffer "*Directory*")
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4067 (setq default-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4068 (if (file-directory-p dirname)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4069 (file-name-as-directory dirname)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4070 (file-name-directory dirname)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 (let ((wildcard (not (file-directory-p dirname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 (insert-directory dirname switches wildcard (not wildcard)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4074 (defun shell-quote-wildcard-pattern (pattern)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4075 "Quote characters special to the shell in PATTERN, leave wildcards alone.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4076
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4077 PATTERN is assumed to represent a file-name wildcard suitable for the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4078 underlying filesystem. For Unix and GNU/Linux, the characters from the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4079 set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4080 the parts of the pattern which don't include wildcard characters are
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4081 quoted with double quotes.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4082 Existing quote characters in PATTERN are left alone, so you can pass
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4083 PATTERN that already quotes some of the special characters."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4084 (save-match-data
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4085 (cond
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4086 ((memq system-type '(ms-dos windows-nt))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4087 ;; DOS/Windows don't allow `"' in file names. So if the
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4088 ;; argument has quotes, we can safely assume it is already
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4089 ;; quoted by the caller.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4090 (if (or (string-match "[\"]" pattern)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4091 ;; We quote [&()#$'] in case their shell is a port of a
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4092 ;; Unixy shell. We quote [,=+] because stock DOS and
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4093 ;; Windows shells require that in some cases, such as
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4094 ;; passing arguments to batch files that use positional
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4095 ;; arguments like %1.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4096 (not (string-match "[ \t;&()#$',=+]" pattern)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4097 pattern
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4098 (let ((result "\"")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4099 (beg 0)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4100 end)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4101 (while (string-match "[*?]+" pattern beg)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4102 (setq end (match-beginning 0)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4103 result (concat result (substring pattern beg end)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4104 "\""
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4105 (substring pattern end (match-end 0))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4106 "\"")
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4107 beg (match-end 0)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4108 (concat result (substring pattern beg) "\""))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4109 (t
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4110 (let ((beg 0))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4111 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4112 (setq pattern
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4113 (concat (substring pattern 0 (match-beginning 0))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4114 "\\"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4115 (substring pattern (match-beginning 0)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4116 beg (1+ (match-end 0)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4117 pattern))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4118
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4119
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 (defvar insert-directory-program "ls"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 "Absolute or relative name of the `ls' program used by `insert-directory'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 ;; insert-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 ;; FULL-DIRECTORY-P is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 ;; The single line of output must display FILE's name as it was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127 ;; given, namely, an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 ;; - must insert exactly one line for each file if WILDCARD or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 ;; before the file lines, plus optional text after the file lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 ;; Lines are delimited by "\n", so filenames containing "\n" are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 ;; allowed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 ;; File lines should display the basename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 ;; - must be consistent with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135 ;; - functions dired-move-to-filename, (these two define what a file line is)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 ;; dired-move-to-end-of-filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 ;; dired-insert-headerline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 ;; dired-after-subdir-garbage (defines what a "total" line is)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 ;; - variable dired-subdir-regexp
1606
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4141 ;; - may be passed "--dired" as argument in SWITCHES.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4142 ;; Filename handlers might have to remove this switch if their
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4143 ;; "ls" command does not support it.
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4144
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4145 ;; END SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4146
2671
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4147 (defvar insert-directory-ls-version 'unknown)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4148
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 (defun insert-directory (file switches &optional wildcard full-directory-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 "Insert directory listing for FILE, formatted according to SWITCHES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151 Leaves point after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 SWITCHES may be a string of options, or a list of strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153 Optional third arg WILDCARD means treat FILE as shell wildcard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 switches do not contain `d', so that a full listing is expected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 This works by running a directory listing program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 whose name is in the variable `insert-directory-program'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 If WILDCARD, it also runs the shell specified by `shell-file-name'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160 ;; We need the directory in order to find the right handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 (let ((handler (find-file-name-handler (expand-file-name file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 'insert-directory)))
1606
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4163 (cond
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4164 (handler
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4165 (funcall handler 'insert-directory file switches
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4166 wildcard full-directory-p))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4167 ;; [mswindows-insert-directory should be called
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4168 ;; nt-insert-directory - kkm]. not true any more according to
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4169 ;; my new naming scheme. --ben
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4170 ((and (fboundp 'mswindows-insert-directory)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4171 (eq system-type 'windows-nt))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4172 (declare-fboundp (mswindows-insert-directory
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4173 file switches wildcard full-directory-p)))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4174 (t
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4175 (let* ((beg (point))
4400
555e21a66d51 2008-01-13 Michael Sperber <mike@xemacs.org>
Mike Sperber <sperber@deinprogramm.de>
parents: 4266
diff changeset
4176 ;; on Unix, assume that ls will output in what the
555e21a66d51 2008-01-13 Michael Sperber <mike@xemacs.org>
Mike Sperber <sperber@deinprogramm.de>
parents: 4266
diff changeset
4177 ;; file-name coding system specifies
555e21a66d51 2008-01-13 Michael Sperber <mike@xemacs.org>
Mike Sperber <sperber@deinprogramm.de>
parents: 4266
diff changeset
4178 (coding-system-for-read (get-coding-system 'file-name))
1606
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4179 (result
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4180 (if wildcard
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4181 ;; Run ls in the directory of the file pattern we asked for.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4182 (let ((default-directory
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4183 (if (file-name-absolute-p file)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4184 (file-name-directory file)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4185 (file-name-directory (expand-file-name file))))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4186 (pattern (file-name-nondirectory file))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4187 (start 0))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4188 ;; Quote some characters that have special meanings in shells;
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4189 ;; but don't quote the wildcards--we want them to be special.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4190 ;; We also currently don't quote the quoting characters
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4191 ;; in case people want to use them explicitly to quote
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4192 ;; wildcard characters.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4193 ;;#### Unix-specific
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4194 (while (string-match "[ \t\n;<>&|()#$]" pattern start)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4195 (setq pattern
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4196 (concat (substring pattern 0 (match-beginning 0))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4197 "\\"
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4198 (substring pattern (match-beginning 0)))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4199 start (1+ (match-end 0))))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4200 (call-process shell-file-name nil t nil
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4201 "-c" (concat "\\" ;; Disregard shell aliases!
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4202 insert-directory-program
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4203 " -d "
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4204 (if (stringp switches)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4205 switches
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4206 (mapconcat 'identity switches " "))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4207 " "
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4208 pattern)))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4209 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4210 ;; directory if FILE is a symbolic link.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4211 (apply 'call-process
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4212 insert-directory-program nil t nil
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4213 (let (list)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4214 (if (listp switches)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4215 (setq list switches)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4216 (if (not (equal switches ""))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4217 (let ((switches switches))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4218 ;; Split the switches at any spaces
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4219 ;; so we can pass separate options as separate args.
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4220 (while (string-match " " switches)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4221 (setq list (cons (substring switches 0 (match-beginning 0))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4222 list)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4223 switches (substring switches (match-end 0))))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4224 (setq list (cons switches list)))))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4225 (append list
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4226 (list
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4227 (if full-directory-p
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4228 (concat (file-name-as-directory file)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4229 ;;#### Unix-specific
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4230 ".")
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4231 file))))))))
2671
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4232
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4233 ;; If we got "//DIRED//" in the output, it means we got a real
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4234 ;; directory listing, even if `ls' returned nonzero.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4235 ;; So ignore any errors.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4236 (when (if (stringp switches)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4237 (string-match "--dired\\>" switches)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4238 (member "--dired" switches))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4239 (save-excursion
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4240 (forward-line -2)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4241 (when (looking-at "//SUBDIRED//")
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4242 (forward-line -1))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4243 (if (looking-at "//DIRED//")
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4244 (setq result 0))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4245
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4246 (when (and (not (eq 0 result))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4247 (eq insert-directory-ls-version 'unknown))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4248 ;; The first time ls returns an error,
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4249 ;; find the version numbers of ls,
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4250 ;; and set insert-directory-ls-version
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4251 ;; to > if it is more than 5.2.1, < if it is less, nil if it
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4252 ;; is equal or if the info cannot be obtained.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4253 ;; (That can mean it isn't GNU ls.)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4254 (let ((version-out
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4255 (with-temp-buffer
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4256 (call-process "ls" nil t nil "--version")
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4257 (buffer-string))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4258 (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4259 (let* ((version (match-string 1 version-out))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4260 (split (split-string version "[.]"))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4261 (numbers (mapcar 'string-to-int split))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4262 (min '(5 2 1))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4263 comparison)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4264 (while (and (not comparison) (or numbers min))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4265 (cond ((null min)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4266 (setq comparison '>))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4267 ((null numbers)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4268 (setq comparison '<))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4269 ((> (car numbers) (car min))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4270 (setq comparison '>))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4271 ((< (car numbers) (car min))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4272 (setq comparison '<))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4273 (t
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4274 (setq numbers (cdr numbers)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4275 min (cdr min)))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4276 (setq insert-directory-ls-version (or comparison '=)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4277 (setq insert-directory-ls-version nil))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4278
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4279 ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4280 (when (and (eq 1 result) (eq insert-directory-ls-version '>))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4281 (setq result 0))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4282
1606
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4283 ;; If `insert-directory-program' failed, signal an error.
2671
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4284 (unless (eq 0 result)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4285 ;; Delete the error message it may have output.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4286 (delete-region beg (point))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4287 ;; On non-Posix systems, we cannot open a directory, so
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4288 ;; don't even try, because that will always result in
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4289 ;; the ubiquitous "Access denied". Instead, show the
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4290 ;; command line so the user can try to guess what went wrong.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4291 (if (and (file-directory-p file)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4292 (memq system-type '(ms-dos windows-nt)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4293 (error
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4294 "Reading directory: \"%s %s -- %s\" exited with status %s"
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4295 insert-directory-program
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4296 (if (listp switches) (concat switches) switches)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4297 file result)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4298 (error "Listing directory failed")))
1606
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4299
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4300 (when (or (and (listp switches)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4301 (member "--dired" switches))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4302 (string-match "--dired\\>" switches))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4303 (forward-line -2)
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4304 (when (looking-at "//SUBDIRED//")
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4305 (delete-region (point) (progn (forward-line 1) (point)))
5d5a604cb3ed [xemacs-hg @ 2003-08-06 09:11:39 by michaels]
michaels
parents: 1346
diff changeset
4306 (forward-line -1))
2671
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4307 (if (looking-at "//DIRED//")
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4308 (let ((end (line-end-position))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4309 (linebeg (point))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4310 error-lines)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4311 ;; Find all the lines that are error messages,
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4312 ;; and record the bounds of each one.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4313 (goto-char beg)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4314 (while (< (point) linebeg)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4315 (or (eql (following-char) ?\s)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4316 (push (list (point) (line-end-position)) error-lines))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4317 (forward-line 1))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4318 (setq error-lines (nreverse error-lines))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4319 ;; Now read the numeric positions of file names.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4320 (goto-char linebeg)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4321 (forward-word 1)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4322 (forward-char 3)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4323 (while (< (point) end)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4324 (let ((start (insert-directory-adj-pos
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4325 (+ beg (read (current-buffer)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4326 error-lines))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4327 (end (insert-directory-adj-pos
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4328 (+ beg (read (current-buffer)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4329 error-lines)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4330 (if (memq (char-after end) '(?\n ?\ ))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4331 ;; End is followed by \n or by " -> ".
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4332 (let ((filename-extent (make-extent start end)))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4333 (set-extent-property filename-extent 'dired-file-name t)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4334 (set-extent-property filename-extent 'start-open t)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4335 (set-extent-property filename-extent 'end-open t))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4336 ;; It seems that we can't trust ls's output as to
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4337 ;; byte positions of filenames.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4338 (map-extents
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4339 #'(lambda (extent maparg)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4340 (delete-extent extent)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4341 nil)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4342 nil beg (point) nil nil 'dired-file-name)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4343 (end-of-line))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4344 (goto-char end)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4345 (beginning-of-line)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4346 (delete-region (point) (progn (forward-line 1) (point))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4347 ;; Take care of the case where the ls output contains a
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4348 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4349 ;; and we went one line too far back (see above).
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4350 (forward-line 1))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4351 (if (looking-at "//DIRED-OPTIONS//")
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4352 (delete-region (point) (progn (forward-line 1) (point))))))))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4353
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4354 (defun insert-directory-adj-pos (pos error-lines)
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4355 "Convert `ls --dired' file name position value POS to a buffer position.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4356 File name position values returned in ls --dired output
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4357 count only stdout; they don't count the error messages sent to stderr.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4358 So this function converts to them to real buffer positions.
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4359 ERROR-LINES is a list of buffer positions of error message lines,
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4360 of the form (START END)."
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4361 (while (and error-lines (< (caar error-lines) pos))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4362 (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4363 (pop error-lines))
5402bf7d11a5 [xemacs-hg @ 2005-03-17 09:26:07 by michaels]
michaels
parents: 2434
diff changeset
4364 pos)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4366 ;; BEGIN SYNC WITH FSF 21.2.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4367
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4368 (defun insert-directory-safely (file switches
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4369 &optional wildcard full-directory-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4370 "Insert directory listing for FILE, formatted according to SWITCHES.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4371
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4372 Like `insert-directory', but if FILE does not exist, it inserts a
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4373 message to that effect instead of signaling an error."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4374 (if (file-exists-p file)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4375 (insert-directory file switches wildcard full-directory-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4376 ;; Simulate the message printed by `ls'.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4377 (insert (format "%s: No such file or directory\n" file))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4378
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 (defvar kill-emacs-query-functions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 "Functions to call with no arguments to query about killing XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 If any of these functions returns nil, killing Emacs is cancelled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 but `kill-emacs', the low level primitive, does not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 See also `kill-emacs-hook'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4386 (defcustom confirm-kill-emacs nil
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4387 "How to ask for confirmation when leaving Emacs.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4388 If nil, the default, don't ask at all. If the value is non-nil, it should
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4389 be a predicate function such as `yes-or-no-p'."
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4390 :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4391 (const :tag "Ask with y-or-n-p" y-or-n-p)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4392 (const :tag "Don't confirm" nil))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4393 :group 'emacs
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4394 ;:version "21.1"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4395 )
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4396
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 (defun save-buffers-kill-emacs (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398 "Offer to save each buffer, then kill this XEmacs process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399 With prefix arg, silently save all file-visiting buffers, then kill."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 (save-some-buffers arg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402 (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4403 (buffer-modified-p buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404 (buffer-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4405 (yes-or-no-p "Modified buffers exist; exit anyway? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4406 (or (not (fboundp 'process-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4407 ;; process-list is not defined on VMS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408 (let ((processes (process-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4409 active)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4410 (while processes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4411 (and (memq (process-status (car processes)) '(run stop open))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4412 (let ((val (process-kill-without-query (car processes))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413 (process-kill-without-query (car processes) val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 (setq active t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416 (setq processes (cdr processes)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4418 (not active)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4419 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4420 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 (delete-other-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422 (list-processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424 "Active processes exist; kill them and exit anyway? "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425 ;; Query the user for other things, perhaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4427 (or (null confirm-kill-emacs)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4428 (funcall confirm-kill-emacs "Really exit Emacs? "))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4429 (kill-emacs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431 (defun symlink-expand-file-name (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4432 "If FILENAME is a symlink, return its non-symlink equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4433 Unlike `file-truename', this doesn't chase symlinks in directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4434 components of the file or expand a relative pathname into an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4435 absolute one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436 (let ((count 20))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 (while (and (> count 0) (file-symlink-p filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438 (setq filename (file-symlink-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4439 count (1- count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 (if (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 (error "Apparently circular symlink path"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445 (defun file-remote-p (file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 "Test whether FILE-NAME is looked for on a remote system."
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 774
diff changeset
4447 (cond ((not (declare-boundp allow-remote-paths)) nil)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
4448 ((fboundp 'ange-ftp-ftp-path)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
4449 (declare-fboundp (ange-ftp-ftp-path file-name)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
4450 ((fboundp 'efs-ftp-path)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
4451 (declare-fboundp (efs-ftp-path file-name)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4452 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4454
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4455 ;; We use /: as a prefix to "quote" a file name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4456 ;; so that magic file name handlers will not apply to it.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4457
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4458 (setq file-name-handler-alist
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4459 (cons '("\\`/:" . file-name-non-special)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4460 file-name-handler-alist))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4461
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4462 ;; We depend on being the last handler on the list,
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4463 ;; so that anything else which does need handling
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4464 ;; has been handled already.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4465 ;; So it is safe for us to inhibit *all* magic file name handlers.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4466
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4467 (defun file-name-non-special (operation &rest arguments)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4468 (let ((file-name-handler-alist nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4469 (default-directory
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4470 (if (eq operation 'insert-directory)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4471 (directory-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4472 (expand-file-name
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4473 (unhandled-file-name-directory default-directory)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4474 default-directory))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4475 ;; Get a list of the indices of the args which are file names.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4476 (file-arg-indices
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4477 (cdr (or (assq operation
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4478 ;; The first four are special because they
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4479 ;; return a file name. We want to include the /:
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4480 ;; in the return value.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4481 ;; So just avoid stripping it in the first place.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4482 '((expand-file-name . nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4483 ;; `identity' means just return the first arg
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4484 ;; as stripped of its quoting.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4485 (substitute-in-file-name . identity)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4486 (file-name-directory . nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4487 (file-name-as-directory . nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4488 (directory-file-name . nil)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4489 (file-name-completion 0 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4490 (file-name-all-completions 0 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4491 (rename-file 0 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4492 (copy-file 0 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4493 (make-symbolic-link 0 1)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4494 (add-name-to-file 0 1)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4495 ;; For all other operations, treat the first argument only
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4496 ;; as the file name.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4497 '(nil 0))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4498 ;; Copy ARGUMENTS so we can replace elements in it.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4499 (arguments (copy-sequence arguments)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4500 ;; Strip off the /: from the file names that have this handler.
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4501 (save-match-data
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4502 (while (consp file-arg-indices)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4503 (let ((pair (nthcdr (car file-arg-indices) arguments)))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4504 (and (car pair)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4505 (string-match "\\`/:" (car pair))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4506 (setcar pair
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4507 (if (= (length (car pair)) 2)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4508 "/"
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4509 (substring (car pair) 2)))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4510 (setq file-arg-indices (cdr file-arg-indices))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4511 (if (eq file-arg-indices 'identity)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4512 (car arguments)
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4513 (apply operation arguments))))
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4514
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 1024
diff changeset
4515 ;; END SYNC WITH FSF 21.2.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516
4720
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4517 ;; XEmacs:
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4518 (defvar default-file-system-ignore-case (and
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4519 (memq system-type '(windows-nt
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4520 cygwin32
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4521 darwin))
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4522 t)
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4523 "What `file-system-ignore-case-p' returns by default.
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4524 This is in the case that nothing in `file-system-case-alist' matches.")
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4525
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4526 ;; Question; do any of the Linuxes mount Windows partitions in a fixed
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4527 ;; place?
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4528 (defvar file-system-case-alist nil
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4529 "Alist to decide where file name case is significant.
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4530
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4531 The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4532 matching a file name, and VAL is t if corresponding file names are
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4533 case-insensitive, nil if corresponding file names are case sensitive. Only
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4534 the first match will be used.
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4535
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4536 This list is used by `file-system-ignore-case-p', itself used in tab
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4537 completion; see also `default-file-system-ignore-case'.")
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4538
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4539 (defun file-system-ignore-case-p (path)
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4540 "Return t if PATH resides on a file system with case-insensitive names.
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4541 Otherwise, return nil. See `file-system-case-alist' and
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4542 `default-file-system-ignore-case'."
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4543 (check-argument-type #'stringp path)
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4544 (if file-system-case-alist
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4545 (loop
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4546 for (pattern . val)
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4547 in file-system-case-alist
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4548 do (and (string-match pattern path) (return val))
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4549 finally (return default-file-system-ignore-case))
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4550 default-file-system-ignore-case))
3c92890f3750 Add `file-system-ignore-case-p', use it.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4655
diff changeset
4551
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4552 ;;; files.el ends here