167 |
(defvar uniquify-possibly-resolvable nil) |
(defvar uniquify-possibly-resolvable nil) |
168 |
|
|
169 |
(defvar uniquify-managed nil |
(defvar uniquify-managed nil |
170 |
"Non-nil if the name of this buffer is managed by uniquify.") |
"Non-nil if the name of this buffer is managed by uniquify. |
171 |
|
It actually holds the list of `uniquify-item's corresponding to the conflict.") |
172 |
(make-variable-buffer-local 'uniquify-managed) |
(make-variable-buffer-local 'uniquify-managed) |
173 |
(put 'uniquify-managed 'permanent-local t) |
(put 'uniquify-managed 'permanent-local t) |
174 |
|
|
175 |
;;; Main entry point. |
;;; Main entry point. |
176 |
|
|
177 |
(defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf) |
(defun uniquify-rationalize-file-buffer-names (newbuffile newbuf) |
178 |
"Make file buffer names unique by adding segments from file name. |
"Make file buffer names unique by adding segments from file name. |
179 |
If `uniquify-min-dir-content' > 0, always pulls that many |
If `uniquify-min-dir-content' > 0, always pulls that many |
180 |
file name elements. |
file name elements. |
181 |
Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." |
Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." |
182 |
(interactive) |
(interactive) |
183 |
(when newbuffile |
(setq newbuffile (expand-file-name (directory-file-name newbuffile))) |
|
(setq newbuffile (expand-file-name (directory-file-name newbuffile)))) |
|
184 |
(let ((fix-list nil) |
(let ((fix-list nil) |
185 |
(base (and newbuffile (file-name-nondirectory newbuffile)))) |
(base (file-name-nondirectory newbuffile))) |
186 |
(dolist (buffer (buffer-list)) |
(dolist (buffer (buffer-list)) |
187 |
(let ((bufname (buffer-name buffer)) |
(let ((bufname (buffer-name buffer)) |
188 |
bfn rawname) |
bfn) |
189 |
(when (and (not (and uniquify-ignore-buffers-re |
(when (and (not (and uniquify-ignore-buffers-re |
190 |
(string-match uniquify-ignore-buffers-re |
(string-match uniquify-ignore-buffers-re |
191 |
bufname))) |
bufname))) |
194 |
(eq buffer newbuf)) |
(eq buffer newbuf)) |
195 |
(setq bfn (if (eq buffer newbuf) newbuffile |
(setq bfn (if (eq buffer newbuf) newbuffile |
196 |
(uniquify-buffer-file-name buffer))) |
(uniquify-buffer-file-name buffer))) |
197 |
(setq rawname (file-name-nondirectory bfn)) |
(equal (file-name-nondirectory bfn) base)) |
|
(or (null base) (equal rawname base))) |
|
198 |
(when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. |
(when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. |
199 |
(setq bfn (directory-file-name bfn))) ;Strip trailing slash. |
(setq bfn (directory-file-name bfn))) ;Strip trailing slash. |
200 |
(push (uniquify-make-item rawname bfn buffer |
(push (uniquify-make-item base bfn buffer |
201 |
(uniquify-get-proposed-name rawname bfn)) |
(uniquify-get-proposed-name base bfn)) |
202 |
fix-list)))) |
fix-list)))) |
|
;; Mark the new buffer as managed. |
|
|
(when newbuf |
|
|
(with-current-buffer newbuf |
|
|
(setq uniquify-managed t))) |
|
203 |
;; selects buffers whose names may need changing, and others that |
;; selects buffers whose names may need changing, and others that |
204 |
;; may conflict, then bring conflicting names together |
;; may conflict, then bring conflicting names together |
205 |
(uniquify-rationalize-a-list fix-list))) |
(uniquify-rationalize fix-list))) |
206 |
|
|
207 |
;; uniquify's version of buffer-file-name; result never contains trailing slash |
;; uniquify's version of buffer-file-name; result never contains trailing slash |
208 |
(defun uniquify-buffer-file-name (buffer) |
(defun uniquify-buffer-file-name (buffer) |
224 |
(car dired-directory) |
(car dired-directory) |
225 |
dired-directory))))))))) |
dired-directory))))))))) |
226 |
|
|
227 |
|
(defun uniquify-rerationalize-w/o-cb (fix-list) |
228 |
|
"Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." |
229 |
|
(let ((new-fix-list nil)) |
230 |
|
(dolist (item fix-list) |
231 |
|
(let ((buf (uniquify-item-buffer item))) |
232 |
|
(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)))) |
238 |
|
(when new-fix-list |
239 |
|
(uniquify-rationalize new-fix-list)))) |
240 |
|
|
241 |
|
(defun uniquify-rationalize (fix-list) |
242 |
|
;; Set up uniquify to re-rationalize after killing/renaming |
243 |
|
;; if there is a conflict. |
244 |
|
(dolist (fix fix-list) |
245 |
|
(with-current-buffer (uniquify-item-buffer fix) |
246 |
|
(setq uniquify-managed fix-list))) |
247 |
|
;; If uniquify-min-dir-content is 0, this will end up just |
248 |
|
;; passing fix-list to uniquify-rationalize-conflicting-sublist. |
249 |
|
(uniquify-rationalize-a-list fix-list)) |
250 |
|
|
251 |
(defun uniquify-item-greaterp (item1 item2) |
(defun uniquify-item-greaterp (item1 item2) |
252 |
(string-lessp (uniquify-item-proposed item2) |
(string-lessp (uniquify-item-proposed item2) |
253 |
(uniquify-item-proposed item1))) |
(uniquify-item-proposed item1))) |
375 |
|
|
376 |
(defadvice rename-buffer (after rename-buffer-uniquify activate) |
(defadvice rename-buffer (after rename-buffer-uniquify activate) |
377 |
"Uniquify buffer names with parts of directory name." |
"Uniquify buffer names with parts of directory name." |
378 |
|
(uniquify-maybe-rerationalize-w/o-cb) |
379 |
(if (null (ad-get-arg 1)) ; no UNIQUE argument. |
(if (null (ad-get-arg 1)) ; no UNIQUE argument. |
380 |
;; Mark this buffer so it won't be renamed by uniquify. |
;; Mark this buffer so it won't be renamed by uniquify. |
381 |
(setq uniquify-managed nil) |
(setq uniquify-managed nil) |
382 |
(when uniquify-buffer-name-style |
(when uniquify-buffer-name-style |
383 |
(if uniquify-after-kill-buffer-p |
;; Rerationalize w.r.t the new name. |
384 |
;; call with no argument; rationalize vs. old name as well as new |
(uniquify-rationalize-file-buffer-names |
385 |
(progn (setq uniquify-managed t) |
(uniquify-buffer-file-name (current-buffer)) (current-buffer)) |
|
(uniquify-rationalize-file-buffer-names)) |
|
|
;; call with argument: rationalize vs. new name only |
|
|
(uniquify-rationalize-file-buffer-names |
|
|
(uniquify-buffer-file-name (current-buffer)) (current-buffer))) |
|
386 |
(setq ad-return-value (buffer-name (current-buffer)))))) |
(setq ad-return-value (buffer-name (current-buffer)))))) |
387 |
|
|
388 |
(defadvice create-file-buffer (after create-file-buffer-uniquify activate) |
(defadvice create-file-buffer (after create-file-buffer-uniquify activate) |
401 |
;; (This ought to set some global variables so the work is done only for |
;; (This ought to set some global variables so the work is done only for |
402 |
;; buffers with names similar to the deleted buffer. -MDE) |
;; buffers with names similar to the deleted buffer. -MDE) |
403 |
|
|
404 |
(defun uniquify-delay-rationalize-file-buffer-names () |
(defun uniquify-maybe-rerationalize-w/o-cb () |
405 |
"Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. |
"Re-rationalize buffer names, ignoring current buffer. |
406 |
For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." |
For use on `kill-buffer-hook'." |
407 |
(if (and uniquify-managed |
(if (and (cdr uniquify-managed) |
408 |
uniquify-buffer-name-style |
uniquify-buffer-name-style |
409 |
uniquify-after-kill-buffer-p |
uniquify-after-kill-buffer-p) |
410 |
;; Rationalizing is costly, so don't do it for temp buffers. |
(uniquify-rerationalize-w/o-cb uniquify-managed))) |
|
(uniquify-buffer-file-name (current-buffer))) |
|
|
(add-hook 'post-command-hook |
|
|
'uniquify-delayed-rationalize-file-buffer-names))) |
|
|
|
|
|
(defun uniquify-delayed-rationalize-file-buffer-names () |
|
|
"Rerationalize buffer names and remove self from `post-command-hook'. |
|
|
See also `delay-rationalize-file-buffer-names' for hook setter." |
|
|
(uniquify-rationalize-file-buffer-names) |
|
|
(remove-hook 'post-command-hook |
|
|
'uniquify-delayed-rationalize-file-buffer-names)) |
|
411 |
|
|
412 |
;; Ideally we'd like to add it buffer-locally, but that doesn't work |
;; Ideally we'd like to add it buffer-locally, but that doesn't work |
413 |
;; because kill-buffer-hook is not permanent-local :-( |
;; because kill-buffer-hook is not permanent-local :-( |
414 |
(add-hook 'kill-buffer-hook 'uniquify-delay-rationalize-file-buffer-names) |
(add-hook 'kill-buffer-hook 'uniquify-maybe-rerationalize-w/o-cb) |
415 |
|
|
416 |
(provide 'uniquify) |
(provide 'uniquify) |
417 |
;;; uniquify.el ends here |
;;; uniquify.el ends here |