comparison lisp/files.el @ 48153:de911fba904d

(find-buffer-visiting): Accept new optional PREDICATE argument to return only a buffer that satisfies the predicate. (insert-file-1): New function. (insert-file-literally): Use it. (insert-file): Use it.
author Juanma Barranquero <lekktu@gmail.com>
date Tue, 05 Nov 2002 07:21:14 +0000
parents c04620adce24
children 4b996fe3a71f
comparison
equal deleted inserted replaced
48152:e24a284feb7a 48153:de911fba904d
1045 directory where the file was found. If you *do not* want that, add the logical 1045 directory where the file was found. If you *do not* want that, add the logical
1046 name to this list as a string." 1046 name to this list as a string."
1047 :type '(repeat (string :tag "Name")) 1047 :type '(repeat (string :tag "Name"))
1048 :group 'find-file) 1048 :group 'find-file)
1049 1049
1050 (defun find-buffer-visiting (filename) 1050 (defun find-buffer-visiting (filename &optional predicate)
1051 "Return the buffer visiting file FILENAME (a string). 1051 "Return the buffer visiting file FILENAME (a string).
1052 This is like `get-file-buffer', except that it checks for any buffer 1052 This is like `get-file-buffer', except that it checks for any buffer
1053 visiting the same file, possibly under a different name. 1053 visiting the same file, possibly under a different name.
1054 If PREDICATE is non-nil, only a buffer satisfying it can be returned.
1054 If there is no such live buffer, return nil." 1055 If there is no such live buffer, return nil."
1055 (let ((buf (get-file-buffer filename)) 1056 (let ((predicate (or predicate #'identity))
1056 (truename (abbreviate-file-name (file-truename filename)))) 1057 (truename (abbreviate-file-name (file-truename filename))))
1057 (or buf 1058 (or (let ((buf (get-file-buffer filename)))
1058 (let ((list (buffer-list)) found) 1059 (when (and buf (funcall predicate buf)) buf))
1059 (while (and (not found) list) 1060 (let ((list (buffer-list)) found)
1060 (save-excursion 1061 (while (and (not found) list)
1061 (set-buffer (car list)) 1062 (save-excursion
1062 (if (and buffer-file-name 1063 (set-buffer (car list))
1063 (string= buffer-file-truename truename)) 1064 (if (and buffer-file-name
1064 (setq found (car list)))) 1065 (string= buffer-file-truename truename)
1065 (setq list (cdr list))) 1066 (funcall predicate (current-buffer)))
1066 found) 1067 (setq found (car list))))
1067 (let* ((attributes (file-attributes truename)) 1068 (setq list (cdr list)))
1068 (number (nthcdr 10 attributes)) 1069 found)
1069 (list (buffer-list)) found) 1070 (let* ((attributes (file-attributes truename))
1070 (and buffer-file-numbers-unique 1071 (number (nthcdr 10 attributes))
1071 number 1072 (list (buffer-list)) found)
1072 (while (and (not found) list) 1073 (and buffer-file-numbers-unique
1073 (with-current-buffer (car list) 1074 number
1074 (if (and buffer-file-name 1075 (while (and (not found) list)
1075 (equal buffer-file-number number) 1076 (with-current-buffer (car list)
1076 ;; Verify this buffer's file number 1077 (if (and buffer-file-name
1077 ;; still belongs to its file. 1078 (equal buffer-file-number number)
1078 (file-exists-p buffer-file-name) 1079 ;; Verify this buffer's file number
1079 (equal (file-attributes buffer-file-truename) 1080 ;; still belongs to its file.
1080 attributes)) 1081 (file-exists-p buffer-file-name)
1081 (setq found (car list)))) 1082 (equal (file-attributes buffer-file-truename)
1082 (setq list (cdr list)))) 1083 attributes)
1083 found)))) 1084 (funcall predicate (current-buffer)))
1085 (setq found (car list))))
1086 (setq list (cdr list))))
1087 found))))
1084 1088
1085 (defcustom find-file-wildcards t 1089 (defcustom find-file-wildcards t
1086 "*Non-nil means file-visiting commands should handle wildcards. 1090 "*Non-nil means file-visiting commands should handle wildcards.
1087 For example, if you specify `*.c', that would visit all the files 1091 For example, if you specify `*.c', that would visit all the files
1088 whose names match the pattern." 1092 whose names match the pattern."
1333 (insert-file-contents filename visit beg end replace)) 1337 (insert-file-contents filename visit beg end replace))
1334 (if find-buffer-file-type-function 1338 (if find-buffer-file-type-function
1335 (fset 'find-buffer-file-type find-buffer-file-type-function) 1339 (fset 'find-buffer-file-type find-buffer-file-type-function)
1336 (fmakunbound 'find-buffer-file-type))))) 1340 (fmakunbound 'find-buffer-file-type)))))
1337 1341
1342 (defun insert-file-1 (filename insert-func)
1343 (if (file-directory-p filename)
1344 (signal 'file-error (list "Opening input file" "file is a directory"
1345 filename)))
1346 (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
1347 #'buffer-modified-p))
1348 (tem (funcall insert-func filename)))
1349 (push-mark (+ (point) (car (cdr tem))))
1350 (when buffer
1351 (message "File %s already visited and modified in buffer %s"
1352 filename (buffer-name buffer)))))
1353
1338 (defun insert-file-literally (filename) 1354 (defun insert-file-literally (filename)
1339 "Insert contents of file FILENAME into buffer after point with no conversion. 1355 "Insert contents of file FILENAME into buffer after point with no conversion.
1340 1356
1341 This function is meant for the user to run interactively. 1357 This function is meant for the user to run interactively.
1342 Don't call it from programs! Use `insert-file-contents-literally' instead. 1358 Don't call it from programs! Use `insert-file-contents-literally' instead.
1343 \(Its calling sequence is different; see its documentation)." 1359 \(Its calling sequence is different; see its documentation)."
1344 (interactive "*fInsert file literally: ") 1360 (interactive "*fInsert file literally: ")
1345 (if (file-directory-p filename) 1361 (insert-file-1 filename #'insert-file-contents-literally))
1346 (signal 'file-error (list "Opening input file" "file is a directory"
1347 filename)))
1348 (let ((tem (insert-file-contents-literally filename)))
1349 (push-mark (+ (point) (car (cdr tem))))))
1350 1362
1351 (defvar find-file-literally nil 1363 (defvar find-file-literally nil
1352 "Non-nil if this buffer was made by `find-file-literally' or equivalent. 1364 "Non-nil if this buffer was made by `find-file-literally' or equivalent.
1353 This is a permanent local.") 1365 This is a permanent local.")
1354 (put 'find-file-literally 'permanent-local t) 1366 (put 'find-file-literally 'permanent-local t)
3145 3157
3146 This function is meant for the user to run interactively. 3158 This function is meant for the user to run interactively.
3147 Don't call it from programs! Use `insert-file-contents' instead. 3159 Don't call it from programs! Use `insert-file-contents' instead.
3148 \(Its calling sequence is different; see its documentation)." 3160 \(Its calling sequence is different; see its documentation)."
3149 (interactive "*fInsert file: ") 3161 (interactive "*fInsert file: ")
3150 (if (file-directory-p filename) 3162 (insert-file-1 filename #'insert-file-contents))
3151 (signal 'file-error (list "Opening input file" "file is a directory"
3152 filename)))
3153 (let ((tem (insert-file-contents filename)))
3154 (push-mark (+ (point) (car (cdr tem))))))
3155 3163
3156 (defun append-to-file (start end filename) 3164 (defun append-to-file (start end filename)
3157 "Append the contents of the region to the end of file FILENAME. 3165 "Append the contents of the region to the end of file FILENAME.
3158 When called from a function, expects three arguments, 3166 When called from a function, expects three arguments,
3159 START, END and FILENAME. START and END are buffer positions 3167 START, END and FILENAME. START and END are buffer positions