Re: suggested new command `picture-mouse-set-point'

[Juanma Barranquero <lektu@terra.es>]

On Wed, 30 Oct 2002 12:18:04 -0500, Richard Stallman <rms@gnu.org> 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))))
 \f
 (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)