diff 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
line wrap: on
line diff
--- a/lisp/files.el	Sat Jul 11 16:33:35 2009 +0100
+++ b/lisp/files.el	Sun Jul 12 14:01:09 2009 +0100
@@ -879,6 +879,30 @@
 		  (not (funcall buffers-tab-selection-function
 			curbuf (car (buffer-list)))))))))
 
+(defmacro find-file-create-switch-thunk (switch-function)
+  "Mark buffer modified if needed, then call SWITCH-FUNCTION. 
+
+The buffer will be marked modified if the file associated with the buffer
+does not exist.  This means that \\[find-file] on a non-existent file will
+create a modified buffer, making \\[save-buffer] sufficient to create the
+file.
+
+SWITCH-FUNCTION should be `switch-to-buffer' or a related function.  This
+function (that is, `find-file-create-switch-thunk') is implemented as a macro
+because we don't have built-in lexical scope, a closure created with
+`lexical-let' will always run as interpreted code.  Though functions created
+by this macro are unlikely to be called in performance-critical contexts.
+
+This function may be called from functions related to `find-file', as well
+as `find-file' itself."
+  `(function
+    (lambda (buffer)
+      (unless (file-exists-p (buffer-file-name buffer))
+        ;; XEmacs: nonexistent file--qualifies as a modification to the
+        ;; buffer.
+        (set-buffer-modified-p t buffer))
+      (,switch-function buffer))))
+
 (defun find-file (filename &optional codesys wildcards)
   "Edit file FILENAME.
 Switch to a buffer visiting file FILENAME, creating one if none already
@@ -912,25 +936,13 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let* ((coding-system-for-read (get-coding-system codesys))
-	     (value (find-file-noselect filename nil nil wildcards))
-	     (bufname (if (listp value) (car (nreverse value)) value)))
-	;; If a user explicitly specified the coding system with a prefix
-	;; argument when opening a nonexistent file, insert-file-contents
-	;; hasn't preserved that coding system as the local
-	;; buffer-file-coding-system. Do that ourselves.
-	(unless (and bufname
-		     (file-exists-p (buffer-file-name bufname)) 
-		     (local-variable-p 'buffer-file-coding-system bufname))
-	  (save-excursion
-	    (set-buffer bufname)
-	    (setq buffer-file-coding-system coding-system-for-read)))
-	(switch-to-buffer bufname))
-    (let ((value (find-file-noselect filename nil nil wildcards)))
-      (if (listp value)
-	  (mapcar 'switch-to-buffer (nreverse value))
-	(switch-to-buffer value)))))
+  (and codesys (setq codesys (check-coding-system codesys)))
+  (let* ((coding-system-for-read (or codesys coding-system-for-read))
+         (value (find-file-noselect filename nil nil wildcards))
+         (thunk (find-file-create-switch-thunk switch-to-buffer)))
+    (if (listp value)
+        (mapcar thunk (nreverse value))
+      (funcall thunk value))))
 
 (defun find-file-other-window (filename &optional codesys wildcards)
   "Edit file FILENAME, in another window.
@@ -942,23 +954,17 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let ((coding-system-for-read
-	     (get-coding-system codesys)))
-	(let ((value (find-file-noselect filename nil nil wildcards)))
-	  (if (listp value)
-	      (progn
-		(setq value (nreverse value))
-		(switch-to-buffer-other-window (car value))
-		(mapcar 'switch-to-buffer (cdr value)))
-	    (switch-to-buffer-other-window value))))
-    (let ((value (find-file-noselect filename nil nil wildcards)))
-      (if (listp value)
-	  (progn
-	    (setq value (nreverse value))
-	    (switch-to-buffer-other-window (car value))
-	    (mapcar 'switch-to-buffer (cdr value)))
-	(switch-to-buffer-other-window value)))))
+  (and codesys (setq codesys (check-coding-system codesys)))
+  (let* ((coding-system-for-read (or codesys coding-system-for-read))
+         (value (find-file-noselect filename nil nil wildcards))
+         (list (and (listp value) (nreverse value)))
+         (other-window-thunk (find-file-create-switch-thunk
+                              switch-to-buffer-other-window)))
+    (if list
+        (cons
+         (funcall other-window-thunk (car list))
+         (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
+      (funcall other-window-thunk value))))
 
 (defun find-file-other-frame (filename &optional codesys wildcards)
   "Edit file FILENAME, in a newly-created frame.
@@ -969,23 +975,20 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let ((coding-system-for-read
-	     (get-coding-system codesys)))
-	(let ((value (find-file-noselect filename nil nil wildcards)))
-	  (if (listp value)
-	      (progn
-		(setq value (nreverse value))
-		(switch-to-buffer-other-frame (car value))
-		(mapcar 'switch-to-buffer (cdr value)))
-	    (switch-to-buffer-other-frame value))))
-    (let ((value (find-file-noselect filename nil nil wildcards)))
-      (if (listp value)
-	  (progn
-	    (setq value (nreverse value))
-	    (switch-to-buffer-other-frame (car value))
-	    (mapcar 'switch-to-buffer (cdr value)))
-	(switch-to-buffer-other-frame value)))))
+  (and codesys (setq codesys (check-coding-system codesys)))
+  (let* ((coding-system-for-read (or codesys coding-system-for-read))
+         (value (find-file-noselect filename nil nil wildcards))
+         (list (and (listp value) (nreverse value)))
+         (other-frame-thunk (find-file-create-switch-thunk
+                             switch-to-buffer-other-frame)))
+    (if list
+        (cons
+         (funcall other-frame-thunk (car list))
+         (mapcar (find-file-create-switch-thunk switch-to-buffer) (cdr list)))
+      (funcall other-frame-thunk value))))
+
+;; No need to keep this macro around in the dumped executable.
+(unintern 'find-file-create-switch-thunk)
 
 (defun find-file-read-only (filename &optional codesys wildcards)
   "Edit file FILENAME but don't allow changes.
@@ -998,13 +1001,11 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let ((coding-system-for-read
-	     (get-coding-system codesys)))
-	(find-file filename nil wildcards))
-    (find-file filename nil wildcards))
-  (setq buffer-read-only t)
-  (current-buffer))
+  (let ((value (find-file filename codesys wildcards)))
+    (mapcar #'(lambda (buffer)
+		(set-symbol-value-in-buffer 'buffer-read-only t buffer))
+	    (if (listp value) value (list value)))
+    value))
 
 (defun find-file-read-only-other-window (filename &optional codesys wildcards)
   "Edit file FILENAME in another window but don't allow changes.
@@ -1017,11 +1018,7 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let ((coding-system-for-read
-	     (get-coding-system codesys)))
-	(find-file-other-window filename))
-    (find-file-other-window filename))
+  (find-file-other-window filename codesys wildcards)
   (setq buffer-read-only t)
   (current-buffer))
 
@@ -1036,11 +1033,7 @@
 		     (and current-prefix-arg
 			  (read-coding-system "Coding system: "))
 		     t))
-  (if codesys
-      (let ((coding-system-for-read
-	     (get-coding-system codesys)))
-	(find-file-other-frame filename))
-    (find-file-other-frame filename))
+  (find-file-other-frame filename codesys wildcards)
   (setq buffer-read-only t)
   (current-buffer))
 
@@ -1062,7 +1055,7 @@
 	      "Find alternate file: " file-dir nil nil file-name)
 	     (if current-prefix-arg (read-coding-system "Coding-system: "))))))
   (if (one-window-p)
-      (find-file-other-window filename)
+      (find-file-other-window filename codesys)
     (save-selected-window
       (other-window 1)
       (find-alternate-file filename codesys))))
@@ -1104,11 +1097,7 @@
     (unwind-protect
 	(progn
 	  (unlock-buffer)
-	  (if codesys
-	      (let ((coding-system-for-read
-		     (get-coding-system codesys)))
-		(find-file filename))
-	    (find-file filename)))
+          (find-file filename codesys))
       (cond ((eq obuf (current-buffer))
 	     (setq buffer-file-name ofile)
 	     (setq buffer-file-number onum)