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

[Juanma Barranquero]

On Mon, 04 Nov 2002 12:13:48 +0100, Juanma Barranquero <address@hidden> 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)