unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Juanma Barranquero <lektu@terra.es>
Cc: emacs-devel@gnu.org
Subject: Re: suggested new command `picture-mouse-set-point'
Date: Mon, 04 Nov 2002 16:02:25 +0100	[thread overview]
Message-ID: <20021104160051.F479.LEKTU@terra.es> (raw)
In-Reply-To: <20021104120550.F46A.LEKTU@terra.es>

On Mon, 04 Nov 2002 12:13:48 +0100, Juanma Barranquero <lektu@terra.es> 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))))
 \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)

  reply	other threads:[~2002-11-04 15:02 UTC|newest]

Thread overview: 35+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2002-10-23 18:04 suggested new command `picture-mouse-set-point' John Paul Wallington
2002-10-24  0:31 ` Kim F. Storm
2002-10-24  9:18   ` John Paul Wallington
2002-10-24 21:42     ` Kim F. Storm
2002-10-24 23:18       ` John Paul Wallington
2002-10-24 23:37         ` Stefan Monnier
2002-10-25  1:42           ` John Paul Wallington
2002-10-25 14:19             ` Stefan Monnier
2002-10-25 22:50               ` Kevin Ryde
2002-10-25 22:57               ` John Paul Wallington
2002-10-25  9:16           ` Kim F. Storm
2002-10-25 14:11             ` Stefan Monnier
2002-10-26 12:34               ` Kai Großjohann
2002-10-26 20:14         ` Richard Stallman
2002-10-28 15:20           ` Juanma Barranquero
2002-10-28 18:26             ` Eli Zaretskii
2002-10-29  7:23               ` Juanma Barranquero
2002-10-29 19:38                 ` Eli Zaretskii
2002-10-29  3:01             ` Richard Stallman
2002-10-28 15:31           ` Juanma Barranquero
2002-10-29  3:02             ` Richard Stallman
2002-10-29 17:59               ` Juanma Barranquero
2002-10-30 11:55                 ` Kim F. Storm
2002-10-30 12:47                   ` Juanma Barranquero
2002-10-30 17:18                 ` Richard Stallman
2002-10-30 17:51                   ` Juanma Barranquero
2002-11-04 11:13                   ` Juanma Barranquero
2002-11-04 15:02                     ` Juanma Barranquero [this message]
2002-11-05  5:13                       ` Richard Stallman
2002-10-26 20:13       ` Richard Stallman
2002-10-25  5:35   ` Richard Stallman
2002-10-25  9:49     ` Kim F. Storm
2002-10-26 20:15       ` Richard Stallman
2002-10-24 16:55 ` Richard Stallman
2002-10-24 23:21   ` John Paul Wallington

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20021104160051.F479.LEKTU@terra.es \
    --to=lektu@terra.es \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).