diff options
| author | Stefan Monnier | 2003-04-17 21:15:04 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2003-04-17 21:15:04 +0000 |
| commit | 818286f457cd0df16c3d7e9b2dfe94cc0d76c95a (patch) | |
| tree | bdae19edea1fc65fc4938d1a042cb532f8c7f1e2 | |
| parent | 16ad5f3ae3e585c1bb35891342c4066347c48aff (diff) | |
| download | emacs-818286f457cd0df16c3d7e9b2dfe94cc0d76c95a.tar.gz emacs-818286f457cd0df16c3d7e9b2dfe94cc0d76c95a.zip | |
(view-read-only): Don't declare a second time.
(find-file-read-only, find-file-read-only-other-window)
(find-file-read-only-other-frame): Check that file does exist.
(large-file-warning-threshold): New custom.
(find-file-noselect): Use it.
(report-errors): New macro.
(normal-mode): Use it.
(toggle-read-only): Really toggle, even if view-mode is on.
(parse-colon-path): Remove unused `cd-prefix' var.
(make-backup-file-name-1): Remove unused `failed' var.
(basic-save-buffer): Remove unused `tempsetmodes' var.
(basic-save-buffer-2): Remove unused `temp' var.
(insert-directory): Remove unused `available' var.
| -rw-r--r-- | lisp/files.el | 64 |
1 files changed, 46 insertions, 18 deletions
diff --git a/lisp/files.el b/lisp/files.el index 9bb2de41993..c6b91c57d6d 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -442,8 +442,7 @@ and ignores this variable." | |||
| 442 | (or (fboundp 'file-locked-p) | 442 | (or (fboundp 'file-locked-p) |
| 443 | (defalias 'file-locked-p 'ignore)) | 443 | (defalias 'file-locked-p 'ignore)) |
| 444 | 444 | ||
| 445 | (defvar view-read-only nil | 445 | (defvar view-read-only) ;Declared in view.el. |
| 446 | "*Non-nil means buffers visiting files read-only, do it in view mode.") | ||
| 447 | 446 | ||
| 448 | (put 'ange-ftp-completion-hook-function 'safe-magic t) | 447 | (put 'ange-ftp-completion-hook-function 'safe-magic t) |
| 449 | (defun ange-ftp-completion-hook-function (op &rest args) | 448 | (defun ange-ftp-completion-hook-function (op &rest args) |
| @@ -501,7 +500,7 @@ Not actually set up until the first time you use it.") | |||
| 501 | \(For values of `colon' equal to `path-separator'.)" | 500 | \(For values of `colon' equal to `path-separator'.)" |
| 502 | ;; We could use split-string here. | 501 | ;; We could use split-string here. |
| 503 | (and cd-path | 502 | (and cd-path |
| 504 | (let (cd-prefix cd-list (cd-start 0) cd-colon) | 503 | (let (cd-list (cd-start 0) cd-colon) |
| 505 | (setq cd-path (concat cd-path path-separator)) | 504 | (setq cd-path (concat cd-path path-separator)) |
| 506 | (while (setq cd-colon (string-match path-separator cd-path cd-start)) | 505 | (while (setq cd-colon (string-match path-separator cd-path cd-start)) |
| 507 | (setq cd-list | 506 | (setq cd-list |
| @@ -928,6 +927,7 @@ expand wildcards (if any) and visit multiple files." | |||
| 928 | Like \\[find-file] but marks buffer as read-only. | 927 | Like \\[find-file] but marks buffer as read-only. |
| 929 | Use \\[toggle-read-only] to permit editing." | 928 | Use \\[toggle-read-only] to permit editing." |
| 930 | (interactive (find-file-read-args "Find file read-only: " t)) | 929 | (interactive (find-file-read-args "Find file read-only: " t)) |
| 930 | (unless (file-exists-p filename) (error "%s does not exist" filename)) | ||
| 931 | (find-file filename wildcards) | 931 | (find-file filename wildcards) |
| 932 | (toggle-read-only 1) | 932 | (toggle-read-only 1) |
| 933 | (current-buffer)) | 933 | (current-buffer)) |
| @@ -937,6 +937,7 @@ Use \\[toggle-read-only] to permit editing." | |||
| 937 | Like \\[find-file-other-window] but marks buffer as read-only. | 937 | Like \\[find-file-other-window] but marks buffer as read-only. |
| 938 | Use \\[toggle-read-only] to permit editing." | 938 | Use \\[toggle-read-only] to permit editing." |
| 939 | (interactive (find-file-read-args "Find file read-only other window: " t)) | 939 | (interactive (find-file-read-args "Find file read-only other window: " t)) |
| 940 | (unless (file-exists-p filename) (error "%s does not exist" filename)) | ||
| 940 | (find-file-other-window filename wildcards) | 941 | (find-file-other-window filename wildcards) |
| 941 | (toggle-read-only 1) | 942 | (toggle-read-only 1) |
| 942 | (current-buffer)) | 943 | (current-buffer)) |
| @@ -946,6 +947,7 @@ Use \\[toggle-read-only] to permit editing." | |||
| 946 | Like \\[find-file-other-frame] but marks buffer as read-only. | 947 | Like \\[find-file-other-frame] but marks buffer as read-only. |
| 947 | Use \\[toggle-read-only] to permit editing." | 948 | Use \\[toggle-read-only] to permit editing." |
| 948 | (interactive (find-file-read-args "Find file read-only other frame: " t)) | 949 | (interactive (find-file-read-args "Find file read-only other frame: " t)) |
| 950 | (unless (file-exists-p filename) (error "%s does not exist" filename)) | ||
| 949 | (find-file-other-frame filename wildcards) | 951 | (find-file-other-frame filename wildcards) |
| 950 | (toggle-read-only 1) | 952 | (toggle-read-only 1) |
| 951 | (current-buffer)) | 953 | (current-buffer)) |
| @@ -1163,6 +1165,10 @@ suppresses this warning." | |||
| 1163 | :version "21.1" | 1165 | :version "21.1" |
| 1164 | :type 'boolean) | 1166 | :type 'boolean) |
| 1165 | 1167 | ||
| 1168 | (defcustom large-file-warning-threshold 10000000 | ||
| 1169 | "Maximum size of file above which a confirmation is requested." | ||
| 1170 | :type 'integer) | ||
| 1171 | |||
| 1166 | (defun find-file-noselect (filename &optional nowarn rawfile wildcards) | 1172 | (defun find-file-noselect (filename &optional nowarn rawfile wildcards) |
| 1167 | "Read file FILENAME into a buffer and return the buffer. | 1173 | "Read file FILENAME into a buffer and return the buffer. |
| 1168 | If a buffer exists visiting FILENAME, return that one, but | 1174 | If a buffer exists visiting FILENAME, return that one, but |
| @@ -1198,7 +1204,8 @@ that are visiting the various files." | |||
| 1198 | (mapcar #'find-file-noselect files))) | 1204 | (mapcar #'find-file-noselect files))) |
| 1199 | (let* ((buf (get-file-buffer filename)) | 1205 | (let* ((buf (get-file-buffer filename)) |
| 1200 | (truename (abbreviate-file-name (file-truename filename))) | 1206 | (truename (abbreviate-file-name (file-truename filename))) |
| 1201 | (number (nthcdr 10 (file-attributes truename))) | 1207 | (attributes (file-attributes truename)) |
| 1208 | (number (nthcdr 10 attributes)) | ||
| 1202 | ;; Find any buffer for a file which has same truename. | 1209 | ;; Find any buffer for a file which has same truename. |
| 1203 | (other (and (not buf) (find-buffer-visiting filename)))) | 1210 | (other (and (not buf) (find-buffer-visiting filename)))) |
| 1204 | ;; Let user know if there is a buffer with the same truename. | 1211 | ;; Let user know if there is a buffer with the same truename. |
| @@ -1212,6 +1219,17 @@ that are visiting the various files." | |||
| 1212 | ;; Optionally also find that buffer. | 1219 | ;; Optionally also find that buffer. |
| 1213 | (if (or find-file-existing-other-name find-file-visit-truename) | 1220 | (if (or find-file-existing-other-name find-file-visit-truename) |
| 1214 | (setq buf other)))) | 1221 | (setq buf other)))) |
| 1222 | ;; Check to see if the file looks uncommonly large. | ||
| 1223 | (when (and large-file-warning-threshold (nth 7 attributes) | ||
| 1224 | ;; Don't ask again if we already have the file or | ||
| 1225 | ;; if we're asked to be quiet. | ||
| 1226 | (not (or buf nowarn)) | ||
| 1227 | (> (nth 7 attributes) large-file-warning-threshold) | ||
| 1228 | (not (y-or-n-p | ||
| 1229 | (format "File %s is large (%sMB), really open? " | ||
| 1230 | (file-name-nondirectory filename) | ||
| 1231 | (/ (nth 7 attributes) 1048576))))) | ||
| 1232 | (error "Aborted")) | ||
| 1215 | (if buf | 1233 | (if buf |
| 1216 | ;; We are using an existing buffer. | 1234 | ;; We are using an existing buffer. |
| 1217 | (progn | 1235 | (progn |
| @@ -1521,6 +1539,19 @@ unless NOMODES is non-nil." | |||
| 1521 | (view-mode-enter)) | 1539 | (view-mode-enter)) |
| 1522 | (run-hooks 'find-file-hook))) | 1540 | (run-hooks 'find-file-hook))) |
| 1523 | 1541 | ||
| 1542 | (defmacro report-errors (format &rest body) | ||
| 1543 | "Eval BODY and turn any error into a FORMAT message. | ||
| 1544 | FORMAT can have a %s escape which will be replaced with the actual error. | ||
| 1545 | If `debug-on-error' is set, errors are not caught, so that you can | ||
| 1546 | debug them. | ||
| 1547 | Avoid using a large BODY since it is duplicated." | ||
| 1548 | (declare (debug t) (indent 1)) | ||
| 1549 | `(if debug-on-error | ||
| 1550 | (progn . ,body) | ||
| 1551 | (condition-case err | ||
| 1552 | (progn . ,body) | ||
| 1553 | (error (message ,format (prin1-to-string err)))))) | ||
| 1554 | |||
| 1524 | (defun normal-mode (&optional find-file) | 1555 | (defun normal-mode (&optional find-file) |
| 1525 | "Choose the major mode for this buffer automatically. | 1556 | "Choose the major mode for this buffer automatically. |
| 1526 | Also sets up any specified local variables of the file. | 1557 | Also sets up any specified local variables of the file. |
| @@ -1538,16 +1569,11 @@ or from Lisp without specifying the optional argument FIND-FILE; | |||
| 1538 | in that case, this function acts as if `enable-local-variables' were t." | 1569 | in that case, this function acts as if `enable-local-variables' were t." |
| 1539 | (interactive) | 1570 | (interactive) |
| 1540 | (or find-file (funcall (or default-major-mode 'fundamental-mode))) | 1571 | (or find-file (funcall (or default-major-mode 'fundamental-mode))) |
| 1541 | (condition-case err | 1572 | (report-errors "File mode specification error: %s" |
| 1542 | (set-auto-mode) | 1573 | (set-auto-mode)) |
| 1543 | (error (message "File mode specification error: %s" | 1574 | (report-errors "File local-variables error: %s" |
| 1544 | (prin1-to-string err)))) | 1575 | (let ((enable-local-variables (or (not find-file) enable-local-variables))) |
| 1545 | (condition-case err | 1576 | (hack-local-variables))) |
| 1546 | (let ((enable-local-variables (or (not find-file) | ||
| 1547 | enable-local-variables))) | ||
| 1548 | (hack-local-variables)) | ||
| 1549 | (error (message "File local-variables error: %s" | ||
| 1550 | (prin1-to-string err)))) | ||
| 1551 | (if (fboundp 'ucs-set-table-for-input) ; don't lose when building | 1577 | (if (fboundp 'ucs-set-table-for-input) ; don't lose when building |
| 1552 | (ucs-set-table-for-input))) | 1578 | (ucs-set-table-for-input))) |
| 1553 | 1579 | ||
| @@ -2677,7 +2703,7 @@ doesn't exist, it is created." | |||
| 2677 | (defun make-backup-file-name-1 (file) | 2703 | (defun make-backup-file-name-1 (file) |
| 2678 | "Subroutine of `make-backup-file-name' and `find-backup-file-name'." | 2704 | "Subroutine of `make-backup-file-name' and `find-backup-file-name'." |
| 2679 | (let ((alist backup-directory-alist) | 2705 | (let ((alist backup-directory-alist) |
| 2680 | elt backup-directory failed) | 2706 | elt backup-directory) |
| 2681 | (while alist | 2707 | (while alist |
| 2682 | (setq elt (pop alist)) | 2708 | (setq elt (pop alist)) |
| 2683 | (if (string-match (car elt) file) | 2709 | (if (string-match (car elt) file) |
| @@ -2994,7 +3020,7 @@ After saving the buffer, this function runs `after-save-hook'." | |||
| 2994 | (set-buffer (buffer-base-buffer))) | 3020 | (set-buffer (buffer-base-buffer))) |
| 2995 | (if (buffer-modified-p) | 3021 | (if (buffer-modified-p) |
| 2996 | (let ((recent-save (recent-auto-save-p)) | 3022 | (let ((recent-save (recent-auto-save-p)) |
| 2997 | setmodes tempsetmodes) | 3023 | setmodes) |
| 2998 | ;; On VMS, rename file and buffer to get rid of version number. | 3024 | ;; On VMS, rename file and buffer to get rid of version number. |
| 2999 | (if (and (eq system-type 'vax-vms) | 3025 | (if (and (eq system-type 'vax-vms) |
| 3000 | (not (string= buffer-file-name | 3026 | (not (string= buffer-file-name |
| @@ -3104,7 +3130,7 @@ After saving the buffer, this function runs `after-save-hook'." | |||
| 3104 | ;; This requires write access to the containing dir, | 3130 | ;; This requires write access to the containing dir, |
| 3105 | ;; which is why we don't try it if we don't have that access. | 3131 | ;; which is why we don't try it if we don't have that access. |
| 3106 | (let ((realname buffer-file-name) | 3132 | (let ((realname buffer-file-name) |
| 3107 | tempname temp nogood i succeed | 3133 | tempname nogood i succeed |
| 3108 | (old-modtime (visited-file-modtime))) | 3134 | (old-modtime (visited-file-modtime))) |
| 3109 | (setq i 0) | 3135 | (setq i 0) |
| 3110 | (setq nogood t) | 3136 | (setq nogood t) |
| @@ -3289,6 +3315,8 @@ If visiting file read-only and `view-read-only' is non-nil, enter view mode." | |||
| 3289 | (make-local-variable 'view-read-only) | 3315 | (make-local-variable 'view-read-only) |
| 3290 | (setq view-read-only t)) ; Must leave view mode. | 3316 | (setq view-read-only t)) ; Must leave view mode. |
| 3291 | ((and (not buffer-read-only) view-read-only | 3317 | ((and (not buffer-read-only) view-read-only |
| 3318 | ;; If view-mode is already active, `view-mode-enter' is a nop. | ||
| 3319 | (not view-mode) | ||
| 3292 | (not (eq (get major-mode 'mode-class) 'special))) | 3320 | (not (eq (get major-mode 'mode-class) 'special))) |
| 3293 | (view-mode-enter)) | 3321 | (view-mode-enter)) |
| 3294 | (t (setq buffer-read-only (not buffer-read-only)) | 3322 | (t (setq buffer-read-only (not buffer-read-only)) |
| @@ -4164,7 +4192,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'." | |||
| 4164 | wildcard full-directory-p) | 4192 | wildcard full-directory-p) |
| 4165 | (if (eq system-type 'vax-vms) | 4193 | (if (eq system-type 'vax-vms) |
| 4166 | (vms-read-directory file switches (current-buffer)) | 4194 | (vms-read-directory file switches (current-buffer)) |
| 4167 | (let (result available (beg (point))) | 4195 | (let (result (beg (point))) |
| 4168 | 4196 | ||
| 4169 | ;; Read the actual directory using `insert-directory-program'. | 4197 | ;; Read the actual directory using `insert-directory-program'. |
| 4170 | ;; RESULT gets the status code. | 4198 | ;; RESULT gets the status code. |