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)
next prev parent 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).