From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Juanma Barranquero Newsgroups: gmane.emacs.devel Subject: Re: suggested new command `picture-mouse-set-point' Date: Mon, 04 Nov 2002 12:13:48 +0100 Sender: emacs-devel-admin@gnu.org Message-ID: <20021104120550.F46A.LEKTU@terra.es> References: <20021029185552.A0B9.LEKTU@terra.es> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="US-ASCII" Content-Transfer-Encoding: 7bit X-Trace: main.gmane.org 1036409295 25408 80.91.224.249 (4 Nov 2002 11:28:15 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 4 Nov 2002 11:28:15 +0000 (UTC) Cc: emacs-devel@gnu.org Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 188fOv-0006bX-00 for ; Mon, 04 Nov 2002 12:28:13 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 188fWQ-0002Sz-00 for ; Mon, 04 Nov 2002 12:35:58 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10) id 188fO8-0001SU-00; Mon, 04 Nov 2002 06:27:24 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10) id 188fB7-0003fv-00 for emacs-devel@gnu.org; Mon, 04 Nov 2002 06:13:57 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10) id 188fB3-0003eZ-00 for emacs-devel@gnu.org; Mon, 04 Nov 2002 06:13:56 -0500 Original-Received: from [62.22.27.141] (helo=mail.peoplecall.com) by monty-python.gnu.org with esmtp (Exim 4.10) id 188fB3-0003eO-00; Mon, 04 Nov 2002 06:13:53 -0500 Original-Received: from [62.22.27.143] (jbarranquero.ofi.peoplecall.com [62.22.27.143]) by mail.peoplecall.com (8.11.6/8.11.6) with ESMTP id gA4BDm006405; Mon, 4 Nov 2002 12:13:48 +0100 Original-To: rms@gnu.org In-Reply-To: X-Mailer: Becky! ver. 2.05.06 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:9100 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:9100 On Wed, 30 Oct 2002 12:18:04 -0500, Richard Stallman wrote: > A warning is better. The user can always undo the insertion, > so it is harmless to go ahead; but the question would be annoying. OK, here's the (still uncommited) "definitive" patch. I assume when you say "a warning" you mean through `message', not `warn'. The only controversial issue in this new patch is that I've decided to add an optional PREDICATE argument to `find-buffer-visiting' instead of adding a new `find-buffer-visiting-1' function as in the previous one. As `find-buffer-visiting' is not a command but a function to be called from lisp programs, it seems better to me. Calls to `find-buffer-visiting' with no PREDICATE do now a funcall to the `identity' built-in, but that shouldn't be that expensive. Comments? /L/e/k/t/u Index: files.el =================================================================== RCS file: /cvs/emacs/lisp/files.el,v retrieving revision 1.620 diff -u -2 -r1.620 files.el --- files.el 26 Oct 2002 22:34:14 -0000 1.620 +++ files.el 4 Nov 2002 11:05:26 -0000 @@ -1048,38 +1048,42 @@ :group 'find-file) -(defun find-buffer-visiting (filename) +(defun find-buffer-visiting (filename &optional predicate) "Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. +If PREDICATE is non-nil, only a buffer satisfying it can be returned. If there is no such live buffer, return nil." - (let ((buf (get-file-buffer filename)) - (truename (abbreviate-file-name (file-truename filename)))) - (or buf - (let ((list (buffer-list)) found) - (while (and (not found) list) - (save-excursion - (set-buffer (car list)) - (if (and buffer-file-name - (string= buffer-file-truename truename)) - (setq found (car list)))) - (setq list (cdr list))) - found) - (let* ((attributes (file-attributes truename)) - (number (nthcdr 10 attributes)) - (list (buffer-list)) found) - (and buffer-file-numbers-unique - number - (while (and (not found) list) - (with-current-buffer (car list) - (if (and buffer-file-name - (equal buffer-file-number number) - ;; Verify this buffer's file number - ;; still belongs to its file. - (file-exists-p buffer-file-name) - (equal (file-attributes buffer-file-truename) - attributes)) - (setq found (car list)))) - (setq list (cdr list)))) - found)))) + (let ((predicate (or predicate #'identity)) + (filename (abbreviate-file-name (file-truename filename)))) + (or (let ((buf (get-file-buffer filename))) + (when (and buf (funcall predicate buf)) buf)) + (let ((list (buffer-list)) found) + (while (and (not found) list) + (save-excursion + (set-buffer (car list)) + (if (and buffer-file-name + (string= buffer-file-truename filename) + (funcall predicate (current-buffer))) + (setq found (car list)))) + (setq list (cdr list))) + found) + (let* ((attributes (file-attributes filename)) + (number (nthcdr 10 attributes)) + (list (buffer-list)) found) + (and buffer-file-numbers-unique + number + (while (and (not found) list) + (with-current-buffer (car list) + (if (and buffer-file-name + (equal buffer-file-number number) + ;; Verify this buffer's file number + ;; still belongs to its file. + (file-exists-p buffer-file-name) + (equal (file-attributes buffer-file-truename) + attributes) + (funcall predicate (current-buffer))) + (setq found (car list)))) + (setq list (cdr list)))) + found)))) (defcustom find-file-wildcards t @@ -1336,4 +1340,16 @@ (fmakunbound 'find-buffer-file-type))))) +(defun insert-file-1 (filename insert-func) + (if (file-directory-p filename) + (signal 'file-error (list "Opening input file" "file is a directory" + filename))) + (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename)) + #'buffer-modified-p)) + (tem (funcall insert-func filename))) + (push-mark (+ (point) (car (cdr tem)))) + (when buffer + (message "File %s already visited and modified in buffer %s" + filename (buffer-name buffer))))) + (defun insert-file-literally (filename) "Insert contents of file FILENAME into buffer after point with no conversion. @@ -1343,9 +1359,5 @@ \(Its calling sequence is different; see its documentation)." (interactive "*fInsert file literally: ") - (if (file-directory-p filename) - (signal 'file-error (list "Opening input file" "file is a directory" - filename))) - (let ((tem (insert-file-contents-literally filename))) - (push-mark (+ (point) (car (cdr tem)))))) + (insert-file-1 filename #'insert-file-contents-literally)) (defvar find-file-literally nil @@ -3148,9 +3160,5 @@ \(Its calling sequence is different; see its documentation)." (interactive "*fInsert file: ") - (if (file-directory-p filename) - (signal 'file-error (list "Opening input file" "file is a directory" - filename))) - (let ((tem (insert-file-contents filename))) - (push-mark (+ (point) (car (cdr tem)))))) + (insert-file-1 filename #'insert-file-contents)) (defun append-to-file (start end filename)