X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ad599c11938b8cf5ccc85c403fb4659debac5d33..9c0c2af5a157eca18c86f644121f7eac5488dbda:/lisp/uniquify.el diff --git a/lisp/uniquify.el b/lisp/uniquify.el index d360b17dc0..f106297476 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,6 +1,6 @@ ;;; uniquify.el --- unique buffer names dependent on file name -;; Copyright (c) 1989, 1995, 1996, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (c) 1989,95,96,97,2001,2003 Free Software Foundation, Inc. ;; Author: Dick King ;; Maintainer: FSF @@ -111,10 +111,8 @@ would have the following buffer names in the various styles: (const :tag "standard Emacs behavior (nil)" nil)) :require 'uniquify) -(defcustom uniquify-after-kill-buffer-p nil - "*If non-nil, rerationalize buffer names after a buffer has been killed. -This can be dangerous if Emacs Lisp code is keeping track of buffers by their -names (rather than keeping pointers to the buffers themselves)." +(defcustom uniquify-after-kill-buffer-p t + "If non-nil, rerationalize buffer names after a buffer has been killed." :type 'boolean) (defcustom uniquify-ask-about-buffer-names-p nil @@ -124,7 +122,7 @@ other buffer names are changed." :type 'boolean) ;; The default value matches certain Gnus buffers. -(defcustom uniquify-ignore-buffers-re "^\\*\\(un\\)?sent " +(defcustom uniquify-ignore-buffers-re nil "*Regular expression matching buffer names that should not be uniquified. For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the @@ -150,6 +148,15 @@ if it is `reverse', add the separator at the beginning; otherwise, this variable is ignored." :type 'boolean) +(defcustom uniquify-strip-common-suffix + ;; Using it when uniquify-min-dir-content>0 doesn't make much sense. + (eq 0 uniquify-min-dir-content) + "If non-nil, strip common directory suffixes of conflicting files. +E.g. if you open /a1/b/c/d and /a2/b/c/d, the buffer names will say +\"d|a1\" and \"d|a2\" instead of \"d|a1/b/c\" and \"d|a2/b/c\". +This can be handy when you have deep parallel hierarchies." + :type 'boolean) + (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) "List of modes for which uniquify should obey `list-buffers-directory'. That means that when `buffer-file-name' is set to nil, `list-buffers-directory' @@ -160,7 +167,8 @@ contains the name of the directory which the buffer is visiting.") ;; uniquify-fix-list data structure (defstruct (uniquify-item (:constructor nil) (:copier nil) - (:constructor uniquify-make-item (base dirname buffer proposed))) + (:constructor uniquify-make-item + (base dirname buffer &optional proposed))) base dirname buffer proposed) ;; Internal variables used free @@ -174,57 +182,62 @@ It actually holds the list of `uniquify-item's corresponding to the conflict.") ;;; Main entry point. -(defun uniquify-rationalize-file-buffer-names (newbuffile newbuf) +(defun uniquify-rationalize-file-buffer-names (base dirname newbuf) "Make file buffer names unique by adding segments from file name. If `uniquify-min-dir-content' > 0, always pulls that many file name elements. -Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." +Arguments BASE, DIRNAME, and NEWBUF specify the new buffer that causes +this rationaliztion." (interactive) - (if (null newbuffile) + (if (null dirname) (with-current-buffer newbuf (setq uniquify-managed nil)) - (setq newbuffile (expand-file-name (directory-file-name newbuffile))) - (let ((fix-list nil) - (base (file-name-nondirectory newbuffile))) + (setq dirname (expand-file-name (directory-file-name dirname))) + (let ((fix-list (list (uniquify-make-item base dirname newbuf))) + items) (dolist (buffer (buffer-list)) - (let ((bufname (buffer-name buffer)) - bfn) - (when (and (not (and uniquify-ignore-buffers-re - (string-match uniquify-ignore-buffers-re - bufname))) - ;; Only try to rename buffers we actually manage. - (or (buffer-local-value 'uniquify-managed buffer) - (eq buffer newbuf)) - (setq bfn (if (eq buffer newbuf) newbuffile - (uniquify-buffer-file-name buffer))) - (equal (file-name-nondirectory bfn) base)) - (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. - (setq bfn (directory-file-name bfn))) ;Strip trailing slash. - (push (uniquify-make-item base bfn buffer - (uniquify-get-proposed-name base bfn)) - fix-list)))) + (when (and (not (and uniquify-ignore-buffers-re + (string-match uniquify-ignore-buffers-re + (buffer-name buffer)))) + ;; Only try to rename buffers we actually manage. + (setq items (buffer-local-value 'uniquify-managed buffer)) + (equal base (uniquify-item-base (car items))) + ;; Don't re-add stuff we already have. Actually this + ;; whole `and' test should only match at most once. + (not (memq (car items) fix-list))) + (unless (cdr items) + ;; If there was no conflict, the buffer-name is equal to the + ;; base-name and we may have missed a rename-buffer because + ;; of code like in set-visited-file-name: + ;; (or (string= new-name (buffer-name)) (rename-buffer new-name t)) + ;; So we need to refresh the dirname of the uniquify-item. + (setf (uniquify-item-dirname (car items)) + (uniquify-buffer-file-name + (uniquify-item-buffer (car items)))) + ;; This shouldn't happen, but maybe there's no dirname any more. + (unless (uniquify-item-dirname (car items)) + (with-current-buffer (uniquify-item-buffer (car items)) + (setq uniquify-managed nil)) + (setq items nil))) + (setq fix-list (append fix-list items)))) ;; selects buffers whose names may need changing, and others that ;; may conflict, then bring conflicting names together (uniquify-rationalize fix-list)))) ;; uniquify's version of buffer-file-name; result never contains trailing slash (defun uniquify-buffer-file-name (buffer) - "Return name of file BUFFER is visiting, or nil if none. + "Return name of directory, file BUFFER is visiting, or nil if none. Works on ordinary file-visiting buffers and buffers whose mode is mentioned in `uniquify-list-buffers-directory-modes', otherwise returns nil." - (or (buffer-file-name buffer) - (with-current-buffer buffer - (and - (memq major-mode uniquify-list-buffers-directory-modes) - (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this - (and list-buffers-directory - (directory-file-name list-buffers-directory)) - ;; don't use default-directory if dired-directory is nil - (and dired-directory - (expand-file-name - (directory-file-name - (if (consp dired-directory) - (car dired-directory) - dired-directory))))))))) + (with-current-buffer buffer + (let ((filename + (or buffer-file-name + (if (memq major-mode uniquify-list-buffers-directory-modes) + list-buffers-directory)))) + (when filename + (directory-file-name + (file-name-directory + (expand-file-name + (directory-file-name filename)))))))) (defun uniquify-rerationalize-w/o-cb (fix-list) "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." @@ -232,10 +245,6 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (dolist (item fix-list) (let ((buf (uniquify-item-buffer item))) (unless (or (eq buf (current-buffer)) (not (buffer-live-p buf))) - ;; Reset the proposed names. - (setf (uniquify-item-proposed item) - (uniquify-get-proposed-name (uniquify-item-base item) - (uniquify-item-dirname item))) (push item new-fix-list)))) (when new-fix-list (uniquify-rationalize new-fix-list)))) @@ -243,9 +252,36 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (defun uniquify-rationalize (fix-list) ;; Set up uniquify to re-rationalize after killing/renaming ;; if there is a conflict. - (dolist (fix fix-list) - (with-current-buffer (uniquify-item-buffer fix) + (dolist (item fix-list) + (with-current-buffer (uniquify-item-buffer item) + ;; Refresh the dirnames and proposed names. + (setf (uniquify-item-proposed item) + (uniquify-get-proposed-name (uniquify-item-base item) + (uniquify-item-dirname item))) (setq uniquify-managed fix-list))) + ;; Strip any shared last directory names of the dirname. + (when (and (cdr fix-list) uniquify-strip-common-suffix) + (let ((strip t)) + (while (let* ((base (file-name-nondirectory + (uniquify-item-dirname (car fix-list)))) + (items fix-list)) + (when (> (length base) 0) + (while (and strip items) + (unless (equal base (file-name-nondirectory + (uniquify-item-dirname (pop items)))) + (setq strip nil))) + strip)) + ;; It's all the same => strip. + (dolist (item (prog1 fix-list (setq fix-list nil))) + ;; Create new items because the old ones are kept (with the true + ;; `dirname') for later rerationalizing. + (push (uniquify-make-item (uniquify-item-base item) + (let ((f (file-name-directory + (uniquify-item-dirname item)))) + (and f (directory-file-name f))) + (uniquify-item-buffer item) + (uniquify-item-proposed item)) + fix-list))))) ;; If uniquify-min-dir-content is 0, this will end up just ;; passing fix-list to uniquify-rationalize-conflicting-sublist. (uniquify-rationalize-a-list fix-list)) @@ -274,7 +310,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (defun uniquify-get-proposed-name (base dirname &optional depth) (unless depth (setq depth uniquify-min-dir-content)) - (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. + (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. ;; Distinguish directories by adding extra separator. (if (and uniquify-trailing-separator-p @@ -294,7 +330,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (setq dirname (directory-file-name dirname))) (setq n (1- n)) (push (if (zerop (length file)) ;nil or "". - (prog1 "" (setq dirname nil)) ;Could be `dirname' iso "". + (prog1 "" (setq dirname nil)) ;Could be `dirname' iso "". file) extra-string))) (when (zerop n) @@ -384,13 +420,18 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (when uniquify-buffer-name-style ;; Rerationalize w.r.t the new name. (uniquify-rationalize-file-buffer-names - (uniquify-buffer-file-name (current-buffer)) (current-buffer)) + (ad-get-arg 0) + (uniquify-buffer-file-name (current-buffer)) + (current-buffer)) (setq ad-return-value (buffer-name (current-buffer)))))) (defadvice create-file-buffer (after create-file-buffer-uniquify activate) "Uniquify buffer names with parts of directory name." (if uniquify-buffer-name-style - (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) + (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0))))) + (uniquify-rationalize-file-buffer-names + (file-name-nondirectory filename) + (file-name-directory filename) ad-return-value)))) ;; Buffer deletion ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. @@ -416,4 +457,6 @@ For use on `kill-buffer-hook'." (add-hook 'kill-buffer-hook 'uniquify-maybe-rerationalize-w/o-cb) (provide 'uniquify) + +;;; arch-tag: e763faa3-56c9-4903-8eb8-26e1c45a0065 ;;; uniquify.el ends here