X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fec99105e2cb5ff47aa3c71c55eda771dc9c5eb2..758c81e87ded2bad9f5a5a6683fb498965eb508c:/lisp/uniquify.el diff --git a/lisp/uniquify.el b/lisp/uniquify.el index c8bbd9256b..520c4b847d 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,19 +1,19 @@ -;;; uniquify.el --- unique buffer names dependent on file name +;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*- -;; Copyright (C) 1989, 1995, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1995-1997, 2001-2012 Free Software Foundation, Inc. ;; Author: Dick King ;; Maintainer: FSF ;; Keywords: files ;; Created: 15 May 86 +;; Package: emacs ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,14 +21,12 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Emacs's standard method for making buffer names unique adds <2>, <3>, -;; etc.. to the end of (all but one of) the buffers. This file replaces +;; etc. to the end of (all but one of) the buffers. This file replaces ;; that behavior, for buffers visiting files and dired buffers, with a ;; uniquification that adds parts of the file name until the buffer names ;; are unique. For instance, buffers visiting /u/mernst/tmp/Makefile and @@ -72,7 +70,7 @@ ;; Add uniquify-list-buffers-directory-modes ;; Stefan Monnier 17 Nov 2000 ;; Algorithm and data structure changed to reduce consing with lots of buffers -;; Francesco Potortì (ideas by rms and monnier) 2001-07-18 +;; Francesco Potortì (ideas by rms and monnier) 2001-07-18 ;; Valuable feedback was provided by ;; Paul Smith , @@ -91,7 +89,7 @@ (defgroup uniquify nil "Unique buffer names dependent on file name." - :group 'applications) + :group 'files) (defcustom uniquify-buffer-name-style nil @@ -168,7 +166,7 @@ This can be handy when you have deep parallel hierarchies." :type 'boolean :group 'uniquify) -(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) +(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode vc-dir-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' contains the name of the directory which the buffer is visiting.") @@ -191,6 +189,13 @@ It actually holds the list of `uniquify-item's corresponding to the conflict.") (make-variable-buffer-local 'uniquify-managed) (put 'uniquify-managed 'permanent-local t) +;; Used in desktop.el to save the non-uniquified buffer name +(defun uniquify-buffer-base-name () + "Return the base name of the current buffer. +Return nil if the buffer is not managed by uniquify." + (and uniquify-managed + (uniquify-item-base (car uniquify-managed)))) + ;;; Main entry point. (defun uniquify-rationalize-file-buffer-names (base dirname newbuf) @@ -235,6 +240,14 @@ this rationalization." (with-current-buffer (uniquify-item-buffer (car items)) (setq uniquify-managed nil)) (setq items nil))) + ;; In case we missed some calls to kill-buffer, there may be dead + ;; buffers in uniquify-managed, so filter them out. + (setq items + (delq nil (mapcar + (lambda (item) + (if (buffer-live-p (uniquify-item-buffer item)) + item)) + items))) (setq fix-list (append fix-list items)))) ;; selects buffers whose names may need changing, and others that ;; may conflict, then bring conflicting names together @@ -314,7 +327,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." proposed) ;; Divide fix-list into items with same proposed names and pass them ;; to uniquify-rationalize-conflicting-sublist. - (dolist (item (sort fix-list 'uniquify-item-greaterp)) + (dolist (item (sort (copy-sequence fix-list) 'uniquify-item-greaterp)) (setq proposed (uniquify-item-proposed item)) (unless (equal proposed old-proposed) (uniquify-rationalize-conflicting-sublist conflicting-sublist @@ -347,7 +360,8 @@ 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 (or (file-remote-p dirname) "") + (setq dirname nil)) ;Could be `dirname' iso "". file) extra-string))) (when (zerop n) @@ -413,6 +427,28 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." ;;; Hooks from the rest of Emacs +(defun uniquify-maybe-rerationalize-w/o-cb () + "Re-rationalize buffer names, ignoring current buffer." + (and (cdr uniquify-managed) + uniquify-buffer-name-style + (uniquify-rerationalize-w/o-cb uniquify-managed))) + +;; Buffer deletion +;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. +;; This mechanism uses `kill-buffer-hook', which runs *before* deletion, so +;; it calls `uniquify-rerationalize-w/o-cb' to rerationalize the buffer list +;; ignoring the current buffer (which is going to be deleted anyway). +(defun uniquify-kill-buffer-function () + "Re-rationalize buffer names, ignoring current buffer. +For use on `kill-buffer-hook'." + (and uniquify-after-kill-buffer-p + (uniquify-maybe-rerationalize-w/o-cb))) + +;; Ideally we'd like to add it buffer-locally, but that doesn't work +;; because kill-buffer-hook is not permanent-local :-( +;; FIXME kill-buffer-hook _is_ permanent-local in 22+. +(add-hook 'kill-buffer-hook 'uniquify-kill-buffer-function) + ;; The logical place to put all this code is in generate-new-buffer-name. ;; It's written in C, so we would add a generate-new-buffer-name-function ;; which, if non-nil, would be called instead of the C. One problem with @@ -450,30 +486,25 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (file-name-nondirectory filename) (file-name-directory filename) ad-return-value)))) -;; Buffer deletion -;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. -;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. -;; That means that the kill-buffer-hook function cannot just delete the -;; buffer -- it has to set something to do the rationalization *later*. -;; It actually puts another function on `post-command-hook'. This other -;; function runs the rationalization and then removes itself from the hook. -;; Is there a better way to accomplish this? -;; (This ought to set some global variables so the work is done only for -;; buffers with names similar to the deleted buffer. -MDE) - -(defun uniquify-maybe-rerationalize-w/o-cb () - "Re-rationalize buffer names, ignoring current buffer. -For use on `kill-buffer-hook'." - (if (and (cdr uniquify-managed) - uniquify-buffer-name-style - uniquify-after-kill-buffer-p) - (uniquify-rerationalize-w/o-cb uniquify-managed))) - -;; Ideally we'd like to add it buffer-locally, but that doesn't work -;; because kill-buffer-hook is not permanent-local :-( -(add-hook 'kill-buffer-hook 'uniquify-maybe-rerationalize-w/o-cb) +;;; The End + +(defun uniquify-unload-function () + "Unload the uniquify library." + (save-current-buffer + (let ((buffers nil)) + (dolist (buf (buffer-list)) + (set-buffer buf) + (when uniquify-managed + (push (cons buf (uniquify-item-base (car uniquify-managed))) buffers))) + (dolist (fun '(rename-buffer create-file-buffer)) + (ad-remove-advice fun 'after (intern (concat (symbol-name fun) "-uniquify"))) + (ad-update fun)) + (dolist (buf buffers) + (set-buffer (car buf)) + (rename-buffer (cdr buf) t)))) + ;; continue standard unloading + nil) (provide 'uniquify) -;; arch-tag: e763faa3-56c9-4903-8eb8-26e1c45a0065 ;;; uniquify.el ends here