Bug fix for vc-dispatcher split.
[bpt/emacs.git] / lisp / uniquify.el
index 24b49a9..03e54b5 100644 (file)
@@ -1,7 +1,7 @@
 ;;; uniquify.el --- unique buffer names dependent on file name
 
 ;; Copyright (C) 1989, 1995, 1996, 1997, 2001, 2002, 2003,
-;;   2004, 2005, 2006 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Dick King <king@reasoning.com>
 ;; Maintainer: FSF
@@ -12,7 +12,7 @@
 
 ;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -72,7 +72,7 @@
 ;; Add uniquify-list-buffers-directory-modes
 ;;   Stefan Monnier <monnier@cs.yale.edu> 17 Nov 2000
 ;; Algorithm and data structure changed to reduce consing with lots of buffers
-;;   Francesco Potortì <pot@gnu.org> (ideas by rms and monnier) 2001-07-18
+;;   Francesco Potortì <pot@gnu.org> (ideas by rms and monnier) 2001-07-18
 
 ;; Valuable feedback was provided by
 ;; Paul Smith <psmith@baynetworks.com>,
@@ -95,7 +95,7 @@
 
 
 (defcustom uniquify-buffer-name-style nil
-  "*If non-nil, buffer names are uniquified with parts of directory name.
+  "If non-nil, buffer names are uniquified with parts of directory name.
 The value determines the buffer name style and is one of `forward',
 `reverse', `post-forward', or `post-forward-angle-brackets'.
 For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
@@ -104,7 +104,9 @@ would have the following buffer names in the various styles:
   reverse        name\\mumble\\bar  name\\mumble\\quux
   post-forward   name|bar/mumble  name|quux/mumble
   post-forward-angle-brackets   name<bar/mumble>  name<quux/mumble>
-  nil            name  name<2>"
+  nil            name  name<2>
+Of course, the \"mumble\" part may be stripped as well, depending on the setting
+of `uniquify-strip-common-suffix'."
   :type '(radio (const forward)
                (const reverse)
                (const post-forward)
@@ -119,7 +121,7 @@ would have the following buffer names in the various styles:
   :group 'uniquify)
 
 (defcustom uniquify-ask-about-buffer-names-p nil
-  "*If non-nil, permit user to choose names for buffers with same base file.
+  "If non-nil, permit user to choose names for buffers with same base file.
 If the user chooses to name a buffer, uniquification is preempted and no
 other buffer names are changed."
   :type 'boolean
@@ -127,7 +129,7 @@ other buffer names are changed."
 
 ;; The default value matches certain Gnus buffers.
 (defcustom uniquify-ignore-buffers-re nil
-  "*Regular expression matching buffer names that should not be uniquified.
+  "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
 visited file name isn't the same as that of the buffer."
@@ -135,12 +137,12 @@ visited file name isn't the same as that of the buffer."
   :group 'uniquify)
 
 (defcustom uniquify-min-dir-content 0
-  "*Minimum number of directory name components included in buffer name."
+  "Minimum number of directory name components included in buffer name."
   :type 'integer
   :group 'uniquify)
 
 (defcustom uniquify-separator nil
-  "*String separator for buffer name components.
+  "String separator for buffer name components.
 When `uniquify-buffer-name-style' is `post-forward', separates
 base file name from directory part in buffer names (default \"|\").
 When `uniquify-buffer-name-style' is `reverse', separates all
@@ -149,7 +151,7 @@ file name components (default \"\\\")."
   :group 'uniquify)
 
 (defcustom uniquify-trailing-separator-p nil
-  "*If non-nil, add a file name separator to dired buffer names.
+  "If non-nil, add a file name separator to dired buffer names.
 If `uniquify-buffer-name-style' is `forward', add the separator at the end;
 if it is `reverse', add the separator at the beginning; otherwise, this
 variable is ignored."
@@ -189,6 +191,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)
@@ -233,6 +242,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
@@ -255,7 +272,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
           (directory-file-name filename))))))))
 
 (defun uniquify-rerationalize-w/o-cb (fix-list)
-  "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer."
+  "Re-rationalize the buffers in FIX-LIST, but ignoring `current-buffer'."
   (let ((new-fix-list nil))
     (dolist (item fix-list)
       (let ((buf (uniquify-item-buffer item)))
@@ -312,7 +329,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
@@ -411,6 +428,23 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 
 ;;; Hooks from the rest of Emacs
 
+;; 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-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 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
@@ -448,28 +482,24 @@ 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)