aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1991-10-31 08:30:58 +0000
committerJim Blandy1991-10-31 08:30:58 +0000
commit5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a (patch)
treef031a44097983ac27126b44feecae16136593a08
parentf798d950c80153954676635b032b3a894b307b1d (diff)
downloademacs-5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a.tar.gz
emacs-5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a.zip
*** empty log message ***
-rw-r--r--lisp/files.el112
1 files changed, 84 insertions, 28 deletions
diff --git a/lisp/files.el b/lisp/files.el
index 9aea76377df..2deba0db011 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -186,7 +186,10 @@ after you find a file. If you explicitly request such a scan with
186 (if (file-executable-p dir) 186 (if (file-executable-p dir)
187 (setq default-directory dir) 187 (setq default-directory dir)
188 (error "Cannot cd to %s: Permission denied" dir))) 188 (error "Cannot cd to %s: Permission denied" dir)))
189 (pwd)) 189 ;; We used to call pwd at this point. That's not terribly helpful
190 ;; when we're invoking cd interactively, and the new cmushell-based
191 ;; shell has its own (better) facilities for this.
192)
190 193
191(defun load-file (file) 194(defun load-file (file)
192 "Load the Lisp file named FILE." 195 "Load the Lisp file named FILE."
@@ -205,6 +208,12 @@ This is an interface to the function `load'."
205 (let ((pop-up-windows t)) 208 (let ((pop-up-windows t))
206 (pop-to-buffer buffer t))) 209 (pop-to-buffer buffer t)))
207 210
211(defun switch-to-buffer-other-screen (buffer)
212 "Switch to buffer BUFFER in another screen."
213 (interactive "BSwitch to buffer in other screen: ")
214 (let ((pop-up-screens t))
215 (pop-to-buffer buffer)))
216
208(defun find-file (filename) 217(defun find-file (filename)
209 "Edit file FILENAME. 218 "Edit file FILENAME.
210Switch to a buffer visiting file FILENAME, 219Switch to a buffer visiting file FILENAME,
@@ -219,6 +228,13 @@ See the function `display-buffer'."
219 (interactive "FFind file in other window: ") 228 (interactive "FFind file in other window: ")
220 (switch-to-buffer-other-window (find-file-noselect filename))) 229 (switch-to-buffer-other-window (find-file-noselect filename)))
221 230
231(defun find-file-other-screen (filename)
232 "Edit file FILENAME, in another screen.
233May create a new screen, or reuse an existing one.
234See the function `display-buffer'."
235 (interactive "FFind file in other screen: ")
236 (switch-to-buffer-other-screen (find-file-noselect filename)))
237
222(defun find-file-read-only (filename) 238(defun find-file-read-only (filename)
223 "Edit file FILENAME but don't allow changes. 239 "Edit file FILENAME but don't allow changes.
224Like \\[find-file] but marks buffer as read-only. 240Like \\[find-file] but marks buffer as read-only.
@@ -235,6 +251,14 @@ Use \\[toggle-read-only] to permit editing."
235 (find-file filename) 251 (find-file filename)
236 (setq buffer-read-only t)) 252 (setq buffer-read-only t))
237 253
254(defun find-file-read-only-other-screen (filename)
255 "Edit file FILENAME in another screen but don't allow changes.
256Like \\[find-file-other-screen] but marks buffer as read-only.
257Use \\[toggle-read-only] to permit editing."
258 (interactive "fFind file read-only other screen: ")
259 (find-file-other-screen filename)
260 (setq buffer-read-only t))
261
238(defun find-alternate-file (filename) 262(defun find-alternate-file (filename)
239 "Find file FILENAME, select its buffer, kill previous buffer. 263 "Find file FILENAME, select its buffer, kill previous buffer.
240If the current buffer now contains an empty file that you just visited 264If the current buffer now contains an empty file that you just visited
@@ -277,6 +301,26 @@ otherwise a string <2> or <3> or ... is appended to get an unused name."
277 (setq lastname filename)) 301 (setq lastname filename))
278 (generate-new-buffer lastname))) 302 (generate-new-buffer lastname)))
279 303
304(defun generate-new-buffer (name)
305 "Create and return a buffer with a name based on NAME.
306Choose the buffer's name using generate-new-buffer-name."
307 (get-buffer-create (generate-new-buffer-name name)))
308
309(defun abbreviate-file-name (filename)
310 "Return a version of FILENAME shortened using directory-abbrev-alist.
311This also substitutes \"~\" for the user's home directory.
312See \\[describe-variable] directory-abbrev-alist RET for more information."
313 (let ((tail directory-abbrev-alist))
314 (while tail
315 (if (string-match (car (car tail)) filename)
316 (setq filename
317 (concat (cdr (car tail)) (substring filename (match-end 0)))))
318 (setq tail (cdr tail)))
319 (if (string-match (concat "^" (expand-file-name "~")) filename)
320 (setq filename
321 (concat "~" (substring filename (match-end 0)))))
322 filename))
323
280(defun find-file-noselect (filename &optional nowarn) 324(defun find-file-noselect (filename &optional nowarn)
281 "Read file FILENAME into a buffer and return the buffer. 325 "Read file FILENAME into a buffer and return the buffer.
282If a buffer exists visiting FILENAME, return that one, but 326If a buffer exists visiting FILENAME, return that one, but
@@ -288,13 +332,7 @@ The buffer is not selected, just returned to the caller."
288 (file-exists-p (file-name-directory 332 (file-exists-p (file-name-directory
289 (substring filename (1- (match-end 0)))))) 333 (substring filename (1- (match-end 0))))))
290 (setq filename (substring filename (1- (match-end 0))))) 334 (setq filename (substring filename (1- (match-end 0)))))
291 ;; Perform any appropriate abbreviations specified in directory-abbrev-alist. 335 (setq filename (abbreviate-file-name filename))
292 (let ((tail directory-abbrev-alist))
293 (while tail
294 (if (string-match (car (car tail)) filename)
295 (setq filename
296 (concat (cdr (car tail)) (substring filename (match-end 0)))))
297 (setq tail (cdr tail))))
298 (if (file-directory-p filename) 336 (if (file-directory-p filename)
299 (if find-file-run-dired 337 (if find-file-run-dired
300 (dired-noselect filename) 338 (dired-noselect filename)
@@ -373,7 +411,19 @@ Finishes by calling the functions in `find-file-hooks'."
373 ((file-attributes (directory-file-name default-directory)) 411 ((file-attributes (directory-file-name default-directory))
374 "File not found and directory write-protected") 412 "File not found and directory write-protected")
375 (t 413 (t
376 "File not found and directory doesn't exist")))) 414 ;; If the directory the buffer is in doesn't exist,
415 ;; offer to create it. It's better to do this now
416 ;; than when we save the buffer, because we want
417 ;; autosaving to work.
418 (setq buffer-read-only nil)
419 (or (file-exists-p (file-name-directory buffer-file-name))
420 (if (yes-or-no-p
421 (format
422 "The directory containing %s does not exist. Create? "
423 (abbreviate-file-name buffer-file-name)))
424 (make-directory-path
425 (file-name-directory buffer-file-name))))
426 nil))))
377 (if msg 427 (if msg
378 (progn 428 (progn
379 (message msg) 429 (message msg)
@@ -546,23 +596,13 @@ if you wish to pass an empty string as the argument."
546 (unlock-buffer))) 596 (unlock-buffer)))
547 (setq buffer-file-name filename) 597 (setq buffer-file-name filename)
548 (if filename ; make buffer name reflect filename. 598 (if filename ; make buffer name reflect filename.
549 (let ((new-name (file-name-nondirectory buffer-file-name)) 599 (let ((new-name (file-name-nondirectory buffer-file-name)))
550 (old-name (buffer-name (current-buffer))))
551 (if (string= new-name "") 600 (if (string= new-name "")
552 (error "Empty file name")) 601 (error "Empty file name"))
553 (if (eq system-type 'vax-vms) 602 (if (eq system-type 'vax-vms)
554 (setq new-name (downcase new-name))) 603 (setq new-name (downcase new-name)))
555 (setq default-directory (file-name-directory buffer-file-name)) 604 (setq default-directory (file-name-directory buffer-file-name))
556 (and (get-buffer new-name) 605 (rename-buffer new-name t)))
557 (setq new-name
558 (buffer-name (create-file-buffer buffer-file-name)))
559 (kill-buffer new-name))
560 (rename-buffer new-name)
561 (if (string= (prog1 (setq new-name (buffer-name (create-file-buffer
562 buffer-file-name)))
563 (kill-buffer new-name))
564 old-name)
565 (rename-buffer old-name))))
566 (setq buffer-backed-up nil) 606 (setq buffer-backed-up nil)
567 (clear-visited-file-modtime) 607 (clear-visited-file-modtime)
568 ;; write-file-hooks is normally used for things like ftp-find-file 608 ;; write-file-hooks is normally used for things like ftp-find-file
@@ -716,7 +756,7 @@ Value is a list whose car is the name for the backup file
716 (file-name-directory fn))) 756 (file-name-directory fn)))
717 (versions (sort (mapcar 'backup-extract-version possibilities) 757 (versions (sort (mapcar 'backup-extract-version possibilities)
718 '<)) 758 '<))
719 (high-water-mark (apply 'max (cons 0 versions))) 759 (high-water-mark (apply 'max 0 versions))
720 (deserve-versions-p 760 (deserve-versions-p
721 (or version-control 761 (or version-control
722 (> high-water-mark 0))) 762 (> high-water-mark 0)))
@@ -907,12 +947,11 @@ the last real save, but optional arg FORCE non-nil means delete anyway."
907 (run-hooks 'after-save-hooks)) 947 (run-hooks 'after-save-hooks))
908 (message "(No changes need to be saved)"))) 948 (message "(No changes need to be saved)")))
909 949
910
911(require 'map-ynp)
912
913(defun save-some-buffers (&optional arg exiting) 950(defun save-some-buffers (&optional arg exiting)
914 "Save some modified file-visiting buffers. Asks user about each one. 951 "Save some modified file-visiting buffers. Asks user about each one.
915With argument, saves all with no questions." 952Optional argument (the prefix) non-nil means save all with no questions.
953Optional second argument EXITING means ask about certain non-file buffers
954 as well as about file buffers."
916 (interactive "P") 955 (interactive "P")
917 (if (zerop (map-y-or-n-p 956 (if (zerop (map-y-or-n-p
918 (function 957 (function
@@ -923,7 +962,7 @@ With argument, saves all with no questions."
923 (and exiting 962 (and exiting
924 (save-excursion 963 (save-excursion
925 (set-buffer buffer) 964 (set-buffer buffer)
926 buffer-offer-save (> (buffer-size) 0)))) 965 (and buffer-offer-save (> (buffer-size) 0)))))
927 (if arg 966 (if arg
928 t 967 t
929 (if (buffer-file-name buffer) 968 (if (buffer-file-name buffer)
@@ -1003,6 +1042,19 @@ or multiple mail buffers, etc."
1003 (kill-buffer new-buf) 1042 (kill-buffer new-buf)
1004 (rename-buffer name) 1043 (rename-buffer name)
1005 (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update 1044 (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update
1045
1046(defun make-directory-path (path)
1047 "Create all the directories along path that don't exist yet."
1048 (interactive "Fdirectory path to create: ")
1049 (let ((path (directory-file-name (expand-file-name path)))
1050 create-list)
1051 (while (not (file-exists-p path))
1052 (setq create-list (cons path create-list)
1053 path (directory-file-name (file-name-directory path))))
1054 (while create-list
1055 (make-directory (car create-list))
1056 (setq create-list (cdr create-list)))))
1057
1006 1058
1007(put 'revert-buffer-function 'permanent-local t) 1059(put 'revert-buffer-function 'permanent-local t)
1008(defvar revert-buffer-function nil 1060(defvar revert-buffer-function nil
@@ -1045,7 +1097,7 @@ If `revert-buffer-function' value is non-nil, it is called to do the work."
1045 ;; If file was backed up but has changed since, 1097 ;; If file was backed up but has changed since,
1046 ;; we shd make another backup. 1098 ;; we shd make another backup.
1047 (and (not auto-save-p) 1099 (and (not auto-save-p)
1048 (not (verify-visited-file-modtime)) 1100 (not (verify-visited-file-modtime (current-buffer)))
1049 (setq buffer-backed-up nil)) 1101 (setq buffer-backed-up nil))
1050 ;; Get rid of all undo records for this buffer. 1102 ;; Get rid of all undo records for this buffer.
1051 (or (eq buffer-undo-list t) 1103 (or (eq buffer-undo-list t)
@@ -1254,3 +1306,7 @@ With prefix arg, silently save all file-visiting buffers, then kill."
1254(define-key ctl-x-4-map "r" 'find-file-read-only-other-window) 1306(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
1255(define-key ctl-x-4-map "\C-f" 'find-file-other-window) 1307(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
1256(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window) 1308(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
1309
1310(define-key ctl-x-3-map "b" 'switch-to-buffer-other-screen)
1311(define-key ctl-x-3-map "f" 'find-file-other-screen)
1312(define-key ctl-x-3-map "r" 'find-file-read-only-other-screen)