Mercurial > emacs
comparison lisp/uniquify.el @ 50914:26edd9033fca
Use the original buffer-name as `base' in place of the
nondirectory part of the file name.
(uniquify-rationalize-file-buffer-names):
Split the `newbuffile' arg into `base' and `dirname'.
Reuse old uniquify-items to avoid recomputing their base&dirname.
(uniquify-buffer-file-name): Only return the directory part.
(uniquify-rerationalize-w/o-cb): Don't bother reseting proposed names.
(rename-buffer): Use the `newname' arg as base.
(create-file-buffer): Split the file name into base and dirname.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 09 May 2003 13:19:15 +0000 |
| parents | 0dc88196f313 |
| children | 46d187316243 |
comparison
equal
deleted
inserted
replaced
| 50913:7a59612e7a27 | 50914:26edd9033fca |
|---|---|
| 180 (make-variable-buffer-local 'uniquify-managed) | 180 (make-variable-buffer-local 'uniquify-managed) |
| 181 (put 'uniquify-managed 'permanent-local t) | 181 (put 'uniquify-managed 'permanent-local t) |
| 182 | 182 |
| 183 ;;; Main entry point. | 183 ;;; Main entry point. |
| 184 | 184 |
| 185 (defun uniquify-rationalize-file-buffer-names (newbuffile newbuf) | 185 (defun uniquify-rationalize-file-buffer-names (base dirname newbuf) |
| 186 "Make file buffer names unique by adding segments from file name. | 186 "Make file buffer names unique by adding segments from file name. |
| 187 If `uniquify-min-dir-content' > 0, always pulls that many | 187 If `uniquify-min-dir-content' > 0, always pulls that many |
| 188 file name elements. | 188 file name elements. |
| 189 Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." | 189 Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." |
| 190 (interactive) | 190 (interactive) |
| 191 (if (null newbuffile) | 191 (if (null dirname) |
| 192 (with-current-buffer newbuf (setq uniquify-managed nil)) | 192 (with-current-buffer newbuf (setq uniquify-managed nil)) |
| 193 (setq newbuffile (expand-file-name (directory-file-name newbuffile))) | 193 (setq dirname (expand-file-name (directory-file-name dirname))) |
| 194 (let ((fix-list nil) | 194 (let ((fix-list (list (uniquify-make-item base dirname newbuf))) |
| 195 (base (file-name-nondirectory newbuffile))) | 195 items) |
| 196 (dolist (buffer (buffer-list)) | 196 (dolist (buffer (buffer-list)) |
| 197 (let ((bufname (buffer-name buffer)) | 197 (when (and (not (and uniquify-ignore-buffers-re |
| 198 bfn) | 198 (string-match uniquify-ignore-buffers-re |
| 199 (when (and (not (and uniquify-ignore-buffers-re | 199 (buffer-name buffer)))) |
| 200 (string-match uniquify-ignore-buffers-re | 200 ;; Only try to rename buffers we actually manage. |
| 201 bufname))) | 201 (setq items (buffer-local-value 'uniquify-managed buffer)) |
| 202 ;; Only try to rename buffers we actually manage. | 202 (equal base (uniquify-item-base (car items))) |
| 203 (or (buffer-local-value 'uniquify-managed buffer) | 203 ;; Don't re-add stuff we already have. Actually this |
| 204 (eq buffer newbuf)) | 204 ;; whole `and' test should only match at most once. |
| 205 (setq bfn (if (eq buffer newbuf) newbuffile | 205 (not (memq (car items) fix-list))) |
| 206 (uniquify-buffer-file-name buffer))) | 206 (setq fix-list (append fix-list items)))) |
| 207 (equal (file-name-nondirectory bfn) base)) | |
| 208 (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. | |
| 209 (setq bfn (directory-file-name bfn))) ;Strip trailing slash. | |
| 210 (push (uniquify-make-item base bfn buffer) | |
| 211 fix-list)))) | |
| 212 ;; selects buffers whose names may need changing, and others that | 207 ;; selects buffers whose names may need changing, and others that |
| 213 ;; may conflict, then bring conflicting names together | 208 ;; may conflict, then bring conflicting names together |
| 214 (uniquify-rationalize fix-list)))) | 209 (uniquify-rationalize fix-list)))) |
| 215 | 210 |
| 216 ;; uniquify's version of buffer-file-name; result never contains trailing slash | 211 ;; uniquify's version of buffer-file-name; result never contains trailing slash |
| 217 (defun uniquify-buffer-file-name (buffer) | 212 (defun uniquify-buffer-file-name (buffer) |
| 218 "Return name of file BUFFER is visiting, or nil if none. | 213 "Return name of directory, file BUFFER is visiting, or nil if none. |
| 219 Works on ordinary file-visiting buffers and buffers whose mode is mentioned | 214 Works on ordinary file-visiting buffers and buffers whose mode is mentioned |
| 220 in `uniquify-list-buffers-directory-modes', otherwise returns nil." | 215 in `uniquify-list-buffers-directory-modes', otherwise returns nil." |
| 221 (or (buffer-file-name buffer) | 216 (with-current-buffer buffer |
| 222 (with-current-buffer buffer | 217 (let ((filename |
| 223 (if (memq major-mode uniquify-list-buffers-directory-modes) | 218 (or buffer-file-name |
| 224 (and list-buffers-directory | 219 (if (memq major-mode uniquify-list-buffers-directory-modes) |
| 225 (directory-file-name list-buffers-directory)))))) | 220 list-buffers-directory)))) |
| 221 (when filename | |
| 222 (file-name-directory (expand-file-name (directory-file-name filename))))))) | |
| 226 | 223 |
| 227 (defun uniquify-rerationalize-w/o-cb (fix-list) | 224 (defun uniquify-rerationalize-w/o-cb (fix-list) |
| 228 "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." | 225 "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." |
| 229 (let ((new-fix-list nil)) | 226 (let ((new-fix-list nil)) |
| 230 (dolist (item fix-list) | 227 (dolist (item fix-list) |
| 231 (let ((buf (uniquify-item-buffer item))) | 228 (let ((buf (uniquify-item-buffer item))) |
| 232 (unless (or (eq buf (current-buffer)) (not (buffer-live-p buf))) | 229 (unless (or (eq buf (current-buffer)) (not (buffer-live-p buf))) |
| 233 ;; Reset the proposed names. | |
| 234 (setf (uniquify-item-proposed item) | |
| 235 (uniquify-get-proposed-name (uniquify-item-base item) | |
| 236 (uniquify-item-dirname item))) | |
| 237 (push item new-fix-list)))) | 230 (push item new-fix-list)))) |
| 238 (when new-fix-list | 231 (when new-fix-list |
| 239 (uniquify-rationalize new-fix-list)))) | 232 (uniquify-rationalize new-fix-list)))) |
| 240 | 233 |
| 241 (defun uniquify-rationalize (fix-list) | 234 (defun uniquify-rationalize (fix-list) |
| 407 ;; Mark this buffer so it won't be renamed by uniquify. | 400 ;; Mark this buffer so it won't be renamed by uniquify. |
| 408 (setq uniquify-managed nil) | 401 (setq uniquify-managed nil) |
| 409 (when uniquify-buffer-name-style | 402 (when uniquify-buffer-name-style |
| 410 ;; Rerationalize w.r.t the new name. | 403 ;; Rerationalize w.r.t the new name. |
| 411 (uniquify-rationalize-file-buffer-names | 404 (uniquify-rationalize-file-buffer-names |
| 412 (uniquify-buffer-file-name (current-buffer)) (current-buffer)) | 405 (ad-get-arg 0) |
| 406 (uniquify-buffer-file-name (current-buffer)) | |
| 407 (current-buffer)) | |
| 413 (setq ad-return-value (buffer-name (current-buffer)))))) | 408 (setq ad-return-value (buffer-name (current-buffer)))))) |
| 414 | 409 |
| 415 (defadvice create-file-buffer (after create-file-buffer-uniquify activate) | 410 (defadvice create-file-buffer (after create-file-buffer-uniquify activate) |
| 416 "Uniquify buffer names with parts of directory name." | 411 "Uniquify buffer names with parts of directory name." |
| 417 (if uniquify-buffer-name-style | 412 (if uniquify-buffer-name-style |
| 418 (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) | 413 (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0))))) |
| 414 (uniquify-rationalize-file-buffer-names | |
| 415 (file-name-nondirectory filename) | |
| 416 (file-name-directory filename) ad-return-value)))) | |
| 419 | 417 |
| 420 ;; Buffer deletion | 418 ;; Buffer deletion |
| 421 ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. | 419 ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. |
| 422 ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. | 420 ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. |
| 423 ;; That means that the kill-buffer-hook function cannot just delete the | 421 ;; That means that the kill-buffer-hook function cannot just delete the |