Mercurial > emacs
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 |