Mercurial > hg > xemacs-beta
comparison lisp/files.el @ 4648:907697569a49
Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
lisp/ChangeLog addition:
2009-07-12 Aidan Kehoe <kehoea@parhasard.net>
* files.el (find-file-create-switch-thunk):
New macro, used to mark buffers created within #'find-file (and
related) modified if the associated file doesn't exist.
(find-alternate-file-other-window):
Correct this, pass CODESYS to find-file-other-window.
(find-file-read-only):
Correct behaviour of this function in the presence of wildcards.
(find-file):
(find-file-other-window):
(find-file-other-frame):
(find-file-read-only-other-window):
(find-file-read-only-other-frame):
(find-alternate-file):
Simplify these functions, use #'find-file-create-switch-thunk'
instead of explicit #'switch-to-buffer calls.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 12 Jul 2009 14:01:09 +0100 |
| parents | f2a991ff6db0 |
| children | 3972966a4588 |
comparison
equal
deleted
inserted
replaced
| 4647:e4ed58cb0e5b | 4648:907697569a49 |
|---|---|
| 877 do (switch-to-buffer (car (last (buffer-list)))) | 877 do (switch-to-buffer (car (last (buffer-list)))) |
| 878 while (or (funcall buffers-tab-omit-function (car (buffer-list))) | 878 while (or (funcall buffers-tab-omit-function (car (buffer-list))) |
| 879 (not (funcall buffers-tab-selection-function | 879 (not (funcall buffers-tab-selection-function |
| 880 curbuf (car (buffer-list))))))))) | 880 curbuf (car (buffer-list))))))))) |
| 881 | 881 |
| 882 (defmacro find-file-create-switch-thunk (switch-function) | |
| 883 "Mark buffer modified if needed, then call SWITCH-FUNCTION. | |
| 884 | |
| 885 The buffer will be marked modified if the file associated with the buffer | |
| 886 does not exist. This means that \\[find-file] on a non-existent file will | |
| 887 create a modified buffer, making \\[save-buffer] sufficient to create the | |
| 888 file. | |
| 889 | |
| 890 SWITCH-FUNCTION should be `switch-to-buffer' or a related function. This | |
| 891 function (that is, `find-file-create-switch-thunk') is implemented as a macro | |
| 892 because we don't have built-in lexical scope, a closure created with | |
| 893 `lexical-let' will always run as interpreted code. Though functions created | |
| 894 by this macro are unlikely to be called in performance-critical contexts. | |
| 895 | |
| 896 This function may be called from functions related to `find-file', as well | |
| 897 as `find-file' itself." | |
| 898 `(function | |
| 899 (lambda (buffer) | |
| 900 (unless (file-exists-p (buffer-file-name buffer)) | |
| 901 ;; XEmacs: nonexistent file--qualifies as a modification to the | |
| 902 ;; buffer. | |
| 903 (set-buffer-modified-p t buffer)) | |
| 904 (,switch-function buffer)))) | |
| 905 | |
| 882 (defun find-file (filename &optional codesys wildcards) | 906 (defun find-file (filename &optional codesys wildcards) |
| 883 "Edit file FILENAME. | 907 "Edit file FILENAME. |
| 884 Switch to a buffer visiting file FILENAME, creating one if none already | 908 Switch to a buffer visiting file FILENAME, creating one if none already |
| 885 exists. Optional second argument specifies the coding system to use when | 909 exists. Optional second argument specifies the coding system to use when |
| 886 decoding the file. Interactively, with a prefix argument, you will be | 910 decoding the file. Interactively, with a prefix argument, you will be |
| 910 can be suppressed by setting `find-file-wildcards' to `nil'." | 934 can be suppressed by setting `find-file-wildcards' to `nil'." |
| 911 (interactive (list (read-file-name "Find file: ") | 935 (interactive (list (read-file-name "Find file: ") |
| 912 (and current-prefix-arg | 936 (and current-prefix-arg |
| 913 (read-coding-system "Coding system: ")) | 937 (read-coding-system "Coding system: ")) |
| 914 t)) | 938 t)) |
| 915 (if codesys | 939 (and codesys (setq codesys (check-coding-system codesys))) |
| 916 (let* ((coding-system-for-read (get-coding-system codesys)) | 940 (let* ((coding-system-for-read (or codesys coding-system-for-read)) |
| 917 (value (find-file-noselect filename nil nil wildcards)) | 941 (value (find-file-noselect filename nil nil wildcards)) |
| 918 (bufname (if (listp value) (car (nreverse value)) value))) | 942 (thunk (find-file-create-switch-thunk switch-to-buffer))) |
| 919 ;; If a user explicitly specified the coding system with a prefix | 943 (if (listp value) |
| 920 ;; argument when opening a nonexistent file, insert-file-contents | 944 (mapcar thunk (nreverse value)) |
| 921 ;; hasn't preserved that coding system as the local | 945 (funcall thunk value)))) |
| 922 ;; buffer-file-coding-system. Do that ourselves. | |
| 923 (unless (and bufname | |
| 924 (file-exists-p (buffer-file-name bufname)) | |
| 925 (local-variable-p 'buffer-file-coding-system bufname)) | |
| 926 (save-excursion | |
| 927 (set-buffer bufname) | |
| 928 (setq buffer-file-coding-system coding-system-for-read))) | |
| 929 (switch-to-buffer bufname)) | |
| 930 (let ((value (find-file-noselect filename nil nil wildcards))) | |
| 931 (if (listp value) | |
| 932 (mapcar 'switch-to-buffer (nreverse value)) | |
| 933 (switch-to-buffer value))))) | |
| 934 | 946 |
| 935 (defun find-file-other-window (filename &optional codesys wildcards) | 947 (defun find-file-other-window (filename &optional codesys wildcards) |
| 936 "Edit file FILENAME, in another window. | 948 "Edit file FILENAME, in another window. |
| 937 May create a new window, or reuse an existing one. See the function | 949 May create a new window, or reuse an existing one. See the function |
| 938 `display-buffer'. Optional second argument specifies the coding system to | 950 `display-buffer'. Optional second argument specifies the coding system to |
| 940 will be prompted for the coding system." | 952 will be prompted for the coding system." |
| 941 (interactive (list (read-file-name "Find file in other window: ") | 953 (interactive (list (read-file-name "Find file in other window: ") |
| 942 (and current-prefix-arg | 954 (and current-prefix-arg |
| 943 (read-coding-system "Coding system: ")) | 955 (read-coding-system "Coding system: ")) |
| 944 t)) | 956 t)) |
| 945 (if codesys | 957 (and codesys (setq codesys (check-coding-system codesys))) |
| 946 (let ((coding-system-for-read | 958 (let* ((coding-system-for-read (or codesys coding-system-for-read)) |
| 947 (get-coding-system codesys))) | 959 (value (find-file-noselect filename nil nil wildcards)) |
| 948 (let ((value (find-file-noselect filename nil nil wildcards))) | 960 (list (and (listp value) (nreverse value))) |
| 949 (if (listp value) | 961 (other-window-thunk (find-file-create-switch-thunk |
| 950 (progn | 962 switch-to-buffer-other-window))) |
| 951 (setq value (nreverse value)) | 963 (if list |
| 952 (switch-to-buffer-other-window (car value)) | 964 (cons |
| 953 (mapcar 'switch-to-buffer (cdr value))) | 965 (funcall other-window-thunk (car list)) |
| 954 (switch-to-buffer-other-window value)))) | 966 (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list))) |
| 955 (let ((value (find-file-noselect filename nil nil wildcards))) | 967 (funcall other-window-thunk value)))) |
| 956 (if (listp value) | |
| 957 (progn | |
| 958 (setq value (nreverse value)) | |
| 959 (switch-to-buffer-other-window (car value)) | |
| 960 (mapcar 'switch-to-buffer (cdr value))) | |
| 961 (switch-to-buffer-other-window value))))) | |
| 962 | 968 |
| 963 (defun find-file-other-frame (filename &optional codesys wildcards) | 969 (defun find-file-other-frame (filename &optional codesys wildcards) |
| 964 "Edit file FILENAME, in a newly-created frame. | 970 "Edit file FILENAME, in a newly-created frame. |
| 965 Optional second argument specifies the coding system to use when decoding | 971 Optional second argument specifies the coding system to use when decoding |
| 966 the file. Interactively, with a prefix argument, you will be prompted for | 972 the file. Interactively, with a prefix argument, you will be prompted for |
| 967 the coding system." | 973 the coding system." |
| 968 (interactive (list (read-file-name "Find file in other frame: ") | 974 (interactive (list (read-file-name "Find file in other frame: ") |
| 969 (and current-prefix-arg | 975 (and current-prefix-arg |
| 970 (read-coding-system "Coding system: ")) | 976 (read-coding-system "Coding system: ")) |
| 971 t)) | 977 t)) |
| 972 (if codesys | 978 (and codesys (setq codesys (check-coding-system codesys))) |
| 973 (let ((coding-system-for-read | 979 (let* ((coding-system-for-read (or codesys coding-system-for-read)) |
| 974 (get-coding-system codesys))) | 980 (value (find-file-noselect filename nil nil wildcards)) |
| 975 (let ((value (find-file-noselect filename nil nil wildcards))) | 981 (list (and (listp value) (nreverse value))) |
| 976 (if (listp value) | 982 (other-frame-thunk (find-file-create-switch-thunk |
| 977 (progn | 983 switch-to-buffer-other-frame))) |
| 978 (setq value (nreverse value)) | 984 (if list |
| 979 (switch-to-buffer-other-frame (car value)) | 985 (cons |
| 980 (mapcar 'switch-to-buffer (cdr value))) | 986 (funcall other-frame-thunk (car list)) |
| 981 (switch-to-buffer-other-frame value)))) | 987 (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list))) |
| 982 (let ((value (find-file-noselect filename nil nil wildcards))) | 988 (funcall other-frame-thunk value)))) |
| 983 (if (listp value) | 989 |
| 984 (progn | 990 ;; No need to keep this macro around in the dumped executable. |
| 985 (setq value (nreverse value)) | 991 (unintern 'find-file-create-switch-thunk) |
| 986 (switch-to-buffer-other-frame (car value)) | |
| 987 (mapcar 'switch-to-buffer (cdr value))) | |
| 988 (switch-to-buffer-other-frame value))))) | |
| 989 | 992 |
| 990 (defun find-file-read-only (filename &optional codesys wildcards) | 993 (defun find-file-read-only (filename &optional codesys wildcards) |
| 991 "Edit file FILENAME but don't allow changes. | 994 "Edit file FILENAME but don't allow changes. |
| 992 Like \\[find-file] but marks buffer as read-only. | 995 Like \\[find-file] but marks buffer as read-only. |
| 993 Use \\[toggle-read-only] to permit editing. | 996 Use \\[toggle-read-only] to permit editing. |
| 996 the coding system." | 999 the coding system." |
| 997 (interactive (list (read-file-name "Find file read-only: ") | 1000 (interactive (list (read-file-name "Find file read-only: ") |
| 998 (and current-prefix-arg | 1001 (and current-prefix-arg |
| 999 (read-coding-system "Coding system: ")) | 1002 (read-coding-system "Coding system: ")) |
| 1000 t)) | 1003 t)) |
| 1001 (if codesys | 1004 (let ((value (find-file filename codesys wildcards))) |
| 1002 (let ((coding-system-for-read | 1005 (mapcar #'(lambda (buffer) |
| 1003 (get-coding-system codesys))) | 1006 (set-symbol-value-in-buffer 'buffer-read-only t buffer)) |
| 1004 (find-file filename nil wildcards)) | 1007 (if (listp value) value (list value))) |
| 1005 (find-file filename nil wildcards)) | 1008 value)) |
| 1006 (setq buffer-read-only t) | |
| 1007 (current-buffer)) | |
| 1008 | 1009 |
| 1009 (defun find-file-read-only-other-window (filename &optional codesys wildcards) | 1010 (defun find-file-read-only-other-window (filename &optional codesys wildcards) |
| 1010 "Edit file FILENAME in another window but don't allow changes. | 1011 "Edit file FILENAME in another window but don't allow changes. |
| 1011 Like \\[find-file-other-window] but marks buffer as read-only. | 1012 Like \\[find-file-other-window] but marks buffer as read-only. |
| 1012 Use \\[toggle-read-only] to permit editing. | 1013 Use \\[toggle-read-only] to permit editing. |
| 1015 the coding system." | 1016 the coding system." |
| 1016 (interactive (list (read-file-name "Find file read-only other window: ") | 1017 (interactive (list (read-file-name "Find file read-only other window: ") |
| 1017 (and current-prefix-arg | 1018 (and current-prefix-arg |
| 1018 (read-coding-system "Coding system: ")) | 1019 (read-coding-system "Coding system: ")) |
| 1019 t)) | 1020 t)) |
| 1020 (if codesys | 1021 (find-file-other-window filename codesys wildcards) |
| 1021 (let ((coding-system-for-read | |
| 1022 (get-coding-system codesys))) | |
| 1023 (find-file-other-window filename)) | |
| 1024 (find-file-other-window filename)) | |
| 1025 (setq buffer-read-only t) | 1022 (setq buffer-read-only t) |
| 1026 (current-buffer)) | 1023 (current-buffer)) |
| 1027 | 1024 |
| 1028 (defun find-file-read-only-other-frame (filename &optional codesys wildcards) | 1025 (defun find-file-read-only-other-frame (filename &optional codesys wildcards) |
| 1029 "Edit file FILENAME in another frame but don't allow changes. | 1026 "Edit file FILENAME in another frame but don't allow changes. |
| 1034 the coding system." | 1031 the coding system." |
| 1035 (interactive (list (read-file-name "Find file read-only other frame: ") | 1032 (interactive (list (read-file-name "Find file read-only other frame: ") |
| 1036 (and current-prefix-arg | 1033 (and current-prefix-arg |
| 1037 (read-coding-system "Coding system: ")) | 1034 (read-coding-system "Coding system: ")) |
| 1038 t)) | 1035 t)) |
| 1039 (if codesys | 1036 (find-file-other-frame filename codesys wildcards) |
| 1040 (let ((coding-system-for-read | |
| 1041 (get-coding-system codesys))) | |
| 1042 (find-file-other-frame filename)) | |
| 1043 (find-file-other-frame filename)) | |
| 1044 (setq buffer-read-only t) | 1037 (setq buffer-read-only t) |
| 1045 (current-buffer)) | 1038 (current-buffer)) |
| 1046 | 1039 |
| 1047 (defun find-alternate-file-other-window (filename &optional codesys) | 1040 (defun find-alternate-file-other-window (filename &optional codesys) |
| 1048 "Find file FILENAME as a replacement for the file in the next window. | 1041 "Find file FILENAME as a replacement for the file in the next window. |
| 1060 file-dir (file-name-directory file))) | 1053 file-dir (file-name-directory file))) |
| 1061 (list (read-file-name | 1054 (list (read-file-name |
| 1062 "Find alternate file: " file-dir nil nil file-name) | 1055 "Find alternate file: " file-dir nil nil file-name) |
| 1063 (if current-prefix-arg (read-coding-system "Coding-system: ")))))) | 1056 (if current-prefix-arg (read-coding-system "Coding-system: ")))))) |
| 1064 (if (one-window-p) | 1057 (if (one-window-p) |
| 1065 (find-file-other-window filename) | 1058 (find-file-other-window filename codesys) |
| 1066 (save-selected-window | 1059 (save-selected-window |
| 1067 (other-window 1) | 1060 (other-window 1) |
| 1068 (find-alternate-file filename codesys)))) | 1061 (find-alternate-file filename codesys)))) |
| 1069 | 1062 |
| 1070 (defun find-alternate-file (filename &optional codesys) | 1063 (defun find-alternate-file (filename &optional codesys) |
| 1102 (setq buffer-file-number nil) | 1095 (setq buffer-file-number nil) |
| 1103 (setq buffer-file-truename nil) | 1096 (setq buffer-file-truename nil) |
| 1104 (unwind-protect | 1097 (unwind-protect |
| 1105 (progn | 1098 (progn |
| 1106 (unlock-buffer) | 1099 (unlock-buffer) |
| 1107 (if codesys | 1100 (find-file filename codesys)) |
| 1108 (let ((coding-system-for-read | |
| 1109 (get-coding-system codesys))) | |
| 1110 (find-file filename)) | |
| 1111 (find-file filename))) | |
| 1112 (cond ((eq obuf (current-buffer)) | 1101 (cond ((eq obuf (current-buffer)) |
| 1113 (setq buffer-file-name ofile) | 1102 (setq buffer-file-name ofile) |
| 1114 (setq buffer-file-number onum) | 1103 (setq buffer-file-number onum) |
| 1115 (setq buffer-file-truename otrue) | 1104 (setq buffer-file-truename otrue) |
| 1116 (lock-buffer) | 1105 (lock-buffer) |