/[emacs]/emacs/lisp/uniquify.el
ViewVC logotype

Diff of /emacs/lisp/uniquify.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.42 by monnier, Sun May 4 21:30:25 2003 UTC revision 1.43 by monnier, Mon May 5 16:55:38 2003 UTC
# Line 109  would have the following buffer names in Line 109  would have the following buffer names in
109                  (const post-forward)                  (const post-forward)
110                  (const post-forward-angle-brackets)                  (const post-forward-angle-brackets)
111                  (const :tag "standard Emacs behavior (nil)" nil))                  (const :tag "standard Emacs behavior (nil)" nil))
112    :require 'uniquify    :require 'uniquify)
   :group 'uniquify)  
113    
114  (defcustom uniquify-after-kill-buffer-p nil  (defcustom uniquify-after-kill-buffer-p nil
115    "*If non-nil, rerationalize buffer names after a buffer has been killed.    "*If non-nil, rerationalize buffer names after a buffer has been killed.
116  This can be dangerous if Emacs Lisp code is keeping track of buffers by their  This can be dangerous if Emacs Lisp code is keeping track of buffers by their
117  names (rather than keeping pointers to the buffers themselves)."  names (rather than keeping pointers to the buffers themselves)."
118    :type 'boolean    :type 'boolean)
   :group 'uniquify)  
119    
120  (defcustom uniquify-ask-about-buffer-names-p nil  (defcustom uniquify-ask-about-buffer-names-p nil
121    "*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.
122  If the user chooses to name a buffer, uniquification is preempted and no  If the user chooses to name a buffer, uniquification is preempted and no
123  other buffer names are changed."  other buffer names are changed."
124    :type 'boolean    :type 'boolean)
   :group 'uniquify)  
125    
126  ;; The default value matches certain Gnus buffers.  ;; The default value matches certain Gnus buffers.
127  (defcustom uniquify-ignore-buffers-re "^\\*\\(un\\)?sent "  (defcustom uniquify-ignore-buffers-re "^\\*\\(un\\)?sent "
# Line 132  other buffer names are changed." Line 129  other buffer names are changed."
129  For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename  For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename
130  draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the  draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the
131  visited file name isn't the same as that of the buffer."  visited file name isn't the same as that of the buffer."
132    :type '(choice (const :tag "Uniquify all buffers" nil) regexp)    :type '(choice (const :tag "Uniquify all buffers" nil) regexp))
   :group 'uniquify)  
133    
134  (defcustom uniquify-min-dir-content 0  (defcustom uniquify-min-dir-content 0
135    "*Minimum number of directory name components included in buffer name."    "*Minimum number of directory name components included in buffer name."
136    :type 'integer    :type 'integer)
   :group 'uniquify)  
137    
138  (defcustom uniquify-separator nil  (defcustom uniquify-separator nil
139    "*String separator for buffer name components.    "*String separator for buffer name components.
# Line 146  When `uniquify-buffer-name-style' is `po Line 141  When `uniquify-buffer-name-style' is `po
141  base file name from directory part in buffer names (default \"|\").  base file name from directory part in buffer names (default \"|\").
142  When `uniquify-buffer-name-style' is `reverse', separates all  When `uniquify-buffer-name-style' is `reverse', separates all
143  file name components (default \"\\\")."  file name components (default \"\\\")."
144    :type '(choice (const nil) string)    :type '(choice (const nil) string))
   :group 'uniquify)  
145    
146  (defcustom uniquify-trailing-separator-p nil  (defcustom uniquify-trailing-separator-p nil
147    "*If non-nil, add a file name separator to dired buffer names.    "*If non-nil, add a file name separator to dired buffer names.
148  If `uniquify-buffer-name-style' is `forward', add the separator at the end;  If `uniquify-buffer-name-style' is `forward', add the separator at the end;
149  if it is `reverse', add the separator at the beginning; otherwise, this  if it is `reverse', add the separator at the beginning; otherwise, this
150  variable is ignored."  variable is ignored."
151    :type 'boolean    :type 'boolean)
   :group 'uniquify)  
152    
153  (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode)  (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode)
154    "List of modes for which uniquify should obey `list-buffers-directory'.    "List of modes for which uniquify should obey `list-buffers-directory'.
# Line 164  contains the name of the directory which Line 157  contains the name of the directory which
157    
158  ;;; Utilities  ;;; Utilities
159    
 ;; For directories, return the last component, not the empty string.  
 (defun uniquify-file-name-nondirectory (file-name)  
   (file-name-nondirectory (directory-file-name file-name)))  
   
160  ;; uniquify-fix-list data structure  ;; uniquify-fix-list data structure
161  (defstruct (uniquify-item  (defstruct (uniquify-item
162              (:constructor nil) (:copier nil)              (:constructor nil) (:copier nil)
# Line 185  If `uniquify-min-dir-content' > 0, alway Line 174  If `uniquify-min-dir-content' > 0, alway
174  file name elements.  file name elements.
175  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."
176    (interactive)    (interactive)
177    (let (fix-list    (when newbuffile
178          (newbuffile-nd (and newbuffile      (setq newbuffile (expand-file-name (directory-file-name newbuffile))))
179                              (uniquify-file-name-nondirectory newbuffile))))    (let ((fix-list nil)
180            (base (and newbuffile (file-name-nondirectory newbuffile))))
181      (dolist (buffer (buffer-list))      (dolist (buffer (buffer-list))
182        (let ((bufname (buffer-name buffer))        (let ((bufname (buffer-name buffer))
183              bfn rawname proposed)              bfn rawname)
184          (if (and (not (and uniquify-ignore-buffers-re          (when (and (not (and uniquify-ignore-buffers-re
185                             (string-match uniquify-ignore-buffers-re                               (string-match uniquify-ignore-buffers-re
186                                           bufname)))                                             bufname)))
187                   (setq bfn (if (eq buffer newbuf)                     (setq bfn (if (eq buffer newbuf) newbuffile
188                                 (when newbuffile                                 (uniquify-buffer-file-name buffer)))
189                                   (expand-file-name                     (setq rawname (file-name-nondirectory bfn))
190                                    (directory-file-name newbuffile)))                     (or (null base) (equal rawname base)))
191                               (uniquify-buffer-file-name buffer)))            (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'.
192                   (setq rawname (uniquify-file-name-nondirectory bfn))              (setq bfn (directory-file-name bfn)))    ;Strip trailing slash.
193                   (or (not newbuffile)            (push (uniquify-make-item rawname bfn buffer
194                       (equal rawname newbuffile-nd))                                      (uniquify-get-proposed-name rawname bfn))
195                   (setq proposed (uniquify-get-proposed-name rawname bfn)))                  fix-list))))
             (push (uniquify-make-item rawname bfn buffer proposed) fix-list))))  
196      ;; selects buffers whose names may need changing, and others that      ;; selects buffers whose names may need changing, and others that
197      ;; may conflict, then bring conflicting names together      ;; may conflict, then bring conflicting names together
198      (uniquify-rationalize-a-list fix-list)))      (uniquify-rationalize-a-list fix-list)))
# Line 252  in `uniquify-list-buffers-directory-mode Line 241  in `uniquify-list-buffers-directory-mode
241    
242  (defun uniquify-get-proposed-name (base filename &optional depth)  (defun uniquify-get-proposed-name (base filename &optional depth)
243    (unless depth (setq depth uniquify-min-dir-content))    (unless depth (setq depth uniquify-min-dir-content))
244    (assert (equal base (uniquify-file-name-nondirectory filename)))    (assert (equal (directory-file-name filename) filename))  ;No trailing slash.
   (assert (equal (directory-file-name filename) filename))  
245    
246    ;; Distinguish directories by adding extra separator.    ;; Distinguish directories by adding extra separator.
247    (if (and uniquify-trailing-separator-p    (if (and uniquify-trailing-separator-p
248             (file-directory-p filename)             (file-directory-p (expand-file-name base filename))
249             (not (string-equal base "")))             (not (string-equal base "")))
250        (cond ((eq uniquify-buffer-name-style 'forward)        (cond ((eq uniquify-buffer-name-style 'forward)
251               (setq base (file-name-as-directory base)))               (setq base (file-name-as-directory base)))
# Line 267  in `uniquify-list-buffers-directory-mode Line 255  in `uniquify-list-buffers-directory-mode
255    
256    (let ((extra-string nil)    (let ((extra-string nil)
257          (n depth))          (n depth))
258      (while (and (> n 0) filename      (while (and (> n 0) filename)
                 (setq filename (file-name-directory filename))  
                 (setq filename (directory-file-name filename)))  
259        (let ((file (file-name-nondirectory filename)))        (let ((file (file-name-nondirectory filename)))
260            (when (setq filename (file-name-directory filename))
261              (setq filename (directory-file-name filename)))
262          (setq n (1- n))          (setq n (1- n))
263          (push (if (zerop (length file)) ;nil or "".          (push (if (zerop (length file)) ;nil or "".
264                    (prog1 "" (setq filename nil)) ;Could be `filename' iso "".                    (prog1 "" (setq filename nil)) ;Could be `filename' iso "".
# Line 278  in `uniquify-list-buffers-directory-mode Line 266  in `uniquify-list-buffers-directory-mode
266                extra-string)))                extra-string)))
267      (when (zerop n)      (when (zerop n)
268        (if (and filename extra-string        (if (and filename extra-string
269                 (setq filename (file-name-directory filename))                 (equal filename (file-name-directory filename)))
                (equal filename  
                       (file-name-directory (directory-file-name filename))))  
270            ;; We're just before the root.  Let's add the leading / already.            ;; We're just before the root.  Let's add the leading / already.
271            ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with            ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with
272            ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b".            ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b".

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26