Mercurial > hg > xemacs-beta
comparison lisp/prim/files.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 56c54cf7c5b6 |
children | b9518feda344 |
comparison
equal
deleted
inserted
replaced
69:804d1389bcd6 | 70:131b0175ea99 |
---|---|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | 14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 ;; General Public License for more details. | 16 ;; General Public License for more details. |
17 | 17 |
18 ;; You should have received a copy of the GNU General Public License | 18 ;; You should have received a copy of the GNU General Public License |
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free | 19 ;; along with XEmacs; see the file COPYING. If not, write to the |
20 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | 20 ;; Free Software Foundation, 59 Temple Place - Suite 330, |
21 ;; 02111-1307, USA. | 21 ;; Boston, MA 02111-1307, USA. |
22 | 22 |
23 ;;; Synched up with: FSF 19.34 [Partial]. | 23 ;;; Synched up with: FSF 19.30. |
24 ;;; Warning: Merging this file is tough. Beware. | 24 ;;; Warning: Merging this file is tough. Beware. |
25 | 25 |
26 ;;; Commentary: | 26 ;;; Commentary: |
27 | 27 |
28 ;; Defines most of XEmacs's file- and directory-handling functions, | 28 ;; Defines most of XEmacs's file- and directory-handling functions, |
29 ;; including basic file visiting, backup generation, link handling, | 29 ;; including basic file visiting, backup generation, link handling, |
30 ;; ITS-id version control, load- and write-hook handling, and the like. | 30 ;; ITS-id version control, load- and write-hook handling, and the like. |
31 | 31 |
32 ;;; Code: | 32 ;;; Code: |
33 | 33 |
34 ;; XEmacs: Avoid compilation warnings. | 34 ;; Avoid compilation warnings. |
35 (defvar overriding-file-coding-system) | 35 (defvar overriding-file-coding-system) |
36 (defvar file-coding-system) | 36 (defvar file-coding-system) |
37 | 37 |
38 ;; XEmacs: In buffer.c | 38 ;; In buffer.c |
39 ;(defconst delete-auto-save-files t | 39 ;(defconst delete-auto-save-files t |
40 ; "*Non-nil means delete auto-save file when a buffer is saved or killed.") | 40 ; "*Non-nil means delete auto-save file when a buffer is saved or killed.") |
41 | |
42 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general. | |
43 ;; note: tmp_mnt bogosity conversion is established in paths.el. | |
44 (defvar directory-abbrev-alist nil | |
45 "*Alist of abbreviations for file directories. | |
46 A list of elements of the form (FROM . TO), each meaning to replace | |
47 FROM with TO when it appears in a directory name. | |
48 This replacement is done when setting up the default directory of a | |
49 newly visited file. *Every* FROM string should start with \\\\` or ^. | |
50 | |
51 Use this feature when you have directories which you normally refer to | |
52 via absolute symbolic links or to eliminate automounter mount points | |
53 from the beginning of your filenames. Make TO the name of the link, | |
54 and FROM the name it is linked to.") | |
55 | 41 |
56 ;;; Turn off backup files on VMS since it has version numbers. | 42 ;;; Turn off backup files on VMS since it has version numbers. |
57 (defconst make-backup-files (not (eq system-type 'vax-vms)) | 43 (defconst make-backup-files (not (eq system-type 'vax-vms)) |
58 "*Non-nil means make a backup of a file the first time it is saved. | 44 "*Non-nil means make a backup of a file the first time it is saved. |
59 This can be done by renaming the file or by copying. | 45 This can be done by renaming the file or by copying. |
108 "*Non-nil in a buffer means offer to save the buffer on exit | 94 "*Non-nil in a buffer means offer to save the buffer on exit |
109 even if the buffer is not visiting a file. | 95 even if the buffer is not visiting a file. |
110 Automatically local in all buffers.") | 96 Automatically local in all buffers.") |
111 (make-variable-buffer-local 'buffer-offer-save) | 97 (make-variable-buffer-local 'buffer-offer-save) |
112 | 98 |
113 ;; FSF uses normal defconst | |
114 (defvaralias 'find-file-visit-truename 'find-file-use-truenames) | 99 (defvaralias 'find-file-visit-truename 'find-file-use-truenames) |
115 (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames) | 100 (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames) |
116 | 101 |
117 (defvar buffer-file-number nil | 102 (defvar buffer-file-number nil |
118 "The device number and file number of the file visited in the current buffer. | 103 "The device number and file number of the file visited in the current buffer. |
120 This pair of numbers uniquely identifies the file. | 105 This pair of numbers uniquely identifies the file. |
121 If the buffer is visiting a new file, the value is nil.") | 106 If the buffer is visiting a new file, the value is nil.") |
122 (make-variable-buffer-local 'buffer-file-number) | 107 (make-variable-buffer-local 'buffer-file-number) |
123 (put 'buffer-file-number 'permanent-local t) | 108 (put 'buffer-file-number 'permanent-local t) |
124 | 109 |
125 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) | |
126 "Non-nil means that buffer-file-number uniquely identifies files.") | |
127 | |
128 (defconst file-precious-flag nil | 110 (defconst file-precious-flag nil |
129 "*Non-nil means protect against I/O errors while saving files. | 111 "*Non-nil means protect against I/O errors while saving files. |
130 Some modes set this non-nil in particular buffers. | 112 Some modes set this non-nil in particular buffers. |
131 | 113 |
132 This feature works by writing the new contents into a temporary file | 114 This feature works by writing the new contents into a temporary file |
142 "*Control use of version numbers for backup files. | 124 "*Control use of version numbers for backup files. |
143 t means make numeric backup versions unconditionally. | 125 t means make numeric backup versions unconditionally. |
144 nil means make them for files that have some already. | 126 nil means make them for files that have some already. |
145 `never' means do not make them.") | 127 `never' means do not make them.") |
146 | 128 |
147 ;; This is now defined in efs. | 129 (defvar dired-kept-versions 2 |
148 ;(defvar dired-kept-versions 2 | 130 "*When cleaning directory, number of versions to keep.") |
149 ; "*When cleaning directory, number of versions to keep.") | |
150 | 131 |
151 (defvar delete-old-versions nil | 132 (defvar delete-old-versions nil |
152 "*If t, delete excess backup versions silently. | 133 "*If t, delete excess backup versions silently. |
153 If nil, ask confirmation. Any other value prevents any trimming.") | 134 If nil, ask confirmation. Any other value prevents any trimming.") |
154 | 135 |
197 "List of functions to be called before writing out a buffer to a file. | 178 "List of functions to be called before writing out a buffer to a file. |
198 If one of them returns non-nil, the file is considered already written | 179 If one of them returns non-nil, the file is considered already written |
199 and the rest are not called. | 180 and the rest are not called. |
200 These hooks are considered to pertain to the visited file. | 181 These hooks are considered to pertain to the visited file. |
201 So this list is cleared if you change the visited file name. | 182 So this list is cleared if you change the visited file name. |
202 | 183 See also `write-contents-hooks' and `continue-save-buffer'. |
203 Don't make this variable buffer-local; instead, use `local-write-file-hooks'. | 184 Don't make this variable buffer-local; instead, use `local-write-file-hooks'.") |
204 See also `write-contents-hooks' and `continue-save-buffer'.") | |
205 ;;; However, in case someone does make it local... | 185 ;;; However, in case someone does make it local... |
206 (put 'write-file-hooks 'permanent-local t) | 186 (put 'write-file-hooks 'permanent-local t) |
207 | 187 |
208 (defvar local-write-file-hooks nil | 188 (defvar local-write-file-hooks nil |
209 "Just like `write-file-hooks', except intended for per-buffer use. | 189 "Just like `write-file-hooks', except intended for per-buffer use. |
210 The functions in this list are called before the ones in | 190 The functions in this list are called before the ones in |
211 `write-file-hooks'. | 191 `write-file-hooks'.") |
212 | |
213 This variable is meant to be used for hooks that have to do with a | |
214 particular visited file. Therefore, it is a permanent local, so that | |
215 changing the major mode does not clear it. However, calling | |
216 `set-visited-file-name' does clear it.") | |
217 (make-variable-buffer-local 'local-write-file-hooks) | 192 (make-variable-buffer-local 'local-write-file-hooks) |
218 (put 'local-write-file-hooks 'permanent-local t) | 193 (put 'local-write-file-hooks 'permanent-local t) |
219 | 194 |
220 | 195 |
221 ;; XEmacs: #### think about this (added by Sun). | 196 ;; #### think about this (added by Sun). |
222 (put 'after-set-visited-file-name-hooks 'permanent-local t) | 197 (put 'after-set-visited-file-name-hooks 'permanent-local t) |
223 (defvar after-set-visited-file-name-hooks nil | 198 (defvar after-set-visited-file-name-hooks nil |
224 "List of functions to be called after \\[set-visited-file-name] | 199 "List of functions to be called after \\[set-visited-file-name] |
225 or during \\[write-file]. | 200 or during \\[write-file]. |
226 You can use this hook to restore local values of write-file-hooks, | 201 You can use this hook to restore local values of write-file-hooks, |
235 and the rest are not called. | 210 and the rest are not called. |
236 These hooks are considered to pertain to the buffer's contents, | 211 These hooks are considered to pertain to the buffer's contents, |
237 not to the particular visited file; thus, `set-visited-file-name' does | 212 not to the particular visited file; thus, `set-visited-file-name' does |
238 not clear this variable, but changing the major mode does clear it. | 213 not clear this variable, but changing the major mode does clear it. |
239 See also `write-file-hooks' and `continue-save-buffer'.") | 214 See also `write-file-hooks' and `continue-save-buffer'.") |
240 ;(make-variable-buffer-local 'write-contents-hooks) | 215 |
241 | 216 ;; Not in FSF19 |
242 ;; XEmacs addition | |
243 ;; Energize needed this to hook into save-buffer at a lower level; we need | 217 ;; Energize needed this to hook into save-buffer at a lower level; we need |
244 ;; to provide a new output method, but don't want to have to duplicate all | 218 ;; to provide a new output method, but don't want to have to duplicate all |
245 ;; of the backup file and file modes logic.that does not occur if one uses | 219 ;; of the backup file and file modes logic.that does not occur if one uses |
246 ;; a write-file-hook which returns non-nil. | 220 ;; a write-file-hook which returns non-nil. |
247 (put 'write-file-data-hooks 'permanent-local t) | 221 (put 'write-file-data-hooks 'permanent-local t) |
271 A value of t means obey `eval' variables; | 245 A value of t means obey `eval' variables; |
272 nil means ignore them; anything else means query. | 246 nil means ignore them; anything else means query. |
273 | 247 |
274 The command \\[normal-mode] always obeys local-variables lists | 248 The command \\[normal-mode] always obeys local-variables lists |
275 and ignores this variable.") | 249 and ignores this variable.") |
250 | |
251 (defvar hack-local-variables-hook nil | |
252 "Normal hook run after processing a file's local variables specs. | |
253 Major modes can use this to examine user-specified local variables | |
254 in order to initialize other data structure based on them. | |
255 | |
256 This hook runs even if there were no local variables or if their | |
257 evaluation was suppressed. See also `enable-local-variables' and | |
258 `enable-local-eval'.") | |
276 | 259 |
277 ;; Avoid losing in versions where CLASH_DETECTION is disabled. | 260 ;; Avoid losing in versions where CLASH_DETECTION is disabled. |
278 (or (fboundp 'lock-buffer) | 261 (or (fboundp 'lock-buffer) |
279 (defalias 'lock-buffer 'ignore)) | 262 (defalias 'lock-buffer 'ignore)) |
280 (or (fboundp 'unlock-buffer) | 263 (or (fboundp 'unlock-buffer) |
315 "Character used to separate concatenated paths.") | 298 "Character used to separate concatenated paths.") |
316 | 299 |
317 (defun parse-colon-path (cd-path) | 300 (defun parse-colon-path (cd-path) |
318 "Explode a colon-separated list of paths into a string list." | 301 "Explode a colon-separated list of paths into a string list." |
319 (and cd-path | 302 (and cd-path |
320 (let (cd-prefix cd-list (cd-start 0) cd-colon) | 303 (let (cd-list (cd-start 0) cd-colon) |
321 (setq cd-path (concat cd-path path-separator)) | 304 (setq cd-path (concat cd-path path-separator)) |
322 (while (setq cd-colon (string-match path-separator cd-path cd-start)) | 305 (while (setq cd-colon (string-match path-separator cd-path cd-start)) |
323 (setq cd-list | 306 (setq cd-list |
324 (nconc cd-list | 307 (nconc cd-list |
325 (list (if (= cd-start cd-colon) | 308 (list (if (= cd-start cd-colon) |
350 | 333 |
351 (defun cd (dir) | 334 (defun cd (dir) |
352 "Make DIR become the current buffer's default directory. | 335 "Make DIR become the current buffer's default directory. |
353 If your environment includes a `CDPATH' variable, try each one of that | 336 If your environment includes a `CDPATH' variable, try each one of that |
354 colon-separated list of directories when resolving a relative directory name." | 337 colon-separated list of directories when resolving a relative directory name." |
338 ; (interactive "DChange default directory: ") | |
355 (interactive | 339 (interactive |
356 ;; XEmacs change? (read-file-name => read-directory-name) | 340 ;; XEmacs change? |
357 (list (read-directory-name "Change default directory: " | 341 (list (read-directory-name "Change default directory: " |
358 default-directory default-directory | 342 default-directory default-directory |
359 (and (member cd-path '(nil ("./"))) | 343 (and (member cd-path '(nil ("./"))) |
360 (null (getenv "CDPATH")))))) | 344 (null (getenv "CDPATH")))))) |
361 (if (file-name-absolute-p dir) | 345 (if (file-name-absolute-p dir) |
362 (cd-absolute (expand-file-name dir)) | 346 (cd-absolute (expand-file-name dir)) |
363 ;; XEmacs | 347 (progn |
364 (if (null cd-path) | 348 (if (null cd-path) |
365 ;;#### Unix-specific | 349 ;;#### Unix-specific |
366 (let ((trypath (parse-colon-path (getenv "CDPATH")))) | 350 (let ((trypath (parse-colon-path (getenv "CDPATH")))) |
367 (setq cd-path (or trypath (list "./"))))) | 351 (setq cd-path (or trypath (list "./"))))) |
368 (or (catch 'found | 352 (or (catch 'found |
369 (mapcar #'(lambda (x) | 353 (mapcar #'(lambda (x) |
370 (let ((f (expand-file-name (concat x dir)))) | 354 (let ((f (expand-file-name (concat x dir)))) |
371 (if (file-directory-p f) | 355 (if (file-directory-p f) |
372 (progn | 356 (progn |
373 (cd-absolute f) | 357 (cd-absolute f) |
374 (throw 'found t))))) | 358 (throw 'found t))))) |
376 nil) | 360 nil) |
377 ;; jwz: give a better error message to those of us with the | 361 ;; jwz: give a better error message to those of us with the |
378 ;; good taste not to use a kludge like $CDPATH. | 362 ;; good taste not to use a kludge like $CDPATH. |
379 (if (equal cd-path '("./")) | 363 (if (equal cd-path '("./")) |
380 (error "No such directory: %s" (expand-file-name dir)) | 364 (error "No such directory: %s" (expand-file-name dir)) |
381 (error "Directory not found in $CDPATH: %s" dir))))) | 365 (error "Directory not found in $CDPATH: %s" dir)))))) |
382 | 366 |
383 (defun load-file (file) | 367 (defun load-file (file) |
384 "Load the Lisp file named FILE." | 368 "Load the Lisp file named FILE." |
385 (interactive "fLoad file: ") | 369 (interactive "fLoad file: ") |
386 (load (expand-file-name file) nil nil t)) | 370 (load (expand-file-name file) nil nil t)) |
387 | 371 |
388 ; We now dump utils/lib-complete.el which has an improved version of this. | 372 ; We now dump utils/lib-complete.el which has improved versions of these. |
389 ;(defun load-library (library) | 373 ;(defun load-library (library) |
390 ; "Load the library named LIBRARY. | 374 ; "Load the library named LIBRARY. |
391 ;This is an interface to the function `load'." | 375 ;This is an interface to the function `load'." |
392 ; (interactive "sLoad library: ") | 376 ; (interactive "sLoad library: ") |
393 ; (load library)) | 377 ; (load library)) |
378 ; | |
379 ;(defun find-library (library) | |
380 ; "Find the library of Lisp code named LIBRARY. | |
381 ;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"." | |
382 ; (interactive "sFind library file: ") | |
383 ; (let ((f (locate-file library load-path ":.el:"))) | |
384 ; (if f | |
385 ; (find-file f) | |
386 ; (error "Couldn't locate library %s" library)))) | |
394 | 387 |
395 (defun file-local-copy (file &optional buffer) | 388 (defun file-local-copy (file &optional buffer) |
396 "Copy the file FILE into a temporary file on this machine. | 389 "Copy the file FILE into a temporary file on this machine. |
397 Returns the name of the local copy, or nil, if FILE is directly | 390 Returns the name of the local copy, or nil, if FILE is directly |
398 accessible." | 391 accessible." |
399 (let ((handler (find-file-name-handler file 'file-local-copy))) | 392 (let ((handler (find-file-name-handler file 'file-local-copy))) |
400 (if handler | 393 (if handler |
401 (funcall handler 'file-local-copy file) | 394 (funcall handler 'file-local-copy file) |
402 nil))) | 395 nil))) |
403 | 396 |
404 ;; XEmacs change block | |
405 ; We have this in C and use the realpath() system call. | 397 ; We have this in C and use the realpath() system call. |
406 | 398 |
407 ;(defun file-truename (filename &optional counter prev-dirs) | 399 ;(defun file-truename (filename &optional counter prev-dirs) |
408 ; "Return the truename of FILENAME, which should be absolute. | 400 ; "Return the truename of FILENAME, which should be absolute. |
409 ;The truename of a file name is found by chasing symbolic links | 401 ;The truename of a file name is found by chasing symbolic links |
509 dir))))) | 501 dir))))) |
510 (if (and find-file-use-truenames buffer-file-truename) | 502 (if (and find-file-use-truenames buffer-file-truename) |
511 (setq buffer-file-name (abbreviate-file-name buffer-file-truename) | 503 (setq buffer-file-name (abbreviate-file-name buffer-file-truename) |
512 default-directory (file-name-directory buffer-file-name))) | 504 default-directory (file-name-directory buffer-file-name))) |
513 buffer-file-truename)) | 505 buffer-file-truename)) |
514 ;; End XEmacs change block | |
515 | 506 |
516 (defun file-chase-links (filename) | 507 (defun file-chase-links (filename) |
517 "Chase links in FILENAME until a name that is not a link. | 508 "Chase links in FILENAME until a name that is not a link. |
518 Does not examine containing directories for links, | 509 Does not examine containing directories for links, |
519 unlike `file-truename'." | 510 unlike `file-truename'." |
566 (pop-to-buffer buffer t (selected-frame)))) | 557 (pop-to-buffer buffer t (selected-frame)))) |
567 | 558 |
568 (defun switch-to-buffer-other-frame (buffer) | 559 (defun switch-to-buffer-other-frame (buffer) |
569 "Switch to buffer BUFFER in a newly-created frame." | 560 "Switch to buffer BUFFER in a newly-created frame." |
570 (interactive "BSwitch to buffer in other frame: ") | 561 (interactive "BSwitch to buffer in other frame: ") |
571 ;; XEmacs guarantees a new frame | |
572 (let* ((name (get-frame-name-for-buffer buffer)) | 562 (let* ((name (get-frame-name-for-buffer buffer)) |
573 (frame (make-frame (if name | 563 (frame (make-frame (if name |
574 (list (cons 'name (symbol-name name))))))) | 564 (list (cons 'name (symbol-name name))))))) |
575 (pop-to-buffer buffer t frame) | 565 (pop-to-buffer buffer t frame) |
576 (make-frame-visible frame) | 566 (make-frame-visible frame) |
577 buffer)) | 567 buffer)) |
578 | 568 |
579 (defun find-file (filename) | 569 (defun find-file (filename &optional codesys) |
580 "Edit file FILENAME. | 570 "Edit file FILENAME. |
581 Switch to a buffer visiting file FILENAME, | 571 Switch to a buffer visiting file FILENAME, |
582 creating one if none already exists." | 572 creating one if none already exists. |
583 (interactive "FFind file: ") | 573 Under XEmacs/Mule, optional second argument specifies the |
584 (switch-to-buffer (find-file-noselect filename))) | 574 coding system to use when decoding the file. Interactively, |
585 | 575 with a prefix argument, you will be prompted for the coding system." |
586 (defun find-file-other-window (filename) | 576 (interactive "FFind file: \nZCoding system: ") |
577 (if codesys | |
578 (let ((overriding-file-coding-system | |
579 (get-coding-system codesys))) | |
580 (switch-to-buffer (find-file-noselect filename))) | |
581 (switch-to-buffer (find-file-noselect filename)))) | |
582 | |
583 (defun find-file-other-window (filename &optional codesys) | |
587 "Edit file FILENAME, in another window. | 584 "Edit file FILENAME, in another window. |
588 May create a new window, or reuse an existing one. | 585 May create a new window, or reuse an existing one. |
589 See the function `display-buffer'." | 586 See the function `display-buffer'. |
590 (interactive "FFind file in other window: ") | 587 Under XEmacs/Mule, optional second argument specifies the |
591 (switch-to-buffer-other-window (find-file-noselect filename))) | 588 coding system to use when decoding the file. Interactively, |
592 | 589 with a prefix argument, you will be prompted for the coding system." |
593 (defun find-file-other-frame (filename) | 590 (interactive "FFind file in other window: \nZCoding system: ") |
591 (if codesys | |
592 (let ((overriding-file-coding-system | |
593 (get-coding-system codesys))) | |
594 (switch-to-buffer-other-window (find-file-noselect filename))) | |
595 (switch-to-buffer-other-window (find-file-noselect filename)))) | |
596 | |
597 (defun find-file-other-frame (filename &optional codesys) | |
594 "Edit file FILENAME, in a newly-created frame. | 598 "Edit file FILENAME, in a newly-created frame. |
595 This function will create a new frame. | 599 Under XEmacs/Mule, optional second argument specifies the |
596 See the function `display-buffer'." | 600 coding system to use when decoding the file. Interactively, |
597 (interactive "FFind file in other frame: ") | 601 with a prefix argument, you will be prompted for the coding system." |
598 (switch-to-buffer-other-frame (find-file-noselect filename))) | 602 (interactive "FFind file in other frame: \nZCoding system: ") |
599 | 603 (if codesys |
600 (defun find-file-read-only (filename) | 604 (let ((overriding-file-coding-system |
605 (get-coding-system codesys))) | |
606 (switch-to-buffer-other-frame (find-file-noselect filename))) | |
607 (switch-to-buffer-other-frame (find-file-noselect filename)))) | |
608 | |
609 (defun find-file-read-only (filename &optional codesys) | |
601 "Edit file FILENAME but don't allow changes. | 610 "Edit file FILENAME but don't allow changes. |
602 Like \\[find-file] but marks buffer as read-only. | 611 Like \\[find-file] but marks buffer as read-only. |
603 Use \\[toggle-read-only] to permit editing." | 612 Use \\[toggle-read-only] to permit editing. |
604 (interactive "fFind file read-only: ") | 613 Under XEmacs/Mule, optional second argument specifies the |
605 (find-file filename) | 614 coding system to use when decoding the file. Interactively, |
615 with a prefix argument, you will be prompted for the coding system." | |
616 (interactive "fFind file read-only: \nZCoding system: ") | |
617 (if codesys | |
618 (let ((overriding-file-coding-system | |
619 (get-coding-system codesys))) | |
620 (find-file filename)) | |
621 (find-file filename)) | |
606 (setq buffer-read-only t) | 622 (setq buffer-read-only t) |
607 (current-buffer)) | 623 (current-buffer)) |
608 | 624 |
609 (defun find-file-read-only-other-window (filename) | 625 (defun find-file-read-only-other-window (filename &optional codesys) |
610 "Edit file FILENAME in another window but don't allow changes. | 626 "Edit file FILENAME in another window but don't allow changes. |
611 Like \\[find-file-other-window] but marks buffer as read-only. | 627 Like \\[find-file-other-window] but marks buffer as read-only. |
612 Use \\[toggle-read-only] to permit editing." | 628 Use \\[toggle-read-only] to permit editing. |
613 (interactive "fFind file read-only other window: ") | 629 Under XEmacs/Mule, optional second argument specifies the |
614 (find-file-other-window filename) | 630 coding system to use when decoding the file. Interactively, |
631 with a prefix argument, you will be prompted for the coding system." | |
632 (interactive "fFind file read-only other window: \nZCoding system: ") | |
633 (if codesys | |
634 (let ((overriding-file-coding-system | |
635 (get-coding-system codesys))) | |
636 (find-file-other-window filename)) | |
637 (find-file-other-window filename)) | |
615 (setq buffer-read-only t) | 638 (setq buffer-read-only t) |
616 (current-buffer)) | 639 (current-buffer)) |
617 | 640 |
618 (defun find-file-read-only-other-frame (filename) | 641 (defun find-file-read-only-other-frame (filename &optional codesys) |
619 "Edit file FILENAME in another frame but don't allow changes. | 642 "Edit file FILENAME in another frame but don't allow changes. |
620 Like \\[find-file-other-frame] but marks buffer as read-only. | 643 Like \\[find-file-other-frame] but marks buffer as read-only. |
621 Use \\[toggle-read-only] to permit editing." | 644 Use \\[toggle-read-only] to permit editing. |
622 (interactive "fFind file read-only other frame: ") | 645 Under XEmacs/Mule, optional second argument specifies the |
623 (find-file-other-frame filename) | 646 coding system to use when decoding the file. Interactively, |
647 with a prefix argument, you will be prompted for the coding system." | |
648 (interactive "fFind file read-only other frame: \nZCoding system: ") | |
649 (if codesys | |
650 (let ((overriding-file-coding-system | |
651 (get-coding-system codesys))) | |
652 (find-file-other-frame filename)) | |
653 (find-file-other-frame filename)) | |
624 (setq buffer-read-only t) | 654 (setq buffer-read-only t) |
625 (current-buffer)) | 655 (current-buffer)) |
626 | 656 |
627 (defun find-alternate-file-other-window (filename) | 657 (defun find-alternate-file-other-window (filename &optional codesys) |
628 "Find file FILENAME as a replacement for the file in the next window. | 658 "Find file FILENAME as a replacement for the file in the next window. |
629 This command does not select that window." | 659 This command does not select that window. |
660 Under XEmacs/Mule, optional second argument specifies the | |
661 coding system to use when decoding the file. Interactively, | |
662 with a prefix argument, you will be prompted for the coding system." | |
630 (interactive | 663 (interactive |
631 (save-selected-window | 664 (save-selected-window |
632 (other-window 1) | 665 (other-window 1) |
633 (let ((file buffer-file-name) | 666 (let ((file buffer-file-name) |
634 (file-name nil) | 667 (file-name nil) |
635 (file-dir nil)) | 668 (file-dir nil)) |
636 (and file | 669 (and file |
637 (setq file-name (file-name-nondirectory file) | 670 (setq file-name (file-name-nondirectory file) |
638 file-dir (file-name-directory file))) | 671 file-dir (file-name-directory file))) |
639 (list (read-file-name | 672 (list (read-file-name |
640 "Find alternate file: " file-dir nil nil file-name))))) | 673 "Find alternate file: " file-dir nil nil file-name) |
674 (if (and current-prefix-arg (featurep 'mule)) | |
675 (read-coding-system "Coding-system: ")))))) | |
641 (if (one-window-p) | 676 (if (one-window-p) |
642 (find-file-other-window filename) | 677 (find-file-other-window filename) |
643 (save-selected-window | 678 (save-selected-window |
644 (other-window 1) | 679 (other-window 1) |
645 (find-alternate-file filename)))) | 680 (find-alternate-file filename codesys)))) |
646 | 681 |
647 (defun find-alternate-file (filename) | 682 (defun find-alternate-file (filename &optional codesys) |
648 "Find file FILENAME, select its buffer, kill previous buffer. | 683 "Find file FILENAME, select its buffer, kill previous buffer. |
649 If the current buffer now contains an empty file that you just visited | 684 If the current buffer now contains an empty file that you just visited |
650 \(presumably by mistake), use this command to visit the file you really want." | 685 \(presumably by mistake), use this command to visit the file you really want. |
686 Under XEmacs/Mule, optional second argument specifies the | |
687 coding system to use when decoding the file. Interactively, | |
688 with a prefix argument, you will be prompted for the coding system." | |
651 (interactive | 689 (interactive |
652 (let ((file buffer-file-name) | 690 (let ((file buffer-file-name) |
653 (file-name nil) | 691 (file-name nil) |
654 (file-dir nil)) | 692 (file-dir nil)) |
655 (and file | 693 (and file |
656 (setq file-name (file-name-nondirectory file) | 694 (setq file-name (file-name-nondirectory file) |
657 file-dir (file-name-directory file))) | 695 file-dir (file-name-directory file))) |
658 (list (read-file-name | 696 (list (read-file-name |
659 "Find alternate file: " file-dir nil nil file-name)))) | 697 "Find alternate file: " file-dir nil nil file-name) |
698 (if (and current-prefix-arg (featurep 'mule)) | |
699 (read-coding-system "Coding-system: "))))) | |
660 (and (buffer-modified-p) (buffer-file-name) | 700 (and (buffer-modified-p) (buffer-file-name) |
661 ;; (not buffer-read-only) | 701 ;; (not buffer-read-only) |
662 (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? " | 702 (not (yes-or-no-p (format |
663 (buffer-name)))) | 703 "Buffer %s is modified; kill anyway? " |
704 (buffer-name)))) | |
664 (error "Aborted")) | 705 (error "Aborted")) |
665 (let ((obuf (current-buffer)) | 706 (let ((obuf (current-buffer)) |
666 (ofile buffer-file-name) | 707 (ofile buffer-file-name) |
667 (onum buffer-file-number) | 708 (onum buffer-file-number) |
668 (otrue buffer-file-truename) | 709 (otrue buffer-file-truename) |
669 (oname (buffer-name))) | 710 (oname (buffer-name))) |
670 (if (get-buffer " **lose**") | 711 (if (get-buffer " **lose**") |
671 (kill-buffer " **lose**")) | 712 (kill-buffer " **lose**")) |
672 (rename-buffer " **lose**") | 713 (rename-buffer " **lose**") |
714 (setq buffer-file-name nil) | |
715 (setq buffer-file-number nil) | |
716 (setq buffer-file-truename nil) | |
673 (unwind-protect | 717 (unwind-protect |
674 (progn | 718 (progn |
675 (unlock-buffer) | 719 (unlock-buffer) |
676 (setq buffer-file-name nil) | 720 (if codesys |
677 (setq buffer-file-number nil) | 721 (let ((overriding-file-coding-system |
678 (setq buffer-file-truename nil) | 722 (get-coding-system codesys))) |
679 (find-file filename)) | 723 (find-file filename)) |
724 (find-file filename))) | |
680 (cond ((eq obuf (current-buffer)) | 725 (cond ((eq obuf (current-buffer)) |
681 (setq buffer-file-name ofile) | 726 (setq buffer-file-name ofile) |
682 (setq buffer-file-number onum) | 727 (setq buffer-file-number onum) |
683 (setq buffer-file-truename otrue) | 728 (setq buffer-file-truename otrue) |
684 (lock-buffer) | 729 (lock-buffer) |
688 | 733 |
689 (defun create-file-buffer (filename) | 734 (defun create-file-buffer (filename) |
690 "Create a suitably named buffer for visiting FILENAME, and return it. | 735 "Create a suitably named buffer for visiting FILENAME, and return it. |
691 FILENAME (sans directory) is used unchanged if that name is free; | 736 FILENAME (sans directory) is used unchanged if that name is free; |
692 otherwise a string <2> or <3> or ... is appended to get an unused name." | 737 otherwise a string <2> or <3> or ... is appended to get an unused name." |
693 (let ((handler (find-file-name-handler filename 'create-file-buffer))) | 738 (let ((lastname (file-name-nondirectory filename))) |
694 (if handler | 739 (if (string= lastname "") |
695 (funcall handler 'create-file-buffer filename) | 740 (setq lastname filename)) |
696 (let ((lastname (file-name-nondirectory filename))) | 741 (generate-new-buffer lastname))) |
697 (if (string= lastname "") | |
698 (setq lastname filename)) | |
699 (generate-new-buffer lastname))))) | |
700 | 742 |
701 (defun generate-new-buffer (name) | 743 (defun generate-new-buffer (name) |
702 "Create and return a buffer with a name based on NAME. | 744 "Create and return a buffer with a name based on NAME. |
703 Choose the buffer's name using `generate-new-buffer-name'." | 745 Choose the buffer's name using `generate-new-buffer-name'." |
704 (get-buffer-create (generate-new-buffer-name name))) | 746 (get-buffer-create (generate-new-buffer-name name))) |
705 | 747 |
706 ;(defconst automount-dir-prefix "^/tmp_mnt/" | 748 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general. |
707 ; "Regexp to match the automounter prefix in a directory name.") | 749 ;; note: tmp_mnt bogosity conversion is established in paths.el. |
750 (defvar directory-abbrev-alist nil | |
751 "*Alist of abbreviations for file directories. | |
752 A list of elements of the form (FROM . TO), each meaning to replace | |
753 FROM with TO when it appears in a directory name. | |
754 This replacement is done when setting up the default directory of a | |
755 newly visited file. *Every* FROM string should start with \\\\` or ^. | |
756 | |
757 Use this feature when you have directories which you normally refer to | |
758 via absolute symbolic links or to eliminate automounter mount points | |
759 from the beginning of your filenames. Make TO the name of the link, | |
760 and FROM the name it is linked to.") | |
708 | 761 |
709 (defvar abbreviated-home-dir nil | 762 (defvar abbreviated-home-dir nil |
710 "The user's homedir abbreviated according to `directory-abbrev-alist'.") | 763 "The user's homedir abbreviated according to `directory-abbrev-alist'.") |
711 | 764 |
712 ;; XEmacs additional parameter | |
713 (defun abbreviate-file-name (filename &optional hack-homedir) | 765 (defun abbreviate-file-name (filename &optional hack-homedir) |
714 "Return a version of FILENAME shortened using `directory-abbrev-alist'. | 766 "Return a version of FILENAME shortened using `directory-abbrev-alist'. |
715 See documentation of variable `directory-abbrev-alist' for more information. | 767 See documentation of variable `directory-abbrev-alist' for more information. |
716 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes | 768 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes |
717 \"~\" for the user's home directory." | 769 \"~\" for the user's home directory." |
718 (let ((handler (find-file-name-handler filename 'abbreviate-file-name))) | 770 ;; Get rid of the prefixes added by the automounter. |
719 (if handler | 771 ;(if (and (string-match automount-dir-prefix filename) |
720 (funcall handler 'abbreviate-file-name filename hack-homedir) | 772 ; (file-exists-p (file-name-directory |
721 ;; Get rid of the prefixes added by the automounter. | 773 ; (substring filename (1- (match-end 0)))))) |
722 ;;(if (and (string-match automount-dir-prefix filename) | 774 ; (setq filename (substring filename (1- (match-end 0))))) |
723 ;; (file-exists-p (file-name-directory | 775 (let ((tail directory-abbrev-alist)) |
724 ;; (substring filename (1- (match-end 0)))))) | 776 ;; If any elt of directory-abbrev-alist matches this name, |
725 ;; (setq filename (substring filename (1- (match-end 0))))) | 777 ;; abbreviate accordingly. |
726 (let ((tail directory-abbrev-alist)) | 778 (while tail |
727 ;; If any elt of directory-abbrev-alist matches this name, | 779 (if (string-match (car (car tail)) filename) |
728 ;; abbreviate accordingly. | 780 (setq filename |
729 (while tail | 781 (concat (cdr (car tail)) (substring filename (match-end 0))))) |
730 (if (string-match (car (car tail)) filename) | 782 (setq tail (cdr tail)))) |
731 (setq filename | 783 (if hack-homedir |
732 (concat (cdr (car tail)) (substring filename (match-end 0))))) | 784 (progn |
733 (setq tail (cdr tail)))) | 785 ;; Compute and save the abbreviated homedir name. |
734 (if hack-homedir | 786 ;; We defer computing this until the first time it's needed, to |
735 (progn | 787 ;; give time for directory-abbrev-alist to be set properly. |
736 ;; Compute and save the abbreviated homedir name. | 788 ;; We include a slash at the end, to avoid spurious matches |
737 ;; We defer computing this until the first time it's needed, to | 789 ;; such as `/usr/foobar' when the home dir is `/usr/foo'. |
738 ;; give time for directory-abbrev-alist to be set properly. | 790 (or abbreviated-home-dir |
739 ;; We include a slash at the end, to avoid spurious matches | 791 (setq abbreviated-home-dir |
740 ;; such as `/usr/foobar' when the home dir is `/usr/foo'. | 792 (let ((abbreviated-home-dir "$foo")) |
741 (or abbreviated-home-dir | 793 (concat "\\`" (regexp-quote (abbreviate-file-name |
742 (setq abbreviated-home-dir | 794 (expand-file-name "~"))) |
743 (let ((abbreviated-home-dir "$foo")) | 795 "\\(/\\|\\'\\)")))) |
744 (concat "\\`" (regexp-quote (abbreviate-file-name | 796 ;; If FILENAME starts with the abbreviated homedir, |
745 (expand-file-name "~"))) | 797 ;; make it start with `~' instead. |
746 "\\(/\\|\\'\\)")))) | 798 (if (and (string-match abbreviated-home-dir filename) |
747 ;; If FILENAME starts with the abbreviated homedir, | 799 ;; If the home dir is just /, don't change it. |
748 ;; make it start with `~' instead. | 800 (not (and (= (match-end 0) 1) ;#### unix-specific |
749 (if (and (string-match abbreviated-home-dir filename) | 801 (= (aref filename 0) ?/))) |
750 ;; If the home dir is just /, don't change it. | 802 (not (and (or (eq system-type 'ms-dos) |
751 (not (and (= (match-end 0) 1) ;#### unix-specific | 803 (eq system-type 'windows-nt)) |
752 (= (aref filename 0) ?/))) | 804 (save-match-data |
753 ;; MS-DOS root directories can come with a drive letter; | 805 (string-match "^[a-zA-Z]:/$" filename))))) |
754 ;; Novell Netware allows drive letters beyond `Z:'. | 806 (setq filename |
755 (not (and (or (eq system-type 'ms-dos) | 807 (concat "~" |
756 (eq system-type 'windows-nt)) | 808 (substring filename |
757 (save-match-data | 809 (match-beginning 1) (match-end 1)) |
758 (string-match "^[a-zA-Z-`]:/$" filename))))) | 810 (substring filename (match-end 0))))))) |
759 (setq filename | 811 filename) |
760 (concat "~" | |
761 (substring filename | |
762 (match-beginning 1) (match-end 1)) | |
763 (substring filename (match-end 0))))))) | |
764 filename))) | |
765 | 812 |
766 (defvar find-file-not-true-dirname-list nil | 813 (defvar find-file-not-true-dirname-list nil |
767 "*List of logical names for which visiting shouldn't save the true dirname. | 814 "*List of logical names for which visiting shouldn't save the true dirname. |
768 On VMS, when you visit a file using a logical name that searches a path, | 815 On VMS, when you visit a file using a logical name that searches a path, |
769 you may or may not want the visited file name to record the specific | 816 you may or may not want the visited file name to record the specific |
770 directory where the file was found. If you *do not* want that, add the logical | 817 directory where the file was found. If you *do not* want that, add the logical |
771 name to this list as a string.") | 818 name to this list as a string.") |
772 | 819 |
773 ;; XEmacs -- why was this commented out?? -- Hrv | 820 ;(defun find-buffer-visiting (filename) |
774 (defun find-buffer-visiting (filename) | 821 ; "Return the buffer visiting file FILENAME (a string). |
775 "Return the buffer visiting file FILENAME (a string). | 822 ;This is like `get-file-buffer', except that it checks for any buffer |
776 This is like `get-file-buffer', except that it checks for any buffer | 823 ;visiting the same file, possibly under a different name. |
777 visiting the same file, possibly under a different name. | 824 ;If there is no such live buffer, return nil." |
778 If there is no such live buffer, return nil." | 825 ; (let ((buf (get-file-buffer filename)) |
779 (let ((buf (get-file-buffer filename)) | 826 ; (truename (abbreviate-file-name (file-truename filename)))) |
780 (truename (abbreviate-file-name (file-truename filename)))) | 827 ; (or buf |
781 (or buf | 828 ; (let ((list (buffer-list)) found) |
782 (let ((list (buffer-list)) found) | 829 ; (while (and (not found) list) |
783 (while (and (not found) list) | 830 ; (save-excursion |
784 (save-excursion | 831 ; (set-buffer (car list)) |
785 (set-buffer (car list)) | 832 ; (if (and buffer-file-name |
786 (if (and buffer-file-name | 833 ; (string= buffer-file-truename truename)) |
787 (string= buffer-file-truename truename)) | 834 ; (setq found (car list)))) |
788 (setq found (car list)))) | 835 ; (setq list (cdr list))) |
789 (setq list (cdr list))) | 836 ; found) |
790 found) | 837 ; (let ((number (nthcdr 10 (file-attributes truename))) |
791 (let ((number (nthcdr 10 (file-attributes truename))) | 838 ; (list (buffer-list)) found) |
792 (list (buffer-list)) found) | 839 ; (and number |
793 (and buffer-file-numbers-unique | 840 ; (while (and (not found) list) |
794 number | 841 ; (save-excursion |
795 (while (and (not found) list) | 842 ; (set-buffer (car list)) |
796 (save-excursion | 843 ; (if (and buffer-file-number |
797 (set-buffer (car list)) | 844 ; (equal buffer-file-number number) |
798 (if (and buffer-file-name | 845 ; ;; Verify this buffer's file number |
799 (equal buffer-file-number number) | 846 ; ;; still belongs to its file. |
800 ;; Verify this buffer's file number | 847 ; (file-exists-p buffer-file-name) |
801 ;; still belongs to its file. | 848 ; (equal (nthcdr 10 (file-attributes buffer-file-name)) |
802 (file-exists-p buffer-file-name) | 849 ; number)) |
803 (equal (nthcdr 10 (file-attributes buffer-file-name)) | 850 ; (setq found (car list)))) |
804 number)) | 851 ; (setq list (cdr list)))) |
805 (setq found (car list)))) | 852 ; found)))) |
806 (setq list (cdr list)))) | |
807 found)))) | |
808 | 853 |
809 (defun insert-file-contents-literally (filename &optional visit beg end replace) | 854 (defun insert-file-contents-literally (filename &optional visit beg end replace) |
810 "Like `insert-file-contents', q.v., but only reads in the file. | 855 "Like `insert-file-contents', q.v., but only reads in the file. |
811 A buffer may be modified in several ways after reading into the buffer due | 856 A buffer may be modified in several ways after reading into the buffer due |
812 to advanced Emacs features, such as file-name-handlers, format decoding, | 857 to advanced Emacs features, such as file-name-handlers, format decoding, |
832 If a buffer exists visiting FILENAME, return that one, but | 877 If a buffer exists visiting FILENAME, return that one, but |
833 verify that the file has not changed since visited or saved. | 878 verify that the file has not changed since visited or saved. |
834 The buffer is not selected, just returned to the caller. | 879 The buffer is not selected, just returned to the caller. |
835 If NOWARN is non-nil warning messages about several potential | 880 If NOWARN is non-nil warning messages about several potential |
836 problems will be suppressed." | 881 problems will be suppressed." |
837 (setq filename | 882 (setq filename (abbreviate-file-name (expand-file-name filename))) |
838 (abbreviate-file-name | |
839 (expand-file-name filename))) | |
840 (if (file-directory-p filename) | 883 (if (file-directory-p filename) |
841 (if find-file-run-dired | 884 (if find-file-run-dired |
842 (dired-noselect (if find-file-use-truenames ; XEmacs | 885 (dired-noselect (if find-file-use-truenames |
843 (abbreviate-file-name (file-truename filename)) | 886 (abbreviate-file-name (file-truename filename)) |
844 filename)) | 887 filename)) |
845 (error "%s is a directory" filename)) | 888 (error "%s is a directory." filename)) |
846 (let* ((buf (get-file-buffer filename)) | 889 (let* ((buf (get-file-buffer filename)) |
847 ; (truename (abbreviate-file-name (file-truename filename))) | 890 ; (truename (abbreviate-file-name (file-truename filename))) |
848 ; (number (nthcdr 10 (file-attributes truename))) | 891 ; (number (nthcdr 10 (file-attributes truename))) |
849 (number (and buffer-file-truename | 892 (number (and buffer-file-truename |
850 (nthcdr 10 (file-attributes buffer-file-truename)))) | 893 (nthcdr 10 (file-attributes buffer-file-truename)))) |
851 ; ;; Find any buffer for a file which has same truename. | 894 ; ;; Find any buffer for a file which has same truename. |
852 ; (other (and (not buf) (find-buffer-visiting filename))) | 895 ; (other (and (not buf) (find-buffer-visiting filename))) |
853 (error nil)) | 896 (error nil)) |
854 | 897 |
855 ; ;; Let user know if there is a buffer with the same truename. | 898 ; ;; Let user know if there is a buffer with the same truename. |
856 ; (if other | 899 ; (if (and (not buf) same-truename (not nowarn)) |
857 ; (progn | 900 ; (message "%s and %s are the same file (%s)" |
858 ; (or nowarn | 901 ; filename (buffer-file-name same-truename) |
859 ; (string-equal filename (buffer-file-name other)) | 902 ; truename) |
860 ; (message "%s and %s are the same file" | 903 ; (if (and (not buf) same-number (not nowarn)) |
861 ; filename (buffer-file-name other))) | 904 ; (message "%s and %s are the same file" |
862 ; ;; Optionally also find that buffer. | 905 ; filename (buffer-file-name same-number)))) |
863 ; (if (or find-file-existing-other-name find-file-visit-truename) | 906 ; ;; Optionally also find that buffer. |
864 ; (setq buf other)))) | 907 ; (if (or find-file-existing-other-name find-file-visit-truename) |
908 ; (setq buf (or same-truename same-number))) | |
865 | 909 |
866 (if (and buf | 910 (if (and buf |
867 (or find-file-compare-truenames find-file-use-truenames) | 911 (or find-file-compare-truenames find-file-use-truenames) |
868 (not nowarn)) | 912 (not nowarn)) |
869 (save-excursion | 913 (save-excursion |
911 (condition-case () | 955 (condition-case () |
912 (insert-file-contents-literally filename t) | 956 (insert-file-contents-literally filename t) |
913 (file-error | 957 (file-error |
914 ;; Unconditionally set error | 958 ;; Unconditionally set error |
915 (setq error t))) | 959 (setq error t))) |
916 (condition-case e ; XEmacs - pass error through | 960 (condition-case e |
917 (insert-file-contents filename t) | 961 (insert-file-contents filename t) |
918 (file-error | 962 (file-error |
919 ;; Run find-file-not-found-hooks until one returns non-nil. | 963 ;; Run find-file-not-found-hooks until one returns non-nil. |
920 (or (run-hook-with-args-until-success 'find-file-not-found-hooks) | 964 (or (run-hook-with-args-until-success 'find-file-not-found-hooks) |
921 ;; If they fail too, set error. | 965 ;; If they fail too, set error. |
922 (setq error e))))) ; XEmacs | 966 (setq error e))))) |
923 ;; Find the file's truename, and maybe use that as visited name. | 967 ;; Find the file's truename, and maybe use that as visited name. |
924 ;; automatically computed in XEmacs. | 968 ;; automatically computed in XEmacs. |
925 ; (setq buffer-file-truename truename) | 969 ; (setq buffer-file-truename truename) |
926 (setq buffer-file-number number) | 970 (setq buffer-file-number number) |
927 ;; On VMS, we may want to remember which directory in a search list | 971 ;; On VMS, we may want to remember which directory in a search list |
951 (progn | 995 (progn |
952 (make-local-variable 'backup-inhibited) | 996 (make-local-variable 'backup-inhibited) |
953 (setq backup-inhibited t))) | 997 (setq backup-inhibited t))) |
954 (if rawfile | 998 (if rawfile |
955 nil | 999 nil |
956 (after-find-file error (not nowarn)) | 1000 (after-find-file error (not nowarn))))) |
957 (setq buf (current-buffer))))) | |
958 buf))) | 1001 buf))) |
959 | 1002 |
960 (defvar after-find-file-from-revert-buffer nil) | 1003 (defvar after-find-file-from-revert-buffer nil) |
961 | 1004 |
962 (defun after-find-file (&optional error warn noauto | 1005 (defun after-find-file (&optional error warn noauto |
963 after-find-file-from-revert-buffer | 1006 after-find-file-from-revert-buffer) |
964 nomodes) | |
965 "Called after finding a file and by the default revert function. | 1007 "Called after finding a file and by the default revert function. |
966 Sets buffer mode, parses local variables. | 1008 Sets buffer mode, parses local variables. |
967 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an | 1009 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an |
968 error in reading the file. WARN non-nil means warn if there | 1010 error in reading the file. WARN non-nil means warn if there |
969 exists an auto-save file more recent than the visited file. | 1011 exists an auto-save file more recent than the visited file. |
970 NOAUTO means don't mess with auto-save mode. | 1012 NOAUTO means don't mess with auto-save mode. |
971 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil | 1013 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil |
972 means this call was from `revert-buffer'. | 1014 means this call was from `revert-buffer'. |
973 Finishes by calling the functions in `find-file-hooks'. | 1015 Finishes by calling the functions in `find-file-hooks'." |
974 Fifth arg NOMODES non-nil means don't alter the file's modes. | |
975 Finishes by calling the functions in `find-file-hooks' | |
976 unless NOMODES is non-nil." | |
977 (setq buffer-read-only (not (file-writable-p buffer-file-name))) | 1016 (setq buffer-read-only (not (file-writable-p buffer-file-name))) |
978 (if noninteractive | 1017 (if noninteractive |
979 nil | 1018 nil |
980 (let* (not-serious | 1019 (let* (not-serious |
981 (msg | 1020 (msg |
1000 ;; If the directory the buffer is in doesn't exist, | 1039 ;; If the directory the buffer is in doesn't exist, |
1001 ;; offer to create it. It's better to do this now | 1040 ;; offer to create it. It's better to do this now |
1002 ;; than when we save the buffer, because we want | 1041 ;; than when we save the buffer, because we want |
1003 ;; autosaving to work. | 1042 ;; autosaving to work. |
1004 (setq buffer-read-only nil) | 1043 (setq buffer-read-only nil) |
1005 ;; XEmacs change | |
1006 (or (file-exists-p (file-name-directory buffer-file-name)) | 1044 (or (file-exists-p (file-name-directory buffer-file-name)) |
1007 (if (yes-or-no-p | 1045 (if (yes-or-no-p |
1008 (format | 1046 (format |
1009 "The directory containing %s does not exist. Create? " | 1047 "The directory containing %s does not exist. Create? " |
1010 (abbreviate-file-name buffer-file-name))) | 1048 (abbreviate-file-name buffer-file-name))) |
1016 (progn | 1054 (progn |
1017 (message msg) | 1055 (message msg) |
1018 (or not-serious (sit-for 1 t))))) | 1056 (or not-serious (sit-for 1 t))))) |
1019 (if (and auto-save-default (not noauto)) | 1057 (if (and auto-save-default (not noauto)) |
1020 (auto-save-mode t))) | 1058 (auto-save-mode t))) |
1021 (unless nomodes | 1059 (normal-mode t) |
1022 (normal-mode t) | 1060 (run-hooks 'find-file-hooks)) |
1023 (run-hooks 'find-file-hooks))) | |
1024 | 1061 |
1025 (defun normal-mode (&optional find-file) | 1062 (defun normal-mode (&optional find-file) |
1026 "Choose the major mode for this buffer automatically. | 1063 "Choose the major mode for this buffer automatically. |
1027 Also sets up any specified local variables of the file. | 1064 Also sets up any specified local variables of the file. |
1028 Uses the visited file name, the -*- line, and the local variables spec. | 1065 Uses the visited file name, the -*- line, and the local variables spec. |
1032 `enable-local-variables': if it is t, we do; if it is nil, we don't; | 1069 `enable-local-variables': if it is t, we do; if it is nil, we don't; |
1033 otherwise, we query. `enable-local-variables' is ignored if you | 1070 otherwise, we query. `enable-local-variables' is ignored if you |
1034 run `normal-mode' explicitly." | 1071 run `normal-mode' explicitly." |
1035 (interactive) | 1072 (interactive) |
1036 (or find-file (funcall (or default-major-mode 'fundamental-mode))) | 1073 (or find-file (funcall (or default-major-mode 'fundamental-mode))) |
1037 ;; XEmacs change | |
1038 (and (condition-case err | 1074 (and (condition-case err |
1039 (progn (set-auto-mode) | 1075 (progn (set-auto-mode) |
1040 t) | 1076 t) |
1041 (error (message "File mode specification error: %s" | 1077 (error (message "File mode specification error: %s" |
1042 (prin1-to-string err)) | 1078 (prin1-to-string err)) |
1049 (defvar auto-mode-alist | 1085 (defvar auto-mode-alist |
1050 (mapcar | 1086 (mapcar |
1051 'purecopy | 1087 'purecopy |
1052 '(("\\.te?xt\\'" . text-mode) | 1088 '(("\\.te?xt\\'" . text-mode) |
1053 ("\\.[ch]\\'" . c-mode) | 1089 ("\\.[ch]\\'" . c-mode) |
1054 ("\\.tex\\'" . tex-mode) | |
1055 ("\\.ltx\\'" . latex-mode) | 1090 ("\\.ltx\\'" . latex-mode) |
1056 ("\\.el\\'" . emacs-lisp-mode) | 1091 ("\\.el\\'" . emacs-lisp-mode) |
1057 ("\\.l\\(i?sp\\)?\\'" . lisp-mode) | 1092 ("\\.l\\(i?sp\\)?\\'" . lisp-mode) |
1058 ("\\.[Ff]\\(or\\)?\\'" . fortran-mode) | 1093 ("\\.f\\(or\\)?\\'" . fortran-mode) |
1059 ("\\.p\\(as\\)?\\'" . pascal-mode) | 1094 ("\\.p\\(as\\)?\\'" . pascal-mode) |
1060 ("\\.ad[abs]\\'" . ada-mode) | 1095 ("\\.ad[abs]\\'" . ada-mode) |
1061 ("\\.pl\\'" . perl-mode) | 1096 ("\\.p[lm]\\'" . perl-mode) |
1062 ("\\.pm\\'" . perl-mode) | |
1063 ("\\.\\([CH]\\|cc\\|hh\\)\\'" . c++-mode) | 1097 ("\\.\\([CH]\\|cc\\|hh\\)\\'" . c++-mode) |
1064 ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode) | 1098 ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode) |
1065 ("\\.java\\'" . java-mode) | 1099 ("\\.java\\'" . java-mode) |
1066 ("\\.ma?k\\'" . makefile-mode) | 1100 ("\\.ma?k\\'" . makefile-mode) |
1067 ("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\(.in\\)?\\'" . makefile-mode) | 1101 ("[Mm]akefile\\(.in\\)?\\(.in\\)?\\'" . makefile-mode) |
1068 ;;; Less common extensions come here | 1102 ;;; Less common extensions come here |
1069 ;;; so more common ones above are found faster. | 1103 ;;; so more common ones above are found faster. |
1070 ("\\.texi\\(nfo\\)?\\'" . texinfo-mode) | 1104 ("\\.texi\\(nfo\\)?\\'" . texinfo-mode) |
1071 ("\\.[Ss]\\'" . asm-mode) | 1105 ("\\.[sS]\\'" . asm-mode) |
1072 ("\\.asm\\'" . asm-mode) | |
1073 ("[Cc]hange.?[Ll]og?\\(.[0-9]+\\)?\\'" . change-log-mode) | 1106 ("[Cc]hange.?[Ll]og?\\(.[0-9]+\\)?\\'" . change-log-mode) |
1074 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) | 1107 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) |
1075 ("\\.scm\\(\\.[0-9]*\\)?\\'" . scheme-mode) | 1108 ("\\.scm\\(\\.[0-9]*\\)?\\'" . scheme-mode) |
1076 ("\\.py\\'" . python-mode) | 1109 ("\\.py\\'" . python-mode) |
1077 ("\\.e\\'" . eiffel-mode) | 1110 ("\\.e\\'" . eiffel-mode) |
1078 ("\\.mss\\'" . scribe-mode) | 1111 ("\\.mss\\'" . scribe-mode) |
1079 ("\\.m\\([mes]\\|an\\)\\'" . nroff-mode) | 1112 ("\\.m\\([mes]\\|an\\)\\'" . nroff-mode) |
1080 ("\\.icn\\'" . icon-mode) | 1113 ("\\.icn\\'" . icon-mode) |
1081 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) | |
1082 ("/\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) | |
1083 ("/\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) | |
1084 ("/\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) | |
1085 ;;; The following should come after the ChangeLog pattern | 1114 ;;; The following should come after the ChangeLog pattern |
1086 ;;; for the sake of ChangeLog.1, etc. | 1115 ;;; for the sake of ChangeLog.1, etc. |
1087 ;;; and after the .scm.[0-9] pattern too. | 1116 ;;; and after the .scm.[0-9] pattern too. |
1088 ("\\.[12345678]\\'" . nroff-mode) | 1117 ("\\.[12345678]\\'" . nroff-mode) |
1089 ("\\.[tT]e[xX]\\'" . tex-mode) | 1118 ("\\.[tT]e[xX]\\'" . tex-mode) |
1092 ("\\.article\\'" . text-mode) | 1121 ("\\.article\\'" . text-mode) |
1093 ("\\.letter\\'" . text-mode) | 1122 ("\\.letter\\'" . text-mode) |
1094 ("\\.\\(tcl\\|exp\\)\\'" . tcl-mode) | 1123 ("\\.\\(tcl\\|exp\\)\\'" . tcl-mode) |
1095 ("\\.wrl\\'" . vrml-mode) | 1124 ("\\.wrl\\'" . vrml-mode) |
1096 ("\\.f90\\'" . f90-mode) | 1125 ("\\.f90\\'" . f90-mode) |
1097 ("\\.lsp\\'" . lisp-mode) | |
1098 ("\\.awk\\'" . awk-mode) | 1126 ("\\.awk\\'" . awk-mode) |
1099 ("\\.prolog\\'" . prolog-mode) | 1127 ("\\.prolog\\'" . prolog-mode) |
1100 ("\\.tar\\'" . tar-mode) | 1128 ("\\.tar\\'" . tar-mode) |
1101 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) | 1129 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) |
1102 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\)\\'" . archive-mode) | |
1103 ;; Mailer puts message to be edited in | 1130 ;; Mailer puts message to be edited in |
1104 ;; /tmp/Re.... or Message | 1131 ;; /tmp/Re.... or Message |
1105 ("^/tmp/Re" . text-mode) | 1132 ("^/tmp/Re" . text-mode) |
1106 ("^/tmp/L[0-9]+TMP\\.html" . text-mode) ; Lynx mail mode | |
1107 ("/Message[0-9]*\\'" . text-mode) | 1133 ("/Message[0-9]*\\'" . text-mode) |
1108 ("/drafts/[0-9]+\\'" . mh-letter-mode) | 1134 ("/drafts/[0-9]+\\'" . mh-letter-mode) |
1109 ;; some news reader is reported to use this | 1135 ;; some news reader is reported to use this |
1110 ("^/tmp/fol/" . text-mode) | 1136 ("^/tmp/fol/" . text-mode) |
1111 ("\\.y\\'" . c-mode) | 1137 ("\\.y\\'" . c-mode) |
1132 calling FUNCTION (if it's not nil), we delete the suffix that matched | 1158 calling FUNCTION (if it's not nil), we delete the suffix that matched |
1133 REGEXP and search the list again for another match.") | 1159 REGEXP and search the list again for another match.") |
1134 | 1160 |
1135 (defconst interpreter-mode-alist | 1161 (defconst interpreter-mode-alist |
1136 (mapcar 'purecopy | 1162 (mapcar 'purecopy |
1137 '(("^#!.*[acjkwz]sh" . sh-mode) | 1163 '(("^#!.*csh" . sh-mode) |
1138 ("^#!.*sh\\b" . sh-mode) | 1164 ("^#!.*sh\\b" . ksh-mode) |
1139 ("^#!.*\\b\\(scope\\|wishx?\\|tcl\\|tclsh\\|expect\\)" . tcl-mode) | 1165 ("^#!.*\\b\\(scope\\|wish\\|tcl\\|expect\\)" . tcl-mode) |
1140 ("perl" . perl-mode) | 1166 ("perl" . perl-mode) |
1141 ("python" . python-mode) | 1167 ("python" . python-mode) |
1142 ("[mng]?awk\\b" . awk-mode) | 1168 ("awk\\b" . awk-mode) |
1143 ("rexx" . rexx-mode) | 1169 ("rexx" . rexx-mode) |
1144 ("scm" . scheme-mode) | 1170 ("scm" . scheme-mode) |
1145 ("^:" . sh-mode) | 1171 ("^:" . ksh-mode) |
1146 )) | 1172 )) |
1147 "Alist mapping interpreter names to major modes. | 1173 "Alist mapping interpreter names to major modes. |
1148 This alist is used to guess the major mode of a file based on the | 1174 This alist is used to guess the major mode of a file based on the |
1149 contents of the first line. This line often contains something like: | 1175 contents of the first line. This line often contains something like: |
1150 #!/bin/sh | 1176 #!/bin/sh |
1168 | 1194 |
1169 (defvar user-init-file | 1195 (defvar user-init-file |
1170 "" ; set by command-line | 1196 "" ; set by command-line |
1171 "File name including directory of user's initialization file.") | 1197 "File name including directory of user's initialization file.") |
1172 | 1198 |
1173 ;; XEmacs (This function is not synched with FSF) | |
1174 (defun set-auto-mode () | 1199 (defun set-auto-mode () |
1175 "Select major mode appropriate for current buffer. | 1200 "Select major mode appropriate for current buffer. |
1176 This checks for a -*- mode tag in the buffer's text, | 1201 This checks for a -*- mode tag in the buffer's text, |
1177 compares the filename against the entries in `auto-mode-alist', | 1202 compares the filename against the entries in `auto-mode-alist', |
1178 or checks the interpreter that runs this file against | 1203 or checks the interpreter that runs this file against |
1213 (setq mode (cdr (car alist)) | 1238 (setq mode (cdr (car alist)) |
1214 keep-going nil))) | 1239 keep-going nil))) |
1215 (setq alist (cdr alist)))) | 1240 (setq alist (cdr alist)))) |
1216 ;; If we can't deduce a mode from the file name, | 1241 ;; If we can't deduce a mode from the file name, |
1217 ;; look for an interpreter specified in the first line. | 1242 ;; look for an interpreter specified in the first line. |
1218 (if (and (null mode) | 1243 (if (null mode) |
1219 (save-excursion ; XEmacs | |
1220 (goto-char (point-min)) | |
1221 (looking-at "#!"))) | |
1222 (let ((firstline | 1244 (let ((firstline |
1223 (buffer-substring | 1245 (buffer-substring |
1224 (point-min) | 1246 (point-min) |
1225 (save-excursion | 1247 (save-excursion |
1226 (goto-char (point-min)) (end-of-line) (point))))) | 1248 (goto-char (point-min)) (end-of-line) (point))))) |
1233 (setq alist (cdr alist)))))) | 1255 (setq alist (cdr alist)))))) |
1234 (if mode | 1256 (if mode |
1235 (funcall mode)) | 1257 (funcall mode)) |
1236 )))))) | 1258 )))))) |
1237 | 1259 |
1238 ;; XEmacs: this function is not synched with FSF | |
1239 ;; jwz - New Version 20.1/19.15 | |
1240 (defun hack-local-variables-prop-line (&optional force) | |
1241 ;; Set local variables specified in the -*- line. | |
1242 ;; Returns t if mode was set. | |
1243 (let ((result nil)) | |
1244 (save-excursion | |
1245 (goto-char (point-min)) | |
1246 (skip-chars-forward " \t\n\r") | |
1247 (let ((end (save-excursion | |
1248 ;; If the file begins with "#!" | |
1249 ;; (un*x exec interpreter magic), look | |
1250 ;; for mode frobs in the first two | |
1251 ;; lines. You cannot necessarily | |
1252 ;; put them in the first line of | |
1253 ;; such a file without screwing up | |
1254 ;; the interpreter invocation. | |
1255 (end-of-line (and (looking-at "^#!") 2)) | |
1256 (point)))) | |
1257 ;; Parse the -*- line into the `result' alist. | |
1258 (cond ((not (search-forward "-*-" end t)) | |
1259 ;; doesn't have one. | |
1260 (setq force t)) | |
1261 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") | |
1262 ;; Antiquated form: "-*- ModeName -*-". | |
1263 (setq result | |
1264 (list (cons 'mode | |
1265 (intern (buffer-substring | |
1266 (match-beginning 1) | |
1267 (match-end 1))))) | |
1268 )) | |
1269 (t | |
1270 ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' | |
1271 ;; (last ";" is optional). | |
1272 (save-excursion | |
1273 (if (search-forward "-*-" end t) | |
1274 (setq end (- (point) 3)) | |
1275 (error "-*- not terminated before end of line"))) | |
1276 (while (< (point) end) | |
1277 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") | |
1278 (error "malformed -*- line")) | |
1279 (goto-char (match-end 0)) | |
1280 ;; There used to be a downcase here, | |
1281 ;; but the manual didn't say so, | |
1282 ;; and people want to set var names that aren't all lc. | |
1283 (let ((key (intern (buffer-substring | |
1284 (match-beginning 1) | |
1285 (match-end 1)))) | |
1286 (val (save-restriction | |
1287 (narrow-to-region (point) end) | |
1288 (read (current-buffer))))) | |
1289 ;; Case sensitivity! Icepicks in my forehead! | |
1290 (if (equal (downcase (symbol-name key)) "mode") | |
1291 (setq key 'mode)) | |
1292 (setq result (cons (cons key val) result)) | |
1293 (skip-chars-forward " \t;"))) | |
1294 (setq result (nreverse result)))))) | |
1295 | |
1296 (let ((set-any-p (or force (hack-local-variables-p t))) | |
1297 (mode-p nil)) | |
1298 (while result | |
1299 (let ((key (car (car result))) | |
1300 (val (cdr (car result)))) | |
1301 (cond ((eq key 'mode) | |
1302 (setq mode-p t) | |
1303 (and enable-local-variables | |
1304 (funcall (intern (concat (downcase (symbol-name val)) | |
1305 "-mode"))))) | |
1306 (set-any-p | |
1307 (hack-one-local-variable key val)) | |
1308 (t | |
1309 nil))) | |
1310 (setq result (cdr result))) | |
1311 mode-p))) | |
1312 | |
1313 (defvar hack-local-variables-hook nil | |
1314 "Normal hook run after processing a file's local variables specs. | |
1315 Major modes can use this to examine user-specified local variables | |
1316 in order to initialize other data structure based on them. | |
1317 | |
1318 This hook runs even if there were no local variables or if their | |
1319 evaluation was suppressed. See also `enable-local-variables' and | |
1320 `enable-local-eval'.") | |
1321 | |
1322 ;; XEmacs this function is not synched with FSF | |
1323 (defun hack-local-variables (&optional force) | 1260 (defun hack-local-variables (&optional force) |
1324 "Parse, and bind or evaluate as appropriate, any local variables | 1261 "Parse, and bind or evaluate as appropriate, any local variables |
1325 for current buffer." | 1262 for current buffer." |
1326 ;; Don't look for -*- if this file name matches any | 1263 ;; Don't look for -*- if this file name matches any |
1327 ;; of the regexps in inhibit-first-line-modes-regexps. | 1264 ;; of the regexps in inhibit-first-line-modes-regexps. |
1453 (error "Local variables entry is terminated incorrectly")) | 1390 (error "Local variables entry is terminated incorrectly")) |
1454 ;; Set the variable. "Variables" mode and eval are funny. | 1391 ;; Set the variable. "Variables" mode and eval are funny. |
1455 (hack-one-local-variable var val)))))))) | 1392 (hack-one-local-variable var val)))))))) |
1456 | 1393 |
1457 | 1394 |
1395 (defun hack-local-variables-prop-line (&optional force) | |
1396 ;; Set local variables specified in the -*- line. | |
1397 ;; Returns t if mode was set. | |
1398 (let ((result nil)) | |
1399 (save-excursion | |
1400 (goto-char (point-min)) | |
1401 (skip-chars-forward " \t\n\r") | |
1402 (let ((end (save-excursion | |
1403 ;; If the file begins with "#!" | |
1404 ;; (un*x exec interpreter magic), look | |
1405 ;; for mode frobs in the first two | |
1406 ;; lines. You cannot necessarily | |
1407 ;; put them in the first line of | |
1408 ;; such a file without screwing up | |
1409 ;; the interpreter invocation. | |
1410 (end-of-line (and (looking-at "^#!") 2)) | |
1411 (point)))) | |
1412 ;; Parse the -*- line into the `result' alist. | |
1413 (cond ((not (search-forward "-*-" end t)) | |
1414 ;; doesn't have one. | |
1415 nil) | |
1416 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") | |
1417 ;; Antiquated form: "-*- ModeName -*-". | |
1418 (setq result | |
1419 (list (cons 'mode | |
1420 (intern (buffer-substring | |
1421 (match-beginning 1) | |
1422 (match-end 1))))) | |
1423 )) | |
1424 (t | |
1425 ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-' | |
1426 ;; (last ";" is optional). | |
1427 (save-excursion | |
1428 (if (search-forward "-*-" end t) | |
1429 (setq end (- (point) 3)) | |
1430 (error "-*- not terminated before end of line"))) | |
1431 (while (< (point) end) | |
1432 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") | |
1433 (error "malformed -*- line")) | |
1434 (goto-char (match-end 0)) | |
1435 ;; There used to be a downcase here, | |
1436 ;; but the manual didn't say so, | |
1437 ;; and people want to set var names that aren't all lc. | |
1438 (let ((key (intern (buffer-substring | |
1439 (match-beginning 1) | |
1440 (match-end 1)))) | |
1441 (val (save-restriction | |
1442 (narrow-to-region (point) end) | |
1443 (read (current-buffer))))) | |
1444 ;; Case sensitivity! Icepicks in my forehead! | |
1445 (if (equal (downcase (symbol-name key)) "mode") | |
1446 (setq key 'mode)) | |
1447 (setq result (cons (cons key val) result)) | |
1448 (skip-chars-forward " \t;"))) | |
1449 (setq result (nreverse result)))))) | |
1450 | |
1451 (let ((set-any-p (or force (hack-local-variables-p t))) | |
1452 (mode-p nil)) | |
1453 (while result | |
1454 (let ((key (car (car result))) | |
1455 (val (cdr (car result)))) | |
1456 (cond ((eq key 'mode) | |
1457 (setq mode-p t) | |
1458 (funcall (intern (concat (downcase (symbol-name val)) | |
1459 "-mode")))) | |
1460 (set-any-p | |
1461 (hack-one-local-variable key val)) | |
1462 (t | |
1463 nil))) | |
1464 (setq result (cdr result))) | |
1465 mode-p))) | |
1458 | 1466 |
1459 (defconst ignored-local-variables | 1467 (defconst ignored-local-variables |
1460 '(enable-local-eval) | 1468 (list 'enable-local-eval) |
1461 "Variables to be ignored in a file's local variable spec.") | 1469 "Variables to be ignored in a file's local variable spec.") |
1462 | 1470 |
1463 ;; Get confirmation before setting these variables as locals in a file. | 1471 ;; Get confirmation before setting these variables as locals in a file. |
1464 (put 'debugger 'risky-local-variable t) | 1472 (put 'debugger 'risky-local-variable t) |
1465 (put 'enable-local-eval 'risky-local-variable t) | 1473 (put 'enable-local-eval 'risky-local-variable t) |
1473 (put 'buffer-file-truename 'risky-local-variable t) | 1481 (put 'buffer-file-truename 'risky-local-variable t) |
1474 (put 'exec-path 'risky-local-variable t) | 1482 (put 'exec-path 'risky-local-variable t) |
1475 (put 'load-path 'risky-local-variable t) | 1483 (put 'load-path 'risky-local-variable t) |
1476 (put 'exec-directory 'risky-local-variable t) | 1484 (put 'exec-directory 'risky-local-variable t) |
1477 (put 'process-environment 'risky-local-variable t) | 1485 (put 'process-environment 'risky-local-variable t) |
1478 (put 'dabbrev-case-fold-search 'risky-local-variable t) | |
1479 (put 'dabbrev-case-replace 'risky-local-variable t) | |
1480 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. | 1486 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. |
1481 (put 'outline-level 'risky-local-variable t) | 1487 (put 'outline-level 'risky-local-variable t) |
1482 (put 'rmail-output-file-alist 'risky-local-variable t) | 1488 (put 'rmail-output-file-alist 'risky-local-variable t) |
1483 | 1489 |
1484 ;; This one is safe because the user gets to check it before it is used. | 1490 ;; This one is safe because the user gets to check it before it is used. |
1485 (put 'compile-command 'safe-local-variable t) | 1491 (put 'compile-command 'safe-local-variable t) |
1486 | 1492 |
1487 ;(defun hack-one-local-variable-quotep (exp) | 1493 ;(defun hack-one-local-variable-quotep (exp) |
1488 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) | 1494 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) |
1533 (message "Ignoring `eval:' in file's local variables"))) | 1539 (message "Ignoring `eval:' in file's local variables"))) |
1534 ;; Ordinary variable, really set it. | 1540 ;; Ordinary variable, really set it. |
1535 (t (make-local-variable var) | 1541 (t (make-local-variable var) |
1536 (set var val)))) | 1542 (set var val)))) |
1537 | 1543 |
1538 (defun set-visited-file-name (filename &optional no-query) | 1544 (defun set-visited-file-name (filename) |
1539 "Change name of file visited in current buffer to FILENAME. | 1545 "Change name of file visited in current buffer to FILENAME. |
1540 The next time the buffer is saved it will go in the newly specified file. | 1546 The next time the buffer is saved it will go in the newly specified file. |
1541 nil or empty string as argument means make buffer not be visiting any file. | 1547 nil or empty string as argument means make buffer not be visiting any file. |
1542 Remember to delete the initial contents of the minibuffer | 1548 Remember to delete the initial contents of the minibuffer |
1543 if you wish to pass an empty string as the argument. | 1549 if you wish to pass an empty string as the argument." |
1544 | |
1545 The optional second argument NO-QUERY, if non-nil, inhibits asking for | |
1546 confirmation in the case where the file FILENAME already exists." | |
1547 (interactive "FSet visited file name: ") | 1550 (interactive "FSet visited file name: ") |
1548 (if (buffer-base-buffer) | 1551 (if (buffer-base-buffer) |
1549 (error "An indirect buffer cannot visit a file")) | 1552 (error "An indirect buffer cannot visit a file")) |
1550 (let (truename) | 1553 (let (truename) |
1551 (if filename | 1554 (if filename |
1555 (expand-file-name filename)))) | 1558 (expand-file-name filename)))) |
1556 (if filename | 1559 (if filename |
1557 (progn | 1560 (progn |
1558 (setq truename (file-truename filename)) | 1561 (setq truename (file-truename filename)) |
1559 ;; #### Do we need to check if truename is non-nil? | 1562 ;; #### Do we need to check if truename is non-nil? |
1560 ;; XEmacs: FSF uses -visit- | |
1561 (if find-file-use-truenames | 1563 (if find-file-use-truenames |
1562 (setq filename truename)))) | 1564 (setq filename truename)))) |
1563 ; (let ((buffer (and filename (find-buffer-visiting filename)))) | |
1564 ; (and buffer (not (eq buffer (current-buffer))) | |
1565 ; (not no-query) | |
1566 ; (not (y-or-n-p (message "A buffer is visiting %s; proceed? " | |
1567 ; filename))) | |
1568 ; (error "Aborted"))) | |
1569 (or (equal filename buffer-file-name) | 1565 (or (equal filename buffer-file-name) |
1570 (progn | 1566 (progn |
1571 (and filename (lock-buffer filename)) | 1567 (and filename (lock-buffer filename)) |
1572 (unlock-buffer))) | 1568 (unlock-buffer))) |
1573 (setq buffer-file-name filename) | 1569 (setq buffer-file-name filename) |
1581 (or (string= new-name (buffer-name)) | 1577 (or (string= new-name (buffer-name)) |
1582 (rename-buffer new-name t)))) | 1578 (rename-buffer new-name t)))) |
1583 (setq buffer-backed-up nil) | 1579 (setq buffer-backed-up nil) |
1584 (clear-visited-file-modtime) | 1580 (clear-visited-file-modtime) |
1585 (compute-buffer-file-truename) ; insert-file-contents does this too. | 1581 (compute-buffer-file-truename) ; insert-file-contents does this too. |
1586 ;; XEmacs deletion | |
1587 ; ;; Abbreviate the file names of the buffer. | 1582 ; ;; Abbreviate the file names of the buffer. |
1588 ; (if truename | 1583 ; (if truename |
1589 ; (progn | 1584 ; (progn |
1590 ; (setq buffer-file-truename (abbreviate-file-name truename)) | 1585 ; (setq buffer-file-truename (abbreviate-file-name truename)) |
1591 ; (if find-file-visit-truename | 1586 ; (if find-file-visit-truename |
1596 nil))) | 1591 nil))) |
1597 ;; write-file-hooks is normally used for things like ftp-find-file | 1592 ;; write-file-hooks is normally used for things like ftp-find-file |
1598 ;; that visit things that are not local files as if they were files. | 1593 ;; that visit things that are not local files as if they were files. |
1599 ;; Changing to visit an ordinary local file instead should flush the hook. | 1594 ;; Changing to visit an ordinary local file instead should flush the hook. |
1600 (kill-local-variable 'write-file-hooks) | 1595 (kill-local-variable 'write-file-hooks) |
1601 (kill-local-variable 'after-save-hook) ; XEmacs | 1596 (kill-local-variable 'after-save-hook) |
1602 (kill-local-variable 'local-write-file-hooks) | 1597 (kill-local-variable 'local-write-file-hooks) |
1603 (kill-local-variable 'write-file-data-hooks) ; XEmacs | 1598 (kill-local-variable 'write-file-data-hooks) |
1604 (kill-local-variable 'revert-buffer-function) | 1599 (kill-local-variable 'revert-buffer-function) |
1605 (kill-local-variable 'backup-inhibited) | 1600 (kill-local-variable 'backup-inhibited) |
1606 ;; If buffer was read-only because of version control, | 1601 ;; If buffer was read-only because of version control, |
1607 ;; that reason is gone now, so make it writable. | 1602 ;; that reason is gone now, so make it writable. |
1608 (if (and (boundp 'vc-mode) vc-mode) | 1603 (if (and (boundp 'vc-mode) vc-mode) |
1630 (and oauto buffer-auto-save-file-name | 1625 (and oauto buffer-auto-save-file-name |
1631 (file-exists-p oauto) | 1626 (file-exists-p oauto) |
1632 (rename-file oauto buffer-auto-save-file-name t))) | 1627 (rename-file oauto buffer-auto-save-file-name t))) |
1633 (if buffer-file-name | 1628 (if buffer-file-name |
1634 (set-buffer-modified-p t)) | 1629 (set-buffer-modified-p t)) |
1635 ;; #### ?? (Not in FSF -sb) | 1630 ;; #### ?? |
1636 (run-hooks 'after-set-visited-file-name-hooks)) | 1631 (run-hooks 'after-set-visited-file-name-hooks)) |
1637 | 1632 |
1638 (defun write-file (filename &optional confirm) | 1633 (defun write-file (filename &optional confirm codesys) |
1639 "Write current buffer into file FILENAME. | 1634 "Write current buffer into file FILENAME. |
1640 Makes buffer visit that file, and marks it not modified. | 1635 Makes buffer visit that file, and marks it not modified. |
1641 If the buffer is already visiting a file, you can specify | 1636 If the buffer is already visiting a file, you can specify |
1642 a directory name as FILENAME, to write a file of the same | 1637 a directory name as FILENAME, to write a file of the same |
1643 old name in that directory. | 1638 old name in that directory. |
1644 | |
1645 If optional second arg CONFIRM is non-nil, | 1639 If optional second arg CONFIRM is non-nil, |
1646 ask for confirmation for overwriting an existing file. | 1640 ask for confirmation for overwriting an existing file. |
1647 Interactively, confirmation is required unless you supply a prefix argument." | 1641 Under XEmacs/Mule, optional third argument specifies the |
1642 coding system to use when encoding the file. Interactively, | |
1643 with a prefix argument, you will be prompted for the coding system." | |
1648 ;; (interactive "FWrite file: ") | 1644 ;; (interactive "FWrite file: ") |
1649 (interactive | 1645 (interactive |
1650 (list (if buffer-file-name | 1646 (list (if buffer-file-name |
1651 (read-file-name "Write file: " | 1647 (read-file-name "Write file: " |
1652 nil nil nil nil) | 1648 nil nil nil nil) |
1653 (read-file-name "Write file: " | 1649 (read-file-name "Write file: " |
1654 (cdr (assq 'default-directory | 1650 (cdr (assq 'default-directory |
1655 (buffer-local-variables))) | 1651 (buffer-local-variables))) |
1656 nil nil (buffer-name))) | 1652 nil nil (buffer-name))) |
1657 t)) | 1653 t |
1658 ;; XEmacs | 1654 (if (and current-prefix-arg (featurep 'mule)) |
1655 (read-coding-system "Coding system: ")))) | |
1659 (and (eq (current-buffer) mouse-grabbed-buffer) | 1656 (and (eq (current-buffer) mouse-grabbed-buffer) |
1660 (error "Can't write minibuffer window")) | 1657 (error "Can't write minibuffer window")) |
1661 (or (null filename) (string-equal filename "") | 1658 (or (null filename) (string-equal filename "") |
1662 (progn | 1659 (progn |
1663 ;; If arg is just a directory, | 1660 ;; If arg is just a directory, |
1669 (file-exists-p filename) | 1666 (file-exists-p filename) |
1670 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) | 1667 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) |
1671 (error "Canceled"))) | 1668 (error "Canceled"))) |
1672 (set-visited-file-name filename))) | 1669 (set-visited-file-name filename))) |
1673 (set-buffer-modified-p t) | 1670 (set-buffer-modified-p t) |
1674 (setq buffer-read-only nil) ; XEmacs | 1671 (setq buffer-read-only nil) |
1675 (save-buffer)) | 1672 (if codesys |
1673 (let ((file-coding-system (get-coding-system codesys))) | |
1674 (save-buffer)) | |
1675 (save-buffer))) | |
1676 | 1676 |
1677 (defun backup-buffer () | 1677 (defun backup-buffer () |
1678 "Make a backup of the disk file visited by the current buffer, if appropriate. | 1678 "Make a backup of the disk file visited by the current buffer, if appropriate. |
1679 This is normally done before saving the buffer the first time. | 1679 This is normally done before saving the buffer the first time. |
1680 If the value is non-nil, it is the result of `file-modes' on the original | 1680 If the value is non-nil, it is the result of `file-modes' on the original file; |
1681 file; this means that the caller, after saving the buffer, should change | 1681 this means that the caller, after saving the buffer, should change the modes |
1682 the modes of the new file to agree with the old modes." | 1682 of the new file to agree with the old modes." |
1683 (if buffer-file-name | 1683 (if (and make-backup-files |
1684 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer))) | 1684 (not backup-inhibited) |
1685 (if handler | 1685 (not buffer-backed-up) |
1686 (funcall handler 'backup-buffer) | 1686 (file-exists-p buffer-file-name) |
1687 (if (and make-backup-files (not backup-inhibited) | 1687 (memq (aref (elt (file-attributes buffer-file-name) 8) 0) |
1688 (not buffer-backed-up) | 1688 '(?- ?l))) |
1689 (file-exists-p buffer-file-name) | 1689 (let ((real-file-name buffer-file-name) |
1690 (memq (aref (elt (file-attributes buffer-file-name) 8) 0) | 1690 backup-info backupname targets setmodes) |
1691 '(?- ?l))) | 1691 ;; If specified name is a symbolic link, chase it to the target. |
1692 (let ((real-file-name buffer-file-name) | 1692 ;; Thus we make the backups in the directory where the real file is. |
1693 backup-info backupname targets setmodes) | 1693 (setq real-file-name (file-chase-links real-file-name)) |
1694 ;; If specified name is a symbolic link, chase it to the target. | 1694 (setq backup-info (find-backup-file-name real-file-name) |
1695 ;; Thus we make the backups in the directory where the real file is. | 1695 backupname (car backup-info) |
1696 (setq real-file-name (file-chase-links real-file-name)) | 1696 targets (cdr backup-info)) |
1697 (setq backup-info (find-backup-file-name real-file-name) | |
1698 backupname (car backup-info) | |
1699 targets (cdr backup-info)) | |
1700 ;;; (if (file-directory-p buffer-file-name) | 1697 ;;; (if (file-directory-p buffer-file-name) |
1701 ;;; (error "Cannot save buffer in directory %s" buffer-file-name)) | 1698 ;;; (error "Cannot save buffer in directory %s" buffer-file-name)) |
1702 (if backup-info | 1699 (if backup-info |
1703 (condition-case () | 1700 (condition-case () |
1704 (let ((delete-old-versions | 1701 (let ((delete-old-versions |
1705 ;; If have old versions to maybe delete, | 1702 ;; If have old versions to maybe delete, |
1706 ;; ask the user to confirm now, before doing anything. | 1703 ;; ask the user to confirm now, before doing anything. |
1707 ;; But don't actually delete til later. | 1704 ;; But don't actually delete til later. |
1708 (and targets | 1705 (and targets |
1709 (or (eq delete-old-versions t) | 1706 (or (eq delete-old-versions t) |
1710 (eq delete-old-versions nil)) | 1707 (eq delete-old-versions nil)) |
1711 (or delete-old-versions | 1708 (or delete-old-versions |
1712 (y-or-n-p (format "Delete excess backup versions of %s? " | 1709 (y-or-n-p (format "Delete excess backup versions of %s? " |
1713 real-file-name)))))) | 1710 real-file-name)))))) |
1714 ;; Actually write the back up file. | 1711 ;; Actually write the back up file. |
1712 (condition-case () | |
1713 (if (or file-precious-flag | |
1714 ; (file-symlink-p buffer-file-name) | |
1715 backup-by-copying | |
1716 (and backup-by-copying-when-linked | |
1717 (> (file-nlinks real-file-name) 1)) | |
1718 (and backup-by-copying-when-mismatch | |
1719 (let ((attr (file-attributes real-file-name))) | |
1720 (or (nth 9 attr) | |
1721 (not (file-ownership-preserved-p real-file-name)))))) | |
1715 (condition-case () | 1722 (condition-case () |
1716 (if (or file-precious-flag | 1723 (copy-file real-file-name backupname t t) |
1717 ; (file-symlink-p buffer-file-name) | |
1718 backup-by-copying | |
1719 (and backup-by-copying-when-linked | |
1720 (> (file-nlinks real-file-name) 1)) | |
1721 (and backup-by-copying-when-mismatch | |
1722 (let ((attr (file-attributes real-file-name))) | |
1723 (or (nth 9 attr) | |
1724 (not (file-ownership-preserved-p real-file-name)))))) | |
1725 (condition-case () | |
1726 (copy-file real-file-name backupname t t) | |
1727 (file-error | |
1728 ;; If copying fails because file BACKUPNAME | |
1729 ;; is not writable, delete that file and try again. | |
1730 (if (and (file-exists-p backupname) | |
1731 (not (file-writable-p backupname))) | |
1732 (delete-file backupname)) | |
1733 (copy-file real-file-name backupname t t))) | |
1734 ;; rename-file should delete old backup. | |
1735 (rename-file real-file-name backupname t) | |
1736 (setq setmodes (file-modes backupname))) | |
1737 (file-error | 1724 (file-error |
1738 ;; If trouble writing the backup, write it in ~. | 1725 ;; If copying fails because file BACKUPNAME |
1739 (setq backupname (expand-file-name | 1726 ;; is not writable, delete that file and try again. |
1740 (convert-standard-filename | 1727 (if (and (file-exists-p backupname) |
1741 "~/%backup%~"))) | 1728 (not (file-writable-p backupname))) |
1742 (message "Cannot write backup file; backing up in %s" | 1729 (delete-file backupname)) |
1743 (file-name-nondirectory backupname)) | 1730 (copy-file real-file-name backupname t t))) |
1744 (sleep-for 1) | 1731 ;; rename-file should delete old backup. |
1745 (condition-case () | 1732 (rename-file real-file-name backupname t) |
1746 (copy-file real-file-name backupname t t) | 1733 (setq setmodes (file-modes backupname))) |
1747 (file-error | 1734 (file-error |
1748 ;; If copying fails because file BACKUPNAME | 1735 ;; If trouble writing the backup, write it in ~. |
1749 ;; is not writable, delete that file and try again. | 1736 (setq backupname (expand-file-name "~/%backup%~")) |
1750 (if (and (file-exists-p backupname) | 1737 (message "Cannot write backup file; backing up in ~/%%backup%%~") |
1751 (not (file-writable-p backupname))) | 1738 (sleep-for 1) |
1752 (delete-file backupname)) | 1739 (condition-case () |
1753 (copy-file real-file-name backupname t t))))) | 1740 (copy-file real-file-name backupname t t) |
1754 (setq buffer-backed-up t) | 1741 (file-error |
1755 ;; Now delete the old versions, if desired. | 1742 ;; If copying fails because file BACKUPNAME |
1756 (if delete-old-versions | 1743 ;; is not writable, delete that file and try again. |
1757 (while targets | 1744 (if (and (file-exists-p backupname) |
1758 (condition-case () | 1745 (not (file-writable-p backupname))) |
1759 (delete-file (car targets)) | 1746 (delete-file backupname)) |
1760 (file-error nil)) | 1747 (copy-file real-file-name backupname t t))))) |
1761 (setq targets (cdr targets)))) | 1748 (setq buffer-backed-up t) |
1762 setmodes) | 1749 ;; Now delete the old versions, if desired. |
1763 (file-error nil))))))))) | 1750 (if delete-old-versions |
1751 (while targets | |
1752 (condition-case () | |
1753 (delete-file (car targets)) | |
1754 (file-error nil)) | |
1755 (setq targets (cdr targets)))) | |
1756 setmodes) | |
1757 (file-error nil)))))) | |
1764 | 1758 |
1765 (defun file-name-sans-versions (name &optional keep-backup-version) | 1759 (defun file-name-sans-versions (name &optional keep-backup-version) |
1766 "Return FILENAME sans backup versions or strings. | 1760 "Return FILENAME sans backup versions or strings. |
1767 This is a separate procedure so your site-init or startup file can | 1761 This is a separate procedure so your site-init or startup file can |
1768 redefine it. | 1762 redefine it. |
1784 (match-beginning 1)) | 1778 (match-beginning 1)) |
1785 (length name)) | 1779 (length name)) |
1786 (if keep-backup-version | 1780 (if keep-backup-version |
1787 (length name) | 1781 (length name) |
1788 (or (string-match "\\.~[0-9.]+~\\'" name) | 1782 (or (string-match "\\.~[0-9.]+~\\'" name) |
1789 ;; XEmacs - VC uses extensions like ".~tagname~" | 1783 ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~" |
1790 ;; or ".~1.1.5.2~" | |
1791 (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name))) | 1784 (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name))) |
1792 (and pos | 1785 (and pos |
1793 ;; #### - is this filesystem check too paranoid? | 1786 ;; #### - is this filesystem check too paranoid? |
1794 (file-exists-p (substring name 0 pos)) | 1787 (file-exists-p (substring name 0 pos)) |
1795 pos)) | 1788 pos)) |
1821 filename)))) | 1814 filename)))) |
1822 | 1815 |
1823 (defun make-backup-file-name (file) | 1816 (defun make-backup-file-name (file) |
1824 "Create the non-numeric backup file name for FILE. | 1817 "Create the non-numeric backup file name for FILE. |
1825 This is a separate function so you can redefine it for customization." | 1818 This is a separate function so you can redefine it for customization." |
1826 (if (and (eq system-type 'ms-dos) | 1819 (if (eq system-type 'ms-dos) |
1827 (not (msdos-long-file-names))) | |
1828 (let ((fn (file-name-nondirectory file))) | 1820 (let ((fn (file-name-nondirectory file))) |
1829 (concat (file-name-directory file) | 1821 (concat (file-name-directory file) |
1830 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) | 1822 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) |
1831 (substring fn 0 (match-end 1))) | 1823 (substring fn 0 (match-end 1))) |
1832 ; (or | |
1833 ; (and (string-match "\\`[^.]+\\'" fn) | |
1834 ; (concat (match-string 0 fn) ".~")) | |
1835 ; (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) | |
1836 ; (concat (match-string 0 fn) "~"))))) | |
1837 ".bak")) | 1824 ".bak")) |
1838 (concat file "~"))) | 1825 (concat file "~"))) |
1839 | 1826 |
1840 (defun backup-file-name-p (file) | 1827 (defun backup-file-name-p (file) |
1841 "Return non-nil if FILE is a backup file name (numeric or not). | 1828 "Return non-nil if FILE is a backup file name (numeric or not). |
1917 directory (file-name-as-directory (expand-file-name | 1904 directory (file-name-as-directory (expand-file-name |
1918 (or directory default-directory)))) | 1905 (or directory default-directory)))) |
1919 (let ((ancestor "")) | 1906 (let ((ancestor "")) |
1920 (while (not (string-match (concat "^" (regexp-quote directory)) filename)) | 1907 (while (not (string-match (concat "^" (regexp-quote directory)) filename)) |
1921 (setq directory (file-name-directory (substring directory 0 -1)) | 1908 (setq directory (file-name-directory (substring directory 0 -1)) |
1922 ancestor (concat "../" ancestor))) | 1909 ancestor (concat "../" ancestor))) |
1923 (concat ancestor (substring filename (match-end 0))))) | 1910 (concat ancestor (substring filename (match-end 0))))) |
1924 | 1911 |
1925 (defun save-buffer (&optional args) | 1912 (defun save-buffer (&optional args) |
1926 "Save current buffer in visited file if modified. Versions described below. | 1913 "Save current buffer in visited file if modified. Versions described below. |
1927 | 1914 |
1928 By default, makes the previous version into a backup file | 1915 By default, makes the previous version into a backup file |
1929 if previously requested or if this is the first save. | 1916 if previously requested or if this is the first save. |
1930 With 1 \\[universal-argument], marks this version | 1917 With 1 or 3 \\[universal-argument]'s, marks this version |
1931 to become a backup when the next save is done. | 1918 to become a backup when the next save is done. |
1932 With 2 \\[universal-argument]'s, | 1919 With 2 or 3 \\[universal-argument]'s, |
1933 unconditionally makes the previous version into a backup file. | 1920 unconditionally makes the previous version into a backup file. |
1934 With 3 \\[universal-argument]'s, marks this version | |
1935 to become a backup when the next save is done, | |
1936 and unconditionally makes the previous version into a backup file. | |
1937 | |
1938 With argument of 0, never makes the previous version into a backup file. | 1921 With argument of 0, never makes the previous version into a backup file. |
1939 | 1922 |
1940 If a file's name is FOO, the names of its numbered backup versions are | 1923 If a file's name is FOO, the names of its numbered backup versions are |
1941 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. | 1924 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. |
1942 Numeric backups (rather than FOO~) will be made if value of | 1925 Numeric backups (rather than FOO~) will be made if value of |
1948 and `kept-new-versions', which tells how many newest versions to keep. | 1931 and `kept-new-versions', which tells how many newest versions to keep. |
1949 Defaults are 2 old versions and 2 new. | 1932 Defaults are 2 old versions and 2 new. |
1950 `dired-kept-versions' controls dired's clean-directory (.) command. | 1933 `dired-kept-versions' controls dired's clean-directory (.) command. |
1951 If `delete-old-versions' is nil, system will query user | 1934 If `delete-old-versions' is nil, system will query user |
1952 before trimming versions. Otherwise it does it silently." | 1935 before trimming versions. Otherwise it does it silently." |
1953 (interactive "_p") | 1936 (interactive "p") |
1954 (let ((modp (buffer-modified-p)) | 1937 (let ((modp (buffer-modified-p)) |
1955 (large (> (buffer-size) 50000)) | 1938 (large (> (buffer-size) 50000)) |
1956 (make-backup-files (or (and make-backup-files (not (eq args 0))) | 1939 (make-backup-files (or (and make-backup-files (not (eq args 0))) |
1957 (memq args '(16 64))))) | 1940 (memq args '(16 64))))) |
1958 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) | 1941 (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) |
1959 (if (and modp large) (message "Saving file %s..." (buffer-file-name))) | 1942 (if (and modp large) (message "Saving file %s..." |
1943 (buffer-file-name))) | |
1960 (basic-save-buffer) | 1944 (basic-save-buffer) |
1961 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) | 1945 (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) |
1962 | 1946 |
1963 (defun delete-auto-save-file-if-necessary (&optional force) | 1947 (defun delete-auto-save-file-if-necessary (&optional force) |
1964 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. | 1948 "Delete auto-save file for current buffer if `delete-auto-save-files' is t. |
2009 (save-excursion | 1993 (save-excursion |
2010 ;; In an indirect buffer, save its base buffer instead. | 1994 ;; In an indirect buffer, save its base buffer instead. |
2011 (if (buffer-base-buffer) | 1995 (if (buffer-base-buffer) |
2012 (set-buffer (buffer-base-buffer))) | 1996 (set-buffer (buffer-base-buffer))) |
2013 (if (buffer-modified-p) | 1997 (if (buffer-modified-p) |
2014 (let ((recent-save (recent-auto-save-p)) | 1998 (let ((recent-save (recent-auto-save-p))) |
2015 setmodes tempsetmodes) | |
2016 ;; On VMS, rename file and buffer to get rid of version number. | 1999 ;; On VMS, rename file and buffer to get rid of version number. |
2017 (if (and (eq system-type 'vax-vms) | 2000 (if (and (eq system-type 'vax-vms) |
2018 (not (string= buffer-file-name | 2001 (not (string= buffer-file-name |
2019 (file-name-sans-versions buffer-file-name)))) | 2002 (file-name-sans-versions buffer-file-name)))) |
2020 (let (buffer-new-name) | 2003 (let (buffer-new-name) |
2096 ;; This does the "real job" of writing a buffer into its visited file | 2079 ;; This does the "real job" of writing a buffer into its visited file |
2097 ;; and making a backup file. This is what is normally done | 2080 ;; and making a backup file. This is what is normally done |
2098 ;; but inhibited if one of write-file-hooks returns non-nil. | 2081 ;; but inhibited if one of write-file-hooks returns non-nil. |
2099 ;; It returns a value to store in setmodes. | 2082 ;; It returns a value to store in setmodes. |
2100 (defun basic-save-buffer-1 () | 2083 (defun basic-save-buffer-1 () |
2101 (let (tempsetmodes setmodes) | 2084 (let (setmodes tempsetmodes) |
2102 (if (not (file-writable-p buffer-file-name)) | 2085 (if (not (file-writable-p buffer-file-name)) |
2103 (let ((dir (file-name-directory buffer-file-name))) | 2086 (let ((dir (file-name-directory buffer-file-name))) |
2104 (if (not (file-directory-p dir)) | 2087 (if (not (file-directory-p dir)) |
2105 (error "%s is not a directory" dir) | 2088 (error "%s is not a directory" dir) |
2106 (if (not (file-exists-p buffer-file-name)) | 2089 (if (not (file-exists-p buffer-file-name)) |
2112 (setq tempsetmodes t) | 2095 (setq tempsetmodes t) |
2113 (error | 2096 (error |
2114 "Attempt to save to a file which you aren't allowed to write")))))) | 2097 "Attempt to save to a file which you aren't allowed to write")))))) |
2115 (or buffer-backed-up | 2098 (or buffer-backed-up |
2116 (setq setmodes (backup-buffer))) | 2099 (setq setmodes (backup-buffer))) |
2117 (let ((dir (file-name-directory buffer-file-name))) | 2100 (let ((dir (file-name-directory buffer-file-name))) |
2118 (if (and file-precious-flag | 2101 (if (and file-precious-flag |
2119 (file-writable-p dir)) | 2102 (file-writable-p dir)) |
2120 ;; If file is precious, write temp name, then rename it. | 2103 ;; If file is precious, write temp name, then rename it. |
2121 ;; This requires write access to the containing dir, | 2104 ;; This requires write access to the containing dir, |
2122 ;; which is why we don't try it if we don't have that access. | 2105 ;; which is why we don't try it if we don't have that access. |
2123 (let ((realname buffer-file-name) | 2106 (let ((realname buffer-file-name) |
2124 tempname temp nogood i succeed | 2107 tempname nogood i succeed |
2125 (old-modtime (visited-file-modtime))) | 2108 (old-modtime (visited-file-modtime))) |
2126 (setq i 0) | 2109 (setq i 0) |
2127 (setq nogood t) | 2110 (setq nogood t) |
2128 ;; Find the temporary name to write under. | 2111 ;; Find the temporary name to write under. |
2129 (while nogood | 2112 (while nogood |
2130 (setq tempname (format | 2113 (setq tempname (format "%s#tmp#%d" dir i)) |
2131 (if (and (eq system-type 'ms-dos) | |
2132 (not (msdos-long-file-names))) | |
2133 "%s#%d.tm#" ; MSDOS limits files to 8+3 | |
2134 "%s#tmp#%d") | |
2135 dir i)) | |
2136 (setq nogood (file-exists-p tempname)) | 2114 (setq nogood (file-exists-p tempname)) |
2137 (setq i (1+ i))) | 2115 (setq i (1+ i))) |
2138 (unwind-protect | 2116 (unwind-protect |
2139 (progn (clear-visited-file-modtime) | 2117 (progn (clear-visited-file-modtime) |
2140 (write-region (point-min) (point-max) | 2118 (write-region (point-min) (point-max) |
2141 tempname nil realname | 2119 tempname nil realname |
2142 buffer-file-truename) | 2120 buffer-file-truename) |
2143 (setq succeed t)) | 2121 (setq succeed t)) |
2144 ;; If writing the temp file fails, | 2122 ;; If writing the temp file fails, |
2145 ;; delete the temp file. | 2123 ;; delete the temp file. |
2146 (or succeed | 2124 (or succeed |
2147 (progn | 2125 (progn |
2148 (delete-file tempname) | 2126 (delete-file tempname) |
2149 (set-visited-file-modtime old-modtime)))) | 2127 (set-visited-file-modtime old-modtime)))) |
2150 ;; Since we have created an entirely new file | 2128 ;; Since we have created an entirely new file |
2151 ;; and renamed it, make sure it gets the | 2129 ;; and renamed it, make sure it gets the |
2160 ;; (setmodes is set) because that says we're superseding. | 2138 ;; (setmodes is set) because that says we're superseding. |
2161 (cond ((and tempsetmodes (not setmodes)) | 2139 (cond ((and tempsetmodes (not setmodes)) |
2162 ;; Change the mode back, after writing. | 2140 ;; Change the mode back, after writing. |
2163 (setq setmodes (file-modes buffer-file-name)) | 2141 (setq setmodes (file-modes buffer-file-name)) |
2164 (set-file-modes buffer-file-name 511))) | 2142 (set-file-modes buffer-file-name 511))) |
2165 ;; XEmacs change to end of function | |
2166 (basic-write-file-data buffer-file-name buffer-file-truename))) | 2143 (basic-write-file-data buffer-file-name buffer-file-truename))) |
2167 (setq buffer-file-number | 2144 (setq buffer-file-number |
2168 (if buffer-file-name | 2145 (if buffer-file-name |
2169 (nth 10 (file-attributes buffer-file-name)) | 2146 (nth 10 (file-attributes buffer-file-name)) |
2170 nil)) | 2147 nil)) |
2204 Optional argument (the prefix) non-nil means save all with no questions. | 2181 Optional argument (the prefix) non-nil means save all with no questions. |
2205 Optional second argument EXITING means ask about certain non-file buffers | 2182 Optional second argument EXITING means ask about certain non-file buffers |
2206 as well as about file buffers." | 2183 as well as about file buffers." |
2207 (interactive "P") | 2184 (interactive "P") |
2208 (save-window-excursion | 2185 (save-window-excursion |
2209 ;; XEmacs - do not use queried flag | |
2210 (let ((files-done | 2186 (let ((files-done |
2211 (map-y-or-n-p | 2187 (map-y-or-n-p |
2212 (function | 2188 (function |
2213 (lambda (buffer) | 2189 (lambda (buffer) |
2214 (and (buffer-modified-p buffer) | 2190 (and (buffer-modified-p buffer) |
2287 (not buffer-read-only) | 2263 (not buffer-read-only) |
2288 (> (prefix-numeric-value arg) 0))) | 2264 (> (prefix-numeric-value arg) 0))) |
2289 ;; Force modeline redisplay | 2265 ;; Force modeline redisplay |
2290 (redraw-modeline)) | 2266 (redraw-modeline)) |
2291 | 2267 |
2292 (defun insert-file (filename) | 2268 (defun insert-file (filename &optional codesys) |
2293 "Insert contents of file FILENAME into buffer after point. | 2269 "Insert contents of file FILENAME into buffer after point. |
2294 Set mark after the inserted text. | 2270 Set mark after the inserted text. |
2271 | |
2272 Under XEmacs/Mule, optional second argument specifies the | |
2273 coding system to use when decoding the file. Interactively, | |
2274 with a prefix argument, you will be prompted for the coding system. | |
2295 | 2275 |
2296 This function is meant for the user to run interactively. | 2276 This function is meant for the user to run interactively. |
2297 Don't call it from programs! Use `insert-file-contents' instead. | 2277 Don't call it from programs! Use `insert-file-contents' instead. |
2298 \(Its calling sequence is different; see its documentation)." | 2278 \(Its calling sequence is different; see its documentation)." |
2299 (interactive "*fInsert file: ") | 2279 (interactive "*fInsert file: \nZCoding system: ") |
2300 (if (file-directory-p filename) | 2280 (if (file-directory-p filename) |
2301 (signal 'file-error (list "Opening input file" "file is a directory" | 2281 (signal 'file-error (list "Opening input file" "file is a directory" |
2302 filename))) | 2282 filename))) |
2303 (let ((tem (insert-file-contents filename))) | 2283 (let ((tem |
2284 (if codesys | |
2285 (let ((overriding-file-coding-system | |
2286 (get-coding-system codesys))) | |
2287 (insert-file-contents filename)) | |
2288 (insert-file-contents filename)))) | |
2304 (push-mark (+ (point) (car (cdr tem)))))) | 2289 (push-mark (+ (point) (car (cdr tem)))))) |
2305 | 2290 |
2306 (defun append-to-file (start end filename) | 2291 (defun append-to-file (start end filename &optional codesys) |
2307 "Append the contents of the region to the end of file FILENAME. | 2292 "Append the contents of the region to the end of file FILENAME. |
2308 When called from a function, expects three arguments, | 2293 When called from a function, expects three arguments, |
2309 START, END and FILENAME. START and END are buffer positions | 2294 START, END and FILENAME. START and END are buffer positions |
2310 saying what text to write." | 2295 saying what text to write. |
2311 (interactive "r\nFAppend to file: ") | 2296 Under XEmacs/Mule, optional fourth argument specifies the |
2312 (write-region start end filename t)) | 2297 coding system to use when encoding the file. Interactively, |
2298 with a prefix argument, you will be prompted for the coding system." | |
2299 (interactive "r\nFAppend to file: \nZCoding system: ") | |
2300 (if codesys | |
2301 (let ((file-coding-system (get-coding-system codesys))) | |
2302 (write-region start end filename t)) | |
2303 (write-region start end filename t))) | |
2313 | 2304 |
2314 (defun file-newest-backup (filename) | 2305 (defun file-newest-backup (filename) |
2315 "Return most recent backup file for FILENAME or nil if no backups exist." | 2306 "Return most recent backup file for FILENAME or nil if no backups exist." |
2316 (let* ((filename (expand-file-name filename)) | 2307 (let* ((filename (expand-file-name filename)) |
2317 (file (file-name-nondirectory filename)) | 2308 (file (file-name-nondirectory filename)) |
2318 (dir (file-name-directory filename)) | 2309 (dir (file-name-directory filename)) |
2319 (comp (file-name-all-completions file dir)) | 2310 (comp (file-name-all-completions file dir)) |
2320 newest tem) | 2311 newest) |
2321 (while comp | 2312 (while comp |
2322 (setq tem (car comp) | 2313 (setq file (concat dir (car comp)) |
2323 comp (cdr comp)) | 2314 comp (cdr comp)) |
2324 (cond ((and (backup-file-name-p tem) | 2315 (if (and (backup-file-name-p file) |
2325 (string= (file-name-sans-versions tem) file)) | 2316 (or (null newest) (file-newer-than-file-p file newest))) |
2326 (setq tem (concat dir tem)) | 2317 (setq newest file))) |
2327 (if (or (null newest) | |
2328 (file-newer-than-file-p tem newest)) | |
2329 (setq newest tem))))) | |
2330 newest)) | 2318 newest)) |
2331 | 2319 |
2332 (defun rename-uniquely () | 2320 (defun rename-uniquely () |
2333 "Rename current buffer to a similar name not already taken. | 2321 "Rename current buffer to a similar name not already taken. |
2334 This function is useful for creating multiple shell process buffers | 2322 This function is useful for creating multiple shell process buffers |
2349 (name (buffer-name new-buf))) | 2337 (name (buffer-name new-buf))) |
2350 (kill-buffer new-buf) | 2338 (kill-buffer new-buf) |
2351 (rename-buffer name) | 2339 (rename-buffer name) |
2352 (redraw-modeline)))) | 2340 (redraw-modeline)))) |
2353 | 2341 |
2354 ;; XEmacs | |
2355 (defun make-directory-path (path) | 2342 (defun make-directory-path (path) |
2356 "Create all the directories along path that don't exist yet." | 2343 "Create all the directories along path that don't exist yet." |
2357 (interactive "Fdirectory path to create: ") | 2344 (interactive "Fdirectory path to create: ") |
2358 (make-directory path t)) | 2345 (make-directory path t)) |
2359 | 2346 |
2363 is the current default directory for file names. | 2350 is the current default directory for file names. |
2364 That is useful when you have visited a file in a nonexistent directory. | 2351 That is useful when you have visited a file in a nonexistent directory. |
2365 | 2352 |
2366 Noninteractively, the second (optional) argument PARENTS says whether | 2353 Noninteractively, the second (optional) argument PARENTS says whether |
2367 to create parent directories if they don't exist." | 2354 to create parent directories if they don't exist." |
2368 ;; XEmacs | |
2369 (interactive (list (let ((current-prefix-arg current-prefix-arg)) | 2355 (interactive (list (let ((current-prefix-arg current-prefix-arg)) |
2370 (read-directory-name "Create directory: ")) | 2356 (read-directory-name "Create directory: ")) |
2371 current-prefix-arg)) | 2357 current-prefix-arg)) |
2372 (let ((handler (find-file-name-handler dir 'make-directory))) | 2358 (let ((handler (find-file-name-handler dir 'make-directory))) |
2373 (if handler | 2359 (if handler |
2407 hook functions. | 2393 hook functions. |
2408 | 2394 |
2409 If `revert-buffer-function' is used to override the normal revert | 2395 If `revert-buffer-function' is used to override the normal revert |
2410 mechanism, this hook is not used.") | 2396 mechanism, this hook is not used.") |
2411 | 2397 |
2412 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) | 2398 (defun revert-buffer (&optional ignore-auto noconfirm) |
2413 "Replace the buffer text with the text of the visited file on disk. | 2399 "Replace the buffer text with the text of the visited file on disk. |
2414 This undoes all changes since the file was visited or saved. | 2400 This undoes all changes since the file was visited or saved. |
2415 With a prefix argument, offer to revert from latest auto-save file, if | 2401 With a prefix argument, offer to revert from latest auto-save file, if |
2416 that is more recent than the visited file. | 2402 that is more recent than the visited file. |
2417 When called from Lisp, the first argument is IGNORE-AUTO; only offer | 2403 When called from Lisp, the first argument is IGNORE-AUTO; only offer |
2437 (interactive (list (not current-prefix-arg))) | 2423 (interactive (list (not current-prefix-arg))) |
2438 (if revert-buffer-function | 2424 (if revert-buffer-function |
2439 (funcall revert-buffer-function ignore-auto noconfirm) | 2425 (funcall revert-buffer-function ignore-auto noconfirm) |
2440 (let* ((opoint (point)) | 2426 (let* ((opoint (point)) |
2441 (auto-save-p (and (not ignore-auto) | 2427 (auto-save-p (and (not ignore-auto) |
2442 (recent-auto-save-p) | 2428 (recent-auto-save-p) |
2443 buffer-auto-save-file-name | 2429 buffer-auto-save-file-name |
2444 (file-readable-p buffer-auto-save-file-name) | 2430 (file-readable-p buffer-auto-save-file-name) |
2445 (y-or-n-p | 2431 (y-or-n-p |
2446 "Buffer has been auto-saved recently. Revert from auto-save file? "))) | 2432 "Buffer has been auto-saved recently. Revert from auto-save file? "))) |
2447 (file-name (if auto-save-p | 2433 (file-name (if auto-save-p |
2462 (or (eq buffer-undo-list t) | 2448 (or (eq buffer-undo-list t) |
2463 (setq buffer-undo-list nil)) | 2449 (setq buffer-undo-list nil)) |
2464 ;; Effectively copy the after-revert-hook status, | 2450 ;; Effectively copy the after-revert-hook status, |
2465 ;; since after-find-file will clobber it. | 2451 ;; since after-find-file will clobber it. |
2466 (let ((global-hook (default-value 'after-revert-hook)) | 2452 (let ((global-hook (default-value 'after-revert-hook)) |
2467 ;; XEmacs | |
2468 (local-hook-p (local-variable-p 'after-revert-hook | 2453 (local-hook-p (local-variable-p 'after-revert-hook |
2469 (current-buffer))) | 2454 (current-buffer))) |
2470 (local-hook (and (local-variable-p 'after-revert-hook | 2455 (local-hook (and (local-variable-p 'after-revert-hook |
2471 (current-buffer)) | 2456 (current-buffer)) |
2472 after-revert-hook))) | 2457 after-revert-hook))) |
2489 (goto-char (min opoint (point-max))) | 2474 (goto-char (min opoint (point-max))) |
2490 ;; Recompute the truename in case changes in symlinks | 2475 ;; Recompute the truename in case changes in symlinks |
2491 ;; have changed the truename. | 2476 ;; have changed the truename. |
2492 ;XEmacs: already done by insert-file-contents | 2477 ;XEmacs: already done by insert-file-contents |
2493 ;(compute-buffer-file-truename) | 2478 ;(compute-buffer-file-truename) |
2494 (after-find-file nil nil t t preserve-modes) | 2479 (after-find-file nil nil t t) |
2495 ;; Run after-revert-hook as it was before we reverted. | 2480 ;; Run after-revert-hook as it was before we reverted. |
2496 (setq-default revert-buffer-internal-hook global-hook) | 2481 (setq-default revert-buffer-internal-hook global-hook) |
2497 (if local-hook-p | 2482 (if local-hook-p |
2498 (progn | 2483 (progn |
2499 (make-local-variable 'revert-buffer-internal-hook) | 2484 (make-local-variable 'revert-buffer-internal-hook) |
2507 ;; Actually putting the file name in the minibuffer should be used | 2492 ;; Actually putting the file name in the minibuffer should be used |
2508 ;; only rarely. | 2493 ;; only rarely. |
2509 ;; Not just because users often use the default. | 2494 ;; Not just because users often use the default. |
2510 (interactive "FRecover file: ") | 2495 (interactive "FRecover file: ") |
2511 (setq file (expand-file-name file)) | 2496 (setq file (expand-file-name file)) |
2512 (let ((handler (or (find-file-name-handler file 'recover-file) | 2497 (if (auto-save-file-name-p file) |
2513 (find-file-name-handler | 2498 (error "%s is an auto-save file" file)) |
2514 (let ((buffer-file-name file)) | 2499 (let ((file-name (let ((buffer-file-name file)) |
2515 (make-auto-save-file-name)) | 2500 (make-auto-save-file-name)))) |
2516 'recover-file)))) | 2501 (cond ((if (file-exists-p file) |
2517 (if handler | 2502 (not (file-newer-than-file-p file-name file)) |
2518 (funcall handler 'recover-file file) | 2503 (not (file-exists-p file-name))) |
2519 (if (auto-save-file-name-p (file-name-nondirectory file)) | 2504 (error "Auto-save file %s not current" file-name)) |
2520 (error "%s is an auto-save file" file)) | 2505 ((save-window-excursion |
2521 (let ((file-name (let ((buffer-file-name file)) | 2506 (if (not (eq system-type 'vax-vms)) |
2522 (make-auto-save-file-name)))) | 2507 (with-output-to-temp-buffer "*Directory*" |
2523 (cond ((if (file-exists-p file) | 2508 (buffer-disable-undo standard-output) |
2524 (not (file-newer-than-file-p file-name file)) | 2509 (call-process "ls" nil standard-output nil |
2525 (not (file-exists-p file-name))) | 2510 (if (file-symlink-p file) "-lL" "-l") |
2526 (error "Auto-save file %s not current" file-name)) | 2511 file file-name))) |
2527 ((save-window-excursion | 2512 (yes-or-no-p (format "Recover auto save file %s? " file-name))) |
2528 (if (not (eq system-type 'vax-vms)) | 2513 (switch-to-buffer (find-file-noselect file t)) |
2529 (with-output-to-temp-buffer "*Directory*" | 2514 (let ((buffer-read-only nil)) |
2530 (buffer-disable-undo standard-output) | 2515 (erase-buffer) |
2531 (call-process "ls" nil standard-output nil | 2516 (insert-file-contents file-name nil)) |
2532 (if (file-symlink-p file) "-lL" "-l") | 2517 (after-find-file nil nil t)) |
2533 file file-name))) | 2518 (t (error "Recover-file cancelled."))))) |
2534 (yes-or-no-p (format "Recover auto save file %s? " file-name))) | |
2535 (switch-to-buffer (find-file-noselect file t)) | |
2536 (let ((buffer-read-only nil)) | |
2537 (erase-buffer) | |
2538 (insert-file-contents file-name nil)) | |
2539 (after-find-file nil nil t)) | |
2540 (t (error "Recover-file cancelled."))))))) | |
2541 | 2519 |
2542 (defun recover-session () | 2520 (defun recover-session () |
2543 "Recover auto save files from a previous Emacs session. | 2521 "Recover auto save files from a previous Emacs session. |
2544 This command first displays a Dired buffer showing you the | 2522 This command first displays a Dired buffer showing you the |
2545 previous sessions that you could recover from. | 2523 previous sessions that you could recover from. |
2546 To choose one, move point to the proper line and then type C-c C-c. | 2524 To choose one, move point to the proper line and then type C-c C-c. |
2547 Then you'll be asked about a number of files to recover." | 2525 Then you'll be asked about a number of files to recover." |
2548 (interactive) | 2526 (interactive) |
2549 (let ((ls-lisp-support-shell-wildcards t)) | 2527 (dired (concat auto-save-list-file-prefix "*")) |
2550 (dired (concat auto-save-list-file-prefix "*"))) | |
2551 (goto-char (point-min)) | 2528 (goto-char (point-min)) |
2552 (or (looking-at "Move to the session you want to recover,") | 2529 (or (looking-at "Move to the session you want to recover,") |
2553 (let ((inhibit-read-only t)) | 2530 (let ((inhibit-read-only t)) |
2554 (insert "Move to the session you want to recover,\n" | 2531 (insert "Move to the session you want to recover,\n" |
2555 "then type C-c C-c to select it.\n\n" | 2532 "then type C-c C-c to select it.\n\n" |
2556 "You can also delete some of these files;\n" | 2533 "You can also delete some of these files;\n" |
2557 "type d on a line to mark that file for deletion.\n\n"))) | 2534 "type d on a line to mark that file for deletion.\n\n"))) |
2558 ;; XEmacs | |
2559 (use-local-map (let ((map (make-sparse-keymap))) | 2535 (use-local-map (let ((map (make-sparse-keymap))) |
2560 (set-keymap-parents map (list (current-local-map))) | 2536 (set-keymap-parents map (list (current-local-map))) |
2561 map)) | 2537 map)) |
2562 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) | 2538 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) |
2563 | 2539 |
2569 ;; Get the name of the session file to recover from. | 2545 ;; Get the name of the session file to recover from. |
2570 (let ((file (dired-get-filename)) | 2546 (let ((file (dired-get-filename)) |
2571 files | 2547 files |
2572 (buffer (get-buffer-create " *recover*"))) | 2548 (buffer (get-buffer-create " *recover*"))) |
2573 ;; #### dired-do-flagged-delete in FSF. | 2549 ;; #### dired-do-flagged-delete in FSF. |
2574 ;; This version is for ange-ftp | 2550 (dired-do-deletions t) |
2575 ;;(dired-do-deletions t) | |
2576 ;T This version is for efs | |
2577 (dired-expunge-deletions) | |
2578 (unwind-protect | 2551 (unwind-protect |
2579 (save-excursion | 2552 (save-excursion |
2580 ;; Read in the auto-save-list file. | 2553 ;; Read in the auto-save-list file. |
2581 (set-buffer buffer) | 2554 (set-buffer buffer) |
2582 (erase-buffer) | 2555 (erase-buffer) |
2626 (if files | 2599 (if files |
2627 (map-y-or-n-p "Recover %s? " | 2600 (map-y-or-n-p "Recover %s? " |
2628 (lambda (file) | 2601 (lambda (file) |
2629 (condition-case nil | 2602 (condition-case nil |
2630 (save-excursion (recover-file file)) | 2603 (save-excursion (recover-file file)) |
2631 (error | 2604 (error |
2632 "Failed to recover `%s'" file))) | 2605 "Failed to recover `%s'" file))) |
2633 files | 2606 files |
2634 '("file" "files" "recover")) | 2607 '("file" "files" "recover")) |
2635 (message "No files can be recovered from this session now"))) | 2608 (message "No files can be recovered from this session now"))) |
2636 (kill-buffer buffer)))) | 2609 (kill-buffer buffer)))) |
2643 (let* ((buffer (car list)) | 2616 (let* ((buffer (car list)) |
2644 (name (buffer-name buffer))) | 2617 (name (buffer-name buffer))) |
2645 (and (not (string-equal name "")) | 2618 (and (not (string-equal name "")) |
2646 (/= (aref name 0) ? ) | 2619 (/= (aref name 0) ? ) |
2647 (yes-or-no-p | 2620 (yes-or-no-p |
2648 ;; XEmacs change | |
2649 (format | 2621 (format |
2650 (if (buffer-modified-p buffer) | 2622 (if (buffer-modified-p buffer) |
2651 (gettext "Buffer %s HAS BEEN EDITED. Kill? ") | 2623 (gettext "Buffer %s HAS BEEN EDITED. Kill? ") |
2652 (gettext "Buffer %s is unmodified. Kill? ")) | 2624 (gettext "Buffer %s is unmodified. Kill? ")) |
2653 name)) | 2625 name)) |
2691 (file-exists-p osave) | 2663 (file-exists-p osave) |
2692 (recent-auto-save-p)) | 2664 (recent-auto-save-p)) |
2693 (rename-file osave buffer-auto-save-file-name t)))) | 2665 (rename-file osave buffer-auto-save-file-name t)))) |
2694 | 2666 |
2695 ;; see also ../packages/auto-save.el | 2667 ;; see also ../packages/auto-save.el |
2696 ;; XEmacs change | |
2697 (defun make-auto-save-file-name (&optional filename) | 2668 (defun make-auto-save-file-name (&optional filename) |
2698 "Return file name to use for auto-saves of current buffer. | 2669 "Return file name to use for auto-saves of current buffer. |
2699 Does not consider `auto-save-visited-file-name' as that variable is checked | 2670 Does not consider `auto-save-visited-file-name' as that variable is checked |
2700 before calling this function. You can redefine this for customization. | 2671 before calling this function. You can redefine this for customization. |
2701 See also `auto-save-file-name-p'." | 2672 See also `auto-save-file-name-p'." |
2754 name | 2725 name |
2755 (expand-file-name (concat "~/" (file-name-nondirectory name)))))) | 2726 (expand-file-name (concat "~/" (file-name-nondirectory name)))))) |
2756 | 2727 |
2757 (defun auto-save-file-name-p (filename) | 2728 (defun auto-save-file-name-p (filename) |
2758 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. | 2729 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. |
2759 FILENAME should lack slashes. You can redefine this for customization." | 2730 FILENAME should lack slashes. |
2731 You can redefine this for customization." | |
2760 (string-match "\\`#.*#\\'" filename)) | 2732 (string-match "\\`#.*#\\'" filename)) |
2761 | |
2762 (defun wildcard-to-regexp (wildcard) | |
2763 "Given a shell file name pattern WILDCARD, return an equivalent regexp. | |
2764 The generated regexp will match a filename iff the filename | |
2765 matches that wildcard according to shell rules. Only wildcards known | |
2766 by `sh' are supported." | |
2767 (let* ((i (string-match "[[.*+\\^$?]" wildcard)) | |
2768 ;; Copy the initial run of non-special characters. | |
2769 (result (substring wildcard 0 i)) | |
2770 (len (length wildcard))) | |
2771 ;; If no special characters, we're almost done. | |
2772 (if i | |
2773 (while (< i len) | |
2774 (let ((ch (aref wildcard i)) | |
2775 j) | |
2776 (setq | |
2777 result | |
2778 (concat result | |
2779 (cond | |
2780 ((eq ch ?\[) ; [...] maps to regexp char class | |
2781 (progn | |
2782 (setq i (1+ i)) | |
2783 (concat | |
2784 (cond | |
2785 ((eq (aref wildcard i) ?!) ; [!...] -> [^...] | |
2786 (progn | |
2787 (setq i (1+ i)) | |
2788 (if (eq (aref wildcard i) ?\]) | |
2789 (progn | |
2790 (setq i (1+ i)) | |
2791 "[^]") | |
2792 "[^"))) | |
2793 ((eq (aref wildcard i) ?^) | |
2794 ;; Found "[^". Insert a `\0' character | |
2795 ;; (which cannot happen in a filename) | |
2796 ;; into the character class, so that `^' | |
2797 ;; is not the first character after `[', | |
2798 ;; and thus non-special in a regexp. | |
2799 (progn | |
2800 (setq i (1+ i)) | |
2801 "[\000^")) | |
2802 ((eq (aref wildcard i) ?\]) | |
2803 ;; I don't think `]' can appear in a | |
2804 ;; character class in a wildcard, but | |
2805 ;; let's be general here. | |
2806 (progn | |
2807 (setq i (1+ i)) | |
2808 "[]")) | |
2809 (t "[")) | |
2810 (prog1 ; copy everything upto next `]'. | |
2811 (substring wildcard | |
2812 i | |
2813 (setq j (string-match | |
2814 "]" wildcard i))) | |
2815 (setq i (if j (1- j) (1- len))))))) | |
2816 ((eq ch ?.) "\\.") | |
2817 ((eq ch ?*) "[^\000]*") | |
2818 ((eq ch ?+) "\\+") | |
2819 ((eq ch ?^) "\\^") | |
2820 ((eq ch ?$) "\\$") | |
2821 ((eq ch ?\\) "\\\\") ; probably cannot happen... | |
2822 ((eq ch ??) "[^\000]") | |
2823 (t (char-to-string ch))))) | |
2824 (setq i (1+ i))))) | |
2825 ;; Shell wildcards should match the entire filename, | |
2826 ;; not its part. Make the regexp say so. | |
2827 (concat "\\`" result "\\'"))) | |
2828 | 2733 |
2829 (defconst list-directory-brief-switches | 2734 (defconst list-directory-brief-switches |
2830 (if (eq system-type 'vax-vms) "" "-CF") | 2735 (if (eq system-type 'vax-vms) "" "-CF") |
2831 "*Switches for list-directory to pass to `ls' for brief listing,") | 2736 "*Switches for list-directory to pass to `ls' for brief listing,") |
2832 | 2737 |
2856 (princ "Directory ") | 2761 (princ "Directory ") |
2857 (princ dirname) | 2762 (princ dirname) |
2858 (terpri) | 2763 (terpri) |
2859 (save-excursion | 2764 (save-excursion |
2860 (set-buffer "*Directory*") | 2765 (set-buffer "*Directory*") |
2861 (setq default-directory | 2766 (setq default-directory (file-name-directory dirname)) |
2862 (if (file-directory-p dirname) | |
2863 (file-name-as-directory dirname) | |
2864 (file-name-directory dirname))) | |
2865 (let ((wildcard (not (file-directory-p dirname)))) | 2767 (let ((wildcard (not (file-directory-p dirname)))) |
2866 (insert-directory dirname switches wildcard (not wildcard))))))) | 2768 (insert-directory dirname switches wildcard (not wildcard))))))) |
2867 | 2769 |
2868 (defvar insert-directory-program "ls" | 2770 (defvar insert-directory-program "ls" |
2869 "Absolute or relative name of the `ls' program used by `insert-directory'.") | 2771 "Absolute or relative name of the `ls' program used by `insert-directory'.") |
2905 wildcard full-directory-p) | 2807 wildcard full-directory-p) |
2906 (if (eq system-type 'vax-vms) | 2808 (if (eq system-type 'vax-vms) |
2907 (vms-read-directory file switches (current-buffer)) | 2809 (vms-read-directory file switches (current-buffer)) |
2908 (if wildcard | 2810 (if wildcard |
2909 ;; Run ls in the directory of the file pattern we asked for. | 2811 ;; Run ls in the directory of the file pattern we asked for. |
2910 (let ((default-directory | 2812 (let ((default-directory |
2911 (if (file-name-absolute-p file) | 2813 (if (file-name-absolute-p file) |
2912 (file-name-directory file) | 2814 (file-name-directory file) |
2913 (file-name-directory (expand-file-name file)))) | 2815 (file-name-directory (expand-file-name file)))) |
2914 (pattern (file-name-nondirectory file)) | 2816 (pattern (file-name-nondirectory file)) |
2915 (beg 0)) | 2817 (beg 0)) |
2916 ;; Quote some characters that have special meanings in shells; | 2818 ;; Quote some characters that have special meanings in shells; |
2917 ;; but don't quote the wildcards--we want them to be special. | 2819 ;; but don't quote the wildcards--we want them to be special. |
2918 ;; We also currently don't quote the quoting characters | 2820 ;; We also currently don't quote the quoting characters |
2919 ;; in case people want to use them explicitly to quote | 2821 ;; in case people want to use them explicitly to quote |
2920 ;; wildcard characters. | 2822 ;; wildcard characters. |
2921 ;;#### Unix-specific | 2823 ;;#### Unix-specific |
2922 (while (string-match "[ \t\n;<>&|()#$]" pattern beg) | 2824 (while (string-match "[ \t\n;<>&|()#$]" pattern beg) |
2923 (setq pattern | 2825 (setq pattern |
2924 (concat (substring pattern 0 (match-beginning 0)) | 2826 (concat (substring pattern 0 (match-beginning 0)) |
2925 "\\" | 2827 "\\" |
2926 (substring pattern (match-beginning 0))) | 2828 (substring pattern (match-beginning 0))) |
2947 ;; so we can pass separate options as separate args. | 2849 ;; so we can pass separate options as separate args. |
2948 (while (string-match " " switches) | 2850 (while (string-match " " switches) |
2949 (setq list (cons (substring switches 0 (match-beginning 0)) | 2851 (setq list (cons (substring switches 0 (match-beginning 0)) |
2950 list) | 2852 list) |
2951 switches (substring switches (match-end 0)))) | 2853 switches (substring switches (match-end 0)))) |
2952 (setq list (nreverse (cons switches list)))))) | 2854 (setq list (cons switches list))))) |
2953 (append list | 2855 (append list |
2954 (list | 2856 (list |
2955 (if full-directory-p | 2857 (if full-directory-p |
2956 (concat (file-name-as-directory file) | 2858 (concat (file-name-as-directory file) |
2957 ;;#### Unix-specific | 2859 ;;#### Unix-specific |
2989 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) | 2891 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) |
2990 ;; Query the user for other things, perhaps. | 2892 ;; Query the user for other things, perhaps. |
2991 (run-hook-with-args-until-failure 'kill-emacs-query-functions) | 2893 (run-hook-with-args-until-failure 'kill-emacs-query-functions) |
2992 (kill-emacs))) | 2894 (kill-emacs))) |
2993 | 2895 |
2994 ;; XEmacs | |
2995 (defun symlink-expand-file-name (filename) | 2896 (defun symlink-expand-file-name (filename) |
2996 "If FILENAME is a symlink, return its non-symlink equivalent. | 2897 "If FILENAME is a symlink, return its non-symlink equivalent. |
2997 Unlike `file-truename', this doesn't chase symlinks in directory | 2898 Unlike `file-truename', this doesn't chase symlinks in directory |
2998 components of the file or expand a relative pathname into an | 2899 components of the file or expand a relative pathname into an |
2999 absolute one." | 2900 absolute one." |
3003 count (1- count))) | 2904 count (1- count))) |
3004 (if (> count 0) | 2905 (if (> count 0) |
3005 filename | 2906 filename |
3006 (error "Apparently circular symlink path")))) | 2907 (error "Apparently circular symlink path")))) |
3007 | 2908 |
3008 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU> | |
3009 (defun file-remote-p (file-name) | |
3010 "Test whether FILE-NAME is looked for on a remote system." | |
3011 (cond ((not allow-remote-paths) nil) | |
3012 ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name)) | |
3013 (t (efs-ftp-path file-name)))) | |
3014 | |
3015 ;; Written in C in FSF | |
3016 (defun insert-file-contents (filename &optional visit beg end replace) | |
3017 "Insert contents of file FILENAME after point. | |
3018 Returns list of absolute file name and length of data inserted. | |
3019 If second argument VISIT is non-nil, the buffer's visited filename | |
3020 and last save file modtime are set, and it is marked unmodified. | |
3021 If visiting and the file does not exist, visiting is completed | |
3022 before the error is signaled. | |
3023 | |
3024 The optional third and fourth arguments BEG and END | |
3025 specify what portion of the file to insert. | |
3026 If VISIT is non-nil, BEG and END must be nil. | |
3027 If optional fifth argument REPLACE is non-nil, | |
3028 it means replace the current buffer contents (in the accessible portion) | |
3029 with the file contents. This is better than simply deleting and inserting | |
3030 the whole thing because (1) it preserves some marker positions | |
3031 and (2) it puts less data in the undo list." | |
3032 (insert-file-contents-internal filename visit beg end replace)) | |
3033 | |
3034 ;; Written in C in FSF | |
3035 (defun write-region (start end filename &optional append visit lockname) | |
3036 "Write current region into specified file. | |
3037 When called from a program, takes three arguments: | |
3038 START, END and FILENAME. START and END are buffer positions. | |
3039 Optional fourth argument APPEND if non-nil means | |
3040 append to existing file contents (if any). | |
3041 Optional fifth argument VISIT if t means | |
3042 set the last-save-file-modtime of buffer to this file's modtime | |
3043 and mark buffer not modified. | |
3044 If VISIT is a string, it is a second file name; | |
3045 the output goes to FILENAME, but the buffer is marked as visiting VISIT. | |
3046 VISIT is also the file name to lock and unlock for clash detection. | |
3047 If VISIT is neither t nor nil nor a string, | |
3048 that means do not print the \"Wrote file\" message. | |
3049 The optional sixth arg LOCKNAME, if non-nil, specifies the name to | |
3050 use for locking and unlocking, overriding FILENAME and VISIT. | |
3051 Kludgy feature: if START is a string, then that string is written | |
3052 to the file, instead of any buffer contents, and END is ignored." | |
3053 (interactive "r\nFWrite region to file: ") | |
3054 (write-region-internal start end filename append visit lockname)) | |
3055 | |
3056 ;; Written in C in FSF | |
3057 (defun load (file &optional noerror nomessage nosuffix) | |
3058 "Execute a file of Lisp code named FILE. | |
3059 First try FILE with `.elc' appended, then try with `.el', | |
3060 then try FILE unmodified. | |
3061 This function searches the directories in `load-path'. | |
3062 If optional second arg NOERROR is non-nil, | |
3063 report no error if FILE doesn't exist. | |
3064 Print messages at start and end of loading unless | |
3065 optional third arg NOMESSAGE is non-nil (ignored in -batch mode). | |
3066 If optional fourth arg NOSUFFIX is non-nil, don't try adding | |
3067 suffixes `.elc' or `.el' to the specified name FILE. | |
3068 Return t if file exists." | |
3069 (load-internal file noerror nomessage nosuffix)) | |
3070 | |
3071 ;(define-key ctl-x-map "\C-f" 'find-file) | |
3072 ;(define-key ctl-x-map "\C-q" 'toggle-read-only) | |
3073 ;(define-key ctl-x-map "\C-r" 'find-file-read-only) | |
3074 ;(define-key ctl-x-map "\C-v" 'find-alternate-file) | |
3075 ;(define-key ctl-x-map "\C-s" 'save-buffer) | |
3076 ;(define-key ctl-x-map "s" 'save-some-buffers) | |
3077 ;(define-key ctl-x-map "\C-w" 'write-file) | |
3078 ;(define-key ctl-x-map "i" 'insert-file) | |
3079 ;(define-key esc-map "~" 'not-modified) | |
3080 ;(define-key ctl-x-map "\C-d" 'list-directory) | |
3081 ;(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) | |
3082 | |
3083 ;(define-key ctl-x-4-map "f" 'find-file-other-window) | |
3084 ;(define-key ctl-x-4-map "r" 'find-file-read-only-other-window) | |
3085 ;(define-key ctl-x-4-map "\C-f" 'find-file-other-window) | |
3086 ;(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) | |
3087 ;(define-key ctl-x-4-map "\C-o" 'display-buffer) | |
3088 | |
3089 ;(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame) | |
3090 ;(define-key ctl-x-5-map "f" 'find-file-other-frame) | |
3091 ;(define-key ctl-x-5-map "\C-f" 'find-file-other-frame) | |
3092 ;(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) | |
3093 | |
3094 ;;; files.el ends here | 2909 ;;; files.el ends here |
2910 | |
2911 | |
2912 |