2:02 p.m.
changeset: 4648:907697569a49
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Jul 12 14:01:09 2009 +0100
files: lisp/ChangeLog lisp/files.el
description:
Mark buffers modified in #'find-file if nonexistent file; fix other bugs.
lisp/ChangeLog addition:
2009-07-12 Aidan Kehoe <kehoea(a)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.
diff -r e4ed58cb0e5b -r 907697569a49 lisp/ChangeLog
--- a/lisp/ChangeLog Sat Jul 11 16:33:35 2009 +0100
+++ b/lisp/ChangeLog Sun Jul 12 14:01:09 2009 +0100
＠＠ -1,3 +1,21 ＠＠
+2009-07-12 Aidan Kehoe <kehoea(a)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.
+
2009-07-11 Aidan Kehoe <kehoea(a)parhasard.net>
* code-files.el (insert-file-contents):
diff -r e4ed58cb0e5b -r 907697569a49 lisp/files.el
--- 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)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches