112 |
:require 'uniquify) |
:require 'uniquify) |
113 |
|
|
114 |
(defcustom uniquify-after-kill-buffer-p nil |
(defcustom uniquify-after-kill-buffer-p nil |
115 |
"*If non-nil, rerationalize buffer names after a buffer has been killed. |
"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)." |
|
116 |
:type 'boolean) |
:type 'boolean) |
117 |
|
|
118 |
(defcustom uniquify-ask-about-buffer-names-p nil |
(defcustom uniquify-ask-about-buffer-names-p nil |
148 |
variable is ignored." |
variable is ignored." |
149 |
:type 'boolean) |
:type 'boolean) |
150 |
|
|
151 |
|
(defcustom uniquify-strip-common-suffix |
152 |
|
;; Using it when uniquify-min-dir-content>0 doesn't make much sense. |
153 |
|
(eq 0 uniquify-min-dir-content) |
154 |
|
"If non-nil, strip common directory suffixes of conflicting files. |
155 |
|
E.g. if you open /a1/b/c/d and /a2/b/c/d, the buffer names will say |
156 |
|
\"d|a1\" and \"d|a2\" instead of \"d|a1/b/c\" and \"d|a2/b/c\". |
157 |
|
This can be handy when you have deep parallel hierarchies." |
158 |
|
:type 'boolean) |
159 |
|
|
160 |
(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) |
(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) |
161 |
"List of modes for which uniquify should obey `list-buffers-directory'. |
"List of modes for which uniquify should obey `list-buffers-directory'. |
162 |
That means that when `buffer-file-name' is set to nil, `list-buffers-directory' |
That means that when `buffer-file-name' is set to nil, `list-buffers-directory' |
167 |
;; uniquify-fix-list data structure |
;; uniquify-fix-list data structure |
168 |
(defstruct (uniquify-item |
(defstruct (uniquify-item |
169 |
(:constructor nil) (:copier nil) |
(:constructor nil) (:copier nil) |
170 |
(:constructor uniquify-make-item (base dirname buffer proposed))) |
(:constructor uniquify-make-item |
171 |
|
(base dirname buffer &optional proposed))) |
172 |
base dirname buffer proposed) |
base dirname buffer proposed) |
173 |
|
|
174 |
;; Internal variables used free |
;; Internal variables used free |
207 |
(equal (file-name-nondirectory bfn) base)) |
(equal (file-name-nondirectory bfn) base)) |
208 |
(when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. |
(when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. |
209 |
(setq bfn (directory-file-name bfn))) ;Strip trailing slash. |
(setq bfn (directory-file-name bfn))) ;Strip trailing slash. |
210 |
(push (uniquify-make-item base bfn buffer |
(push (uniquify-make-item base bfn buffer) |
|
(uniquify-get-proposed-name base bfn)) |
|
211 |
fix-list)))) |
fix-list)))) |
212 |
;; selects buffers whose names may need changing, and others that |
;; selects buffers whose names may need changing, and others that |
213 |
;; may conflict, then bring conflicting names together |
;; may conflict, then bring conflicting names together |
220 |
in `uniquify-list-buffers-directory-modes', otherwise returns nil." |
in `uniquify-list-buffers-directory-modes', otherwise returns nil." |
221 |
(or (buffer-file-name buffer) |
(or (buffer-file-name buffer) |
222 |
(with-current-buffer buffer |
(with-current-buffer buffer |
223 |
(and |
(if (memq major-mode uniquify-list-buffers-directory-modes) |
224 |
(memq major-mode uniquify-list-buffers-directory-modes) |
(and list-buffers-directory |
225 |
(if (boundp 'list-buffers-directory) ; XEmacs mightn't define this |
(directory-file-name list-buffers-directory)))))) |
|
(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))))))))) |
|
226 |
|
|
227 |
(defun uniquify-rerationalize-w/o-cb (fix-list) |
(defun uniquify-rerationalize-w/o-cb (fix-list) |
228 |
"Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." |
"Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." |
241 |
(defun uniquify-rationalize (fix-list) |
(defun uniquify-rationalize (fix-list) |
242 |
;; Set up uniquify to re-rationalize after killing/renaming |
;; Set up uniquify to re-rationalize after killing/renaming |
243 |
;; if there is a conflict. |
;; if there is a conflict. |
244 |
(dolist (fix fix-list) |
(dolist (item fix-list) |
245 |
(with-current-buffer (uniquify-item-buffer fix) |
(with-current-buffer (uniquify-item-buffer item) |
246 |
|
;; Reset the proposed names. |
247 |
|
(setf (uniquify-item-proposed item) |
248 |
|
(uniquify-get-proposed-name (uniquify-item-base item) |
249 |
|
(uniquify-item-dirname item))) |
250 |
(setq uniquify-managed fix-list))) |
(setq uniquify-managed fix-list))) |
251 |
|
;; Strip any shared last directory names of the dirname. |
252 |
|
(when (and (cdr fix-list) uniquify-strip-common-suffix) |
253 |
|
(let ((strip t)) |
254 |
|
(while (let* ((base (file-name-nondirectory |
255 |
|
(uniquify-item-dirname (car fix-list)))) |
256 |
|
(items fix-list)) |
257 |
|
(when (> (length base) 0) |
258 |
|
(while (and strip items) |
259 |
|
(unless (equal base (file-name-nondirectory |
260 |
|
(uniquify-item-dirname (pop items)))) |
261 |
|
(setq strip nil))) |
262 |
|
strip)) |
263 |
|
;; It's all the same => strip. |
264 |
|
(dolist (item (prog1 fix-list (setq fix-list nil))) |
265 |
|
;; Create new items because the old ones are kept (with the true |
266 |
|
;; `dirname') for later rerationalizing. |
267 |
|
(push (uniquify-make-item (uniquify-item-base item) |
268 |
|
(let ((f (file-name-directory |
269 |
|
(uniquify-item-dirname item)))) |
270 |
|
(and f (directory-file-name f))) |
271 |
|
(uniquify-item-buffer item) |
272 |
|
(uniquify-item-proposed item)) |
273 |
|
fix-list))))) |
274 |
;; If uniquify-min-dir-content is 0, this will end up just |
;; If uniquify-min-dir-content is 0, this will end up just |
275 |
;; passing fix-list to uniquify-rationalize-conflicting-sublist. |
;; passing fix-list to uniquify-rationalize-conflicting-sublist. |
276 |
(uniquify-rationalize-a-list fix-list)) |
(uniquify-rationalize-a-list fix-list)) |
299 |
|
|
300 |
(defun uniquify-get-proposed-name (base dirname &optional depth) |
(defun uniquify-get-proposed-name (base dirname &optional depth) |
301 |
(unless depth (setq depth uniquify-min-dir-content)) |
(unless depth (setq depth uniquify-min-dir-content)) |
302 |
(assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. |
(assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. |
303 |
|
|
304 |
;; Distinguish directories by adding extra separator. |
;; Distinguish directories by adding extra separator. |
305 |
(if (and uniquify-trailing-separator-p |
(if (and uniquify-trailing-separator-p |
319 |
(setq dirname (directory-file-name dirname))) |
(setq dirname (directory-file-name dirname))) |
320 |
(setq n (1- n)) |
(setq n (1- n)) |
321 |
(push (if (zerop (length file)) ;nil or "". |
(push (if (zerop (length file)) ;nil or "". |
322 |
(prog1 "" (setq dirname nil)) ;Could be `dirname' iso "". |
(prog1 "" (setq dirname nil)) ;Could be `dirname' iso "". |
323 |
file) |
file) |
324 |
extra-string))) |
extra-string))) |
325 |
(when (zerop n) |
(when (zerop n) |