[Emacs-diffs] Changes to emacs/lisp/uniquify.el

[Stefan Monnier]

Index: emacs/lisp/uniquify.el
diff -c emacs/lisp/uniquify.el:1.47 emacs/lisp/uniquify.el:1.48
*** emacs/lisp/uniquify.el:1.47 Wed May  7 17:56:43 2003
--- emacs/lisp/uniquify.el      Thu May  8 15:39:32 2003
***************
*** 112,120 ****
    :require 'uniquify)
  
  (defcustom uniquify-after-kill-buffer-p nil
!   "*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)."
    :type 'boolean)
  
  (defcustom uniquify-ask-about-buffer-names-p nil
--- 112,118 ----
    :require 'uniquify)
  
  (defcustom uniquify-after-kill-buffer-p nil
!   "If non-nil, rerationalize buffer names after a buffer has been killed."
    :type 'boolean)
  
  (defcustom uniquify-ask-about-buffer-names-p nil
***************
*** 150,155 ****
--- 148,162 ----
  variable is ignored."
    :type 'boolean)
  
+ (defcustom uniquify-strip-common-suffix
+   ;; Using it when uniquify-min-dir-content>0 doesn't make much sense.
+   (eq 0 uniquify-min-dir-content)
+   "If non-nil, strip common directory suffixes of conflicting files.
+ 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)
+ 
  (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-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'
***************
*** 160,166 ****
  ;; uniquify-fix-list data structure
  (defstruct (uniquify-item
            (:constructor nil) (:copier nil)
!           (:constructor uniquify-make-item (base dirname buffer proposed)))
    base dirname buffer proposed)
  
  ;; Internal variables used free
--- 167,174 ----
  ;; uniquify-fix-list data structure
  (defstruct (uniquify-item
            (:constructor nil) (:copier nil)
!           (:constructor uniquify-make-item
!            (base dirname buffer &optional proposed)))
    base dirname buffer proposed)
  
  ;; Internal variables used free
***************
*** 199,206 ****
                     (equal (file-name-nondirectory bfn) base))
            (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'.
              (setq bfn (directory-file-name bfn)))    ;Strip trailing slash.
!           (push (uniquify-make-item base bfn buffer
!                                     (uniquify-get-proposed-name base bfn))
                  fix-list))))
        ;; selects buffers whose names may need changing, and others that
        ;; may conflict, then bring conflicting names together
--- 207,213 ----
                     (equal (file-name-nondirectory bfn) base))
            (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'.
              (setq bfn (directory-file-name bfn)))    ;Strip trailing slash.
!           (push (uniquify-make-item base bfn buffer)
                  fix-list))))
        ;; selects buffers whose names may need changing, and others that
        ;; may conflict, then bring conflicting names together
***************
*** 213,230 ****
  in `uniquify-list-buffers-directory-modes', otherwise returns nil."
    (or (buffer-file-name buffer)
        (with-current-buffer buffer
!       (and
!        (memq major-mode uniquify-list-buffers-directory-modes)
!        (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this
!            (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)))))))))
  
  (defun uniquify-rerationalize-w/o-cb (fix-list)
    "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer."
--- 220,228 ----
  in `uniquify-list-buffers-directory-modes', otherwise returns nil."
    (or (buffer-file-name buffer)
        (with-current-buffer buffer
!       (if (memq major-mode uniquify-list-buffers-directory-modes)
!           (and list-buffers-directory
!                (directory-file-name list-buffers-directory))))))
  
  (defun uniquify-rerationalize-w/o-cb (fix-list)
    "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer."
***************
*** 243,251 ****
  (defun uniquify-rationalize (fix-list)
    ;; Set up uniquify to re-rationalize after killing/renaming
    ;; if there is a conflict.
!   (dolist (fix fix-list)
!     (with-current-buffer (uniquify-item-buffer fix)
        (setq uniquify-managed fix-list)))
    ;; If uniquify-min-dir-content is 0, this will end up just
    ;; passing fix-list to uniquify-rationalize-conflicting-sublist.
    (uniquify-rationalize-a-list fix-list))
--- 241,276 ----
  (defun uniquify-rationalize (fix-list)
    ;; Set up uniquify to re-rationalize after killing/renaming
    ;; if there is a conflict.
!   (dolist (item fix-list)
!     (with-current-buffer (uniquify-item-buffer item)
!       ;; Reset the proposed names.
!       (setf (uniquify-item-proposed item)
!           (uniquify-get-proposed-name (uniquify-item-base item)
!                                       (uniquify-item-dirname item)))
        (setq uniquify-managed fix-list)))
+   ;; Strip any shared last directory names of the dirname.
+   (when (and (cdr fix-list) uniquify-strip-common-suffix)
+     (let ((strip t))
+       (while (let* ((base (file-name-nondirectory
+                          (uniquify-item-dirname (car fix-list))))
+                   (items fix-list))
+              (when (> (length base) 0)
+                (while (and strip items)
+                  (unless (equal base (file-name-nondirectory
+                                       (uniquify-item-dirname (pop items))))
+                    (setq strip nil)))
+                strip))
+       ;; It's all the same => strip.
+       (dolist (item (prog1 fix-list (setq fix-list nil)))
+         ;; Create new items because the old ones are kept (with the true
+         ;; `dirname') for later rerationalizing.
+         (push (uniquify-make-item (uniquify-item-base item)
+                                   (let ((f (file-name-directory
+                                             (uniquify-item-dirname item))))
+                                     (and f (directory-file-name f)))
+                                   (uniquify-item-buffer item)
+                                   (uniquify-item-proposed item))
+               fix-list)))))
    ;; If uniquify-min-dir-content is 0, this will end up just
    ;; passing fix-list to uniquify-rationalize-conflicting-sublist.
    (uniquify-rationalize-a-list fix-list))
***************
*** 274,280 ****
  
  (defun uniquify-get-proposed-name (base dirname &optional depth)
    (unless depth (setq depth uniquify-min-dir-content))
!   (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
  
    ;; Distinguish directories by adding extra separator.
    (if (and uniquify-trailing-separator-p
--- 299,305 ----
  
  (defun uniquify-get-proposed-name (base dirname &optional depth)
    (unless depth (setq depth uniquify-min-dir-content))
!   (assert (equal (directory-file-name dirname) dirname))  ;No trailing slash.
  
    ;; Distinguish directories by adding extra separator.
    (if (and uniquify-trailing-separator-p
***************
*** 294,300 ****
          (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 "".
                file)
              extra-string)))
      (when (zerop n)
--- 319,325 ----
          (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 "".
                file)
              extra-string)))
      (when (zerop n)