X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8f924df7df019cce90537647de2627581043b5c4..c5ca3aa00840c5dfa0aa7eeb8483ea077e5577bc:/lisp/uniquify.el diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 656f5c3708..e894127cdb 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,18 +1,19 @@ ;;; uniquify.el --- unique buffer names dependent on file name -;; Copyright (c) 1989,95,96,97,2001,2003 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1995-1997, 2001-2011 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 @@ -20,9 +21,7 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -71,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 , @@ -89,12 +88,12 @@ ;;; User-visible variables (defgroup uniquify nil - "Unique buffer names dependent on file name" - :group 'applications) + "Unique buffer names dependent on file name." + :group 'files) (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' @@ -103,50 +102,59 @@ 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 name - 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) (const post-forward-angle-brackets) (const :tag "standard Emacs behavior (nil)" nil)) - :require 'uniquify) + :require 'uniquify + :group 'uniquify) (defcustom uniquify-after-kill-buffer-p t "If non-nil, rerationalize buffer names after a buffer has been killed." - :type 'boolean) + :type 'boolean + :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) + :type 'boolean + :group 'uniquify) ;; 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." - :type '(choice (const :tag "Uniquify all buffers" nil) regexp)) + :type '(choice (const :tag "Uniquify all buffers" nil) regexp) + :group 'uniquify) (defcustom uniquify-min-dir-content 0 - "*Minimum number of directory name components included in buffer name." - :type 'integer) + "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 file name components (default \"\\\")." - :type '(choice (const nil) string)) + :type '(choice (const nil) string) + :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." - :type 'boolean) + :type 'boolean + :group 'uniquify) (defcustom uniquify-strip-common-suffix ;; Using it when uniquify-min-dir-content>0 doesn't make much sense. @@ -155,9 +163,10 @@ variable is ignored." 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) + :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.") @@ -180,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) @@ -187,10 +203,16 @@ It actually holds the list of `uniquify-item's corresponding to the conflict.") If `uniquify-min-dir-content' > 0, always pulls that many file name elements. Arguments BASE, DIRNAME, and NEWBUF specify the new buffer that causes -this rationaliztion." - (interactive) - (if (null dirname) - (with-current-buffer newbuf (setq uniquify-managed nil)) +this rationalization." + (interactive + (list (if uniquify-managed + (uniquify-item-base (car uniquify-managed)) (buffer-name)) + (uniquify-buffer-file-name (current-buffer)) + (current-buffer))) + ;; Make sure we don't get confused by outdated uniquify-managed info in + ;; this buffer. + (with-current-buffer newbuf (setq uniquify-managed nil)) + (when dirname (setq dirname (expand-file-name (directory-file-name dirname))) (let ((fix-list (list (uniquify-make-item base dirname newbuf))) items) @@ -218,6 +240,14 @@ this rationaliztion." (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 @@ -240,7 +270,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))) @@ -297,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 @@ -330,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) @@ -396,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 @@ -433,28 +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) + ;;; uniquify.el ends here