[COMMIT] Mark buffers modified in #'find-file if nonexistent file; fix other bugs.

APPROVE COMMIT NOTE: This patch has been committed. Cf. issue 147 and the related thread, of which http://mid.gmane.org/18848.1418.826402.657446＠parhasard.net is the only message to show up in Gmane. I said yesterday that I hoped to commit something that would fix the problems with wild cards and specifying coding systems in #'find-file and related functions; I had misremembered, the change I committed yesterday was sufficient for that. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1247403669 -3600 # Node ID 907697569a49825c445209e4d95649f581cde788 # Parent e4ed58cb0e5b779d7ab5e2939e5a1b20b2acad93 Mark buffers modified in #'find-file if nonexistent file; fix other bugs. lisp/ChangeLog addition: 2009-07-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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&gt; + + * 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&gt; * 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) -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches