diff options
| author | Jim Blandy | 1991-10-31 08:30:58 +0000 |
|---|---|---|
| committer | Jim Blandy | 1991-10-31 08:30:58 +0000 |
| commit | 5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a (patch) | |
| tree | f031a44097983ac27126b44feecae16136593a08 | |
| parent | f798d950c80153954676635b032b3a894b307b1d (diff) | |
| download | emacs-5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a.tar.gz emacs-5bbbceb1dea7c7a7387fe451f606cb2b1d6faa0a.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/files.el | 112 |
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. |
| 210 | Switch to a buffer visiting file FILENAME, | 219 | Switch 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. | ||
| 233 | May create a new screen, or reuse an existing one. | ||
| 234 | See 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. |
| 224 | Like \\[find-file] but marks buffer as read-only. | 240 | Like \\[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. | ||
| 256 | Like \\[find-file-other-screen] but marks buffer as read-only. | ||
| 257 | Use \\[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. |
| 240 | If the current buffer now contains an empty file that you just visited | 264 | If 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. | ||
| 306 | Choose 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. | ||
| 311 | This also substitutes \"~\" for the user's home directory. | ||
| 312 | See \\[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. |
| 282 | If a buffer exists visiting FILENAME, return that one, but | 326 | If 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. |
| 915 | With argument, saves all with no questions." | 952 | Optional argument (the prefix) non-nil means save all with no questions. |
| 953 | Optional 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) | ||