/[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.45 by monnier, Wed May 7 15:53:08 2003 UTC revision 1.46 by monnier, Wed May 7 16:03:14 2003 UTC
# Line 167  contains the name of the directory which Line 167  contains the name of the directory which
167  (defvar uniquify-possibly-resolvable nil)  (defvar uniquify-possibly-resolvable nil)
168    
169  (defvar uniquify-managed nil  (defvar uniquify-managed nil
170    "Non-nil if the name of this buffer is managed by uniquify.")    "Non-nil if the name of this buffer is managed by uniquify.
171    It actually holds the list of `uniquify-item's corresponding to the conflict.")
172  (make-variable-buffer-local 'uniquify-managed)  (make-variable-buffer-local 'uniquify-managed)
173  (put 'uniquify-managed 'permanent-local t)  (put 'uniquify-managed 'permanent-local t)
174    
175  ;;; Main entry point.  ;;; Main entry point.
176    
177  (defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf)  (defun uniquify-rationalize-file-buffer-names (newbuffile newbuf)
178    "Make file buffer names unique by adding segments from file name.    "Make file buffer names unique by adding segments from file name.
179  If `uniquify-min-dir-content' > 0, always pulls that many  If `uniquify-min-dir-content' > 0, always pulls that many
180  file name elements.  file name elements.
181  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."
182    (interactive)    (interactive)
183    (when newbuffile    (setq newbuffile (expand-file-name (directory-file-name newbuffile)))
     (setq newbuffile (expand-file-name (directory-file-name newbuffile))))  
184    (let ((fix-list nil)    (let ((fix-list nil)
185          (base (and newbuffile (file-name-nondirectory newbuffile))))          (base (file-name-nondirectory newbuffile)))
186      (dolist (buffer (buffer-list))      (dolist (buffer (buffer-list))
187        (let ((bufname (buffer-name buffer))        (let ((bufname (buffer-name buffer))
188              bfn rawname)              bfn)
189          (when (and (not (and uniquify-ignore-buffers-re          (when (and (not (and uniquify-ignore-buffers-re
190                               (string-match uniquify-ignore-buffers-re                               (string-match uniquify-ignore-buffers-re
191                                             bufname)))                                             bufname)))
# Line 194  Arguments NEWBUFFILE and NEWBUF cause on Line 194  Arguments NEWBUFFILE and NEWBUF cause on
194                         (eq buffer newbuf))                         (eq buffer newbuf))
195                     (setq bfn (if (eq buffer newbuf) newbuffile                     (setq bfn (if (eq buffer newbuf) newbuffile
196                                 (uniquify-buffer-file-name buffer)))                                 (uniquify-buffer-file-name buffer)))
197                     (setq rawname (file-name-nondirectory bfn))                     (equal (file-name-nondirectory bfn) base))
                    (or (null base) (equal rawname base)))  
198            (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'.            (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'.
199              (setq bfn (directory-file-name bfn)))    ;Strip trailing slash.              (setq bfn (directory-file-name bfn)))    ;Strip trailing slash.
200            (push (uniquify-make-item rawname bfn buffer            (push (uniquify-make-item base bfn buffer
201                                      (uniquify-get-proposed-name rawname bfn))                                      (uniquify-get-proposed-name base bfn))
202                  fix-list))))                  fix-list))))
     ;; Mark the new buffer as managed.  
     (when newbuf  
       (with-current-buffer newbuf  
         (setq uniquify-managed t)))  
203      ;; selects buffers whose names may need changing, and others that      ;; selects buffers whose names may need changing, and others that
204      ;; may conflict, then bring conflicting names together      ;; may conflict, then bring conflicting names together
205      (uniquify-rationalize-a-list fix-list)))      (uniquify-rationalize fix-list)))
206    
207  ;; uniquify's version of buffer-file-name; result never contains trailing slash  ;; uniquify's version of buffer-file-name; result never contains trailing slash
208  (defun uniquify-buffer-file-name (buffer)  (defun uniquify-buffer-file-name (buffer)
# Line 229  in `uniquify-list-buffers-directory-mode Line 224  in `uniquify-list-buffers-directory-mode
224                        (car dired-directory)                        (car dired-directory)
225                      dired-directory)))))))))                      dired-directory)))))))))
226    
227    (defun uniquify-rerationalize-w/o-cb (fix-list)
228      "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer."
229      (let ((new-fix-list nil))
230        (dolist (item fix-list)
231          (let ((buf (uniquify-item-buffer item)))
232            (unless (or (eq buf (current-buffer)) (not (buffer-live-p buf)))
233              ;; Reset the proposed names.
234              (setf (uniquify-item-proposed item)
235                    (uniquify-get-proposed-name (uniquify-item-base item)
236                                                (uniquify-item-dirname item)))
237              (push item new-fix-list))))
238        (when new-fix-list
239          (uniquify-rationalize new-fix-list))))
240    
241    (defun uniquify-rationalize (fix-list)
242      ;; Set up uniquify to re-rationalize after killing/renaming
243      ;; if there is a conflict.
244      (dolist (fix fix-list)
245        (with-current-buffer (uniquify-item-buffer fix)
246          (setq uniquify-managed fix-list)))
247      ;; If uniquify-min-dir-content is 0, this will end up just
248      ;; passing fix-list to uniquify-rationalize-conflicting-sublist.
249      (uniquify-rationalize-a-list fix-list))
250    
251  (defun uniquify-item-greaterp (item1 item2)  (defun uniquify-item-greaterp (item1 item2)
252    (string-lessp (uniquify-item-proposed item2)    (string-lessp (uniquify-item-proposed item2)
253                  (uniquify-item-proposed item1)))                  (uniquify-item-proposed item1)))
# Line 356  in `uniquify-list-buffers-directory-mode Line 375  in `uniquify-list-buffers-directory-mode
375    
376  (defadvice rename-buffer (after rename-buffer-uniquify activate)  (defadvice rename-buffer (after rename-buffer-uniquify activate)
377    "Uniquify buffer names with parts of directory name."    "Uniquify buffer names with parts of directory name."
378      (uniquify-maybe-rerationalize-w/o-cb)
379    (if (null (ad-get-arg 1))             ; no UNIQUE argument.    (if (null (ad-get-arg 1))             ; no UNIQUE argument.
380        ;; Mark this buffer so it won't be renamed by uniquify.        ;; Mark this buffer so it won't be renamed by uniquify.
381        (setq uniquify-managed nil)        (setq uniquify-managed nil)
382      (when uniquify-buffer-name-style      (when uniquify-buffer-name-style
383        (if uniquify-after-kill-buffer-p        ;; Rerationalize w.r.t the new name.
384            ;; call with no argument; rationalize vs. old name as well as new        (uniquify-rationalize-file-buffer-names
385            (progn (setq uniquify-managed t)         (uniquify-buffer-file-name (current-buffer)) (current-buffer))
                  (uniquify-rationalize-file-buffer-names))  
         ;; call with argument: rationalize vs. new name only  
         (uniquify-rationalize-file-buffer-names  
          (uniquify-buffer-file-name (current-buffer)) (current-buffer)))  
386        (setq ad-return-value (buffer-name (current-buffer))))))        (setq ad-return-value (buffer-name (current-buffer))))))
387    
388  (defadvice create-file-buffer (after create-file-buffer-uniquify activate)  (defadvice create-file-buffer (after create-file-buffer-uniquify activate)
# Line 385  in `uniquify-list-buffers-directory-mode Line 401  in `uniquify-list-buffers-directory-mode
401  ;; (This ought to set some global variables so the work is done only for  ;; (This ought to set some global variables so the work is done only for
402  ;; buffers with names similar to the deleted buffer.  -MDE)  ;; buffers with names similar to the deleted buffer.  -MDE)
403    
404  (defun uniquify-delay-rationalize-file-buffer-names ()  (defun uniquify-maybe-rerationalize-w/o-cb ()
405    "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.    "Re-rationalize buffer names, ignoring current buffer.
406  For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."  For use on `kill-buffer-hook'."
407    (if (and uniquify-managed    (if (and (cdr uniquify-managed)
408             uniquify-buffer-name-style             uniquify-buffer-name-style
409             uniquify-after-kill-buffer-p             uniquify-after-kill-buffer-p)
410             ;; Rationalizing is costly, so don't do it for temp buffers.        (uniquify-rerationalize-w/o-cb uniquify-managed)))
            (uniquify-buffer-file-name (current-buffer)))  
       (add-hook 'post-command-hook  
                 'uniquify-delayed-rationalize-file-buffer-names)))  
   
 (defun uniquify-delayed-rationalize-file-buffer-names ()  
   "Rerationalize buffer names and remove self from `post-command-hook'.  
 See also `delay-rationalize-file-buffer-names' for hook setter."  
   (uniquify-rationalize-file-buffer-names)  
   (remove-hook 'post-command-hook  
                'uniquify-delayed-rationalize-file-buffer-names))  
411    
412  ;; Ideally we'd like to add it buffer-locally, but that doesn't work  ;; Ideally we'd like to add it buffer-locally, but that doesn't work
413  ;; because kill-buffer-hook is not permanent-local :-(  ;; because kill-buffer-hook is not permanent-local :-(
414  (add-hook 'kill-buffer-hook 'uniquify-delay-rationalize-file-buffer-names)  (add-hook 'kill-buffer-hook 'uniquify-maybe-rerationalize-w/o-cb)
415    
416  (provide 'uniquify)  (provide 'uniquify)
417  ;;; uniquify.el ends here  ;;; uniquify.el ends here

Legend:
Removed from v.1.45  
changed lines
  Added in v.1.46

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