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 16:02:25 +0100 Sender: emacs-devel-admin@gnu.org Message-ID: <20021104160051.F479.LEKTU@terra.es> References: <20021104120550.F46A.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 1036423677 17861 80.91.224.249 (4 Nov 2002 15:27:57 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 4 Nov 2002 15:27:57 +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 188j8p-0004dZ-00 for ; Mon, 04 Nov 2002 16:27:51 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 188jGP-0007nq-00 for ; Mon, 04 Nov 2002 16:35:41 +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 188j8D-0004hq-00; Mon, 04 Nov 2002 10:27:13 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10) id 188itD-00084c-00 for emacs-devel@gnu.org; Mon, 04 Nov 2002 10:11:43 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10) id 188ikK-0004Nh-00 for emacs-devel@gnu.org; Mon, 04 Nov 2002 10:02:36 -0500 Original-Received: from [62.22.27.141] (helo=mail.peoplecall.com) by monty-python.gnu.org with esmtp (Exim 4.10) id 188ikJ-0004M5-00; Mon, 04 Nov 2002 10:02:31 -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 gA4F2P009108; Mon, 4 Nov 2002 16:02:25 +0100 Original-To: rms@gnu.org In-Reply-To: <20021104120550.F46A.LEKTU@terra.es> 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:9108 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:9108 On Mon, 04 Nov 2002 12:13:48 +0100, Juanma Barranquero wrote: > OK, here's the (still uncommited) "definitive" patch. Er, *this* one I mean. Little change, but I prefer not to mess with the filename passed to `get-file-buffer'. /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 14:47:17 -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)) + (truename (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 truename) + (funcall predicate (current-buffer))) + (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) + (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)