Mercurial > hg > xemacs-beta

comparison lisp/utils/uniquify.el @ 189:489f57a838ef r20-3b21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b21
author cvs
date Mon, 13 Aug 2007 09:57:07 +0200
parents 8eaf7971accc
children 1f0dabaa0855
comparison
equal deleted inserted replaced
188:e29a8e7498d9 189:489f57a838ef
81 81
82 (provide 'uniquify) 82 (provide 'uniquify)
83 83
84 ;;; User-visible variables 84 ;;; User-visible variables
85 85
86 (progn 86 (defgroup uniquify nil
87 (defgroup uniquify nil 87 "Unique buffer names dependent on file name"
88 "Unique buffer names dependent on file name" 88 :group 'applications)
89 :group 'applications) 89
90 ) 90
91 91 (defcustom uniquify-buffer-name-style nil
92
93 (defcustom uniquify-buffer-name-style 'post-forward
94 "*If non-nil, buffer names are uniquified with parts of directory name. 92 "*If non-nil, buffer names are uniquified with parts of directory name.
95 The value determines the buffer name style and is one of `forward', 93 The value determines the buffer name style and is one of `forward',
96 `reverse', `post-forward' (the default), or `post-forward-angle-brackets'. 94 `reverse', `post-forward' (the default), or `post-forward-angle-brackets'.
97 For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name' 95 For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
98 would have the following buffer names in the various styles: 96 would have the following buffer names in the various styles:
104 :type '(radio (const forward) 102 :type '(radio (const forward)
105 (const reverse) 103 (const reverse)
106 (const post-forward) 104 (const post-forward)
107 (const podt-forward-angle-brackets) 105 (const podt-forward-angle-brackets)
108 (const nil)) 106 (const nil))
107 :require 'uniquify
109 :group 'uniquify) 108 :group 'uniquify)
110 109
111 (defcustom uniquify-after-kill-buffer-p nil 110 (defcustom uniquify-after-kill-buffer-p nil
112 "*If non-nil, rerationalize buffer names after a buffer has been killed. 111 "*If non-nil, rerationalize buffer names after a buffer has been killed.
113 This can be dangerous if Emacs Lisp code is keeping track of buffers by their 112 This can be dangerous if Emacs Lisp code is keeping track of buffers by their
358 (apply (function concat) sofar))) 357 (apply (function concat) sofar)))
359 358
360 359
361 ;;; Hooks from the rest of Emacs 360 ;;; Hooks from the rest of Emacs
362 361
363 (cond 362 ;; The logical place to put all this code is in generate-new-buffer-name.
364 ((string-match "^\\(19\\|20\\)" emacs-version) 363 ;; It's written in C, so we would add a generate-new-buffer-name-function
365 ;; Emacs 19 (Emacs or XEmacs) 364 ;; which, if non-nil, would be called instead of the C. One problem with
366 365 ;; that is that generate-new-buffer-name takes a potential buffer name as
367 ;; The logical place to put all this code is in generate-new-buffer-name. 366 ;; its argument -- not other information, such as what file the buffer will
368 ;; It's written in C, so we would add a generate-new-buffer-name-function 367 ;; visit.
369 ;; which, if non-nil, would be called instead of the C. One problem with 368
370 ;; that is that generate-new-buffer-name takes a potential buffer name as 369 ;; The below solution works because generate-new-buffer-name is called
371 ;; its argument -- not other information, such as what file the buffer will 370 ;; only by rename-buffer (which, as of 19.29, is never called from C) and
372 ;; visit. 371 ;; generate-new-buffer, which is called only by Lisp functions
373 372 ;; create-file-buffer and rename-uniquely. Rename-uniquely generally
374 ;; The below solution works because generate-new-buffer-name is called 373 ;; isn't used for buffers visiting files, so it's sufficient to hook
375 ;; only by rename-buffer (which, as of 19.29, is never called from C) and 374 ;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't
376 ;; generate-new-buffer, which is called only by Lisp functions 375 ;; sufficient.)
377 ;; create-file-buffer and rename-uniquely. Rename-uniquely generally 376
378 ;; isn't used for buffers visiting files, so it's sufficient to hook 377 (defadvice rename-buffer (after rename-buffer-uniquify activate)
379 ;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't 378 "Uniquify buffer names with parts of directory name."
380 ;; sufficient.) 379 (if (and uniquify-buffer-name-style
381 380 ;; UNIQUE argument
382 (defadvice rename-buffer (after rename-buffer-uniquify activate) 381 (ad-get-arg 1))
383 "Uniquify buffer names with parts of directory name." 382 (progn
384 (if (and uniquify-buffer-name-style 383 (if uniquify-after-kill-buffer-p
385 ;; UNIQUE argument 384 ;; call with no argument; rationalize vs. old name as well as new
386 (ad-get-arg 1)) 385 (uniquify-rationalize-file-buffer-names)
387 (progn 386 ;; call with argument: rationalize vs. new name only
388 (if uniquify-after-kill-buffer-p 387 (uniquify-rationalize-file-buffer-names
389 ;; call with no argument; rationalize vs. old name as well as new 388 (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
390 (uniquify-rationalize-file-buffer-names) 389 (setq ad-return-value (buffer-name (current-buffer))))))
391 ;; call with argument: rationalize vs. new name only 390
392 (uniquify-rationalize-file-buffer-names 391 (defadvice create-file-buffer (after create-file-buffer-uniquify activate)
393 (uniquify-buffer-file-name (current-buffer)) (current-buffer))) 392 "Uniquify buffer names with parts of directory name."
394 (setq ad-return-value (buffer-name (current-buffer)))))) 393 (if uniquify-buffer-name-style
395 394 (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
396 (defadvice create-file-buffer (after create-file-buffer-uniquify activate) 395
397 "Uniquify buffer names with parts of directory name." 396 ;; Buffer deletion
398 (if uniquify-buffer-name-style 397 ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
399 (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) 398 ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
400 399 ;; That means that the kill-buffer-hook function cannot just delete the
401 ;; Buffer deletion 400 ;; buffer -- it has to set something to do the rationalization *later*.
402 ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. 401 ;; It actually puts another function on `post-command-hook'. This other
403 ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. 402 ;; function runs the rationalization and then removes itself from the hook.
404 ;; That means that the kill-buffer-hook function cannot just delete the 403 ;; Is there a better way to accomplish this?
405 ;; buffer -- it has to set something to do the rationalization *later*. 404 ;; (This ought to set some global variables so the work is done only for
406 ;; It actually puts another function on `post-command-hook'. This other 405 ;; buffers with names similar to the deleted buffer. -MDE)
407 ;; function runs the rationalization and then removes itself from the hook. 406
408 ;; Is there a better way to accomplish this? 407 ;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?)
409 ;; (This ought to set some global variables so the work is done only for 408 (defun delay-uniquify-rationalize-file-buffer-names ()
410 ;; buffers with names similar to the deleted buffer. -MDE) 409 "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
411
412 (cond
413 ((or (not (string-lessp emacs-version "19.28"))
414 (and (string-match "XEmacs" emacs-version)
415 (not (string-lessp emacs-version "19.12"))))
416 ;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?)
417 (defun delay-uniquify-rationalize-file-buffer-names ()
418 "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
419 For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." 410 For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
420 (if (and uniquify-buffer-name-style 411 (if (and uniquify-buffer-name-style
421 uniquify-after-kill-buffer-p) 412 uniquify-after-kill-buffer-p)
422 (add-hook 'post-command-hook 413 (add-hook 'post-command-hook
423 'delayed-uniquify-rationalize-file-buffer-names))) 414 'delayed-uniquify-rationalize-file-buffer-names)))
424 (defun delayed-uniquify-rationalize-file-buffer-names () 415
425 "Rerationalize buffer names and remove self from `post-command-hook'. 416 (defun delayed-uniquify-rationalize-file-buffer-names ()
417 "Rerationalize buffer names and remove self from `post-command-hook'.
426 See also `delay-rationalize-file-buffer-names' for hook setter." 418 See also `delay-rationalize-file-buffer-names' for hook setter."
427 (uniquify-rationalize-file-buffer-names) 419 (uniquify-rationalize-file-buffer-names)
428 (remove-hook 'post-command-hook 420 (remove-hook 'post-command-hook
429 'delayed-uniquify-rationalize-file-buffer-names)) 421 'delayed-uniquify-rationalize-file-buffer-names))
430 422
431 (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)) 423 (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
432 (t 424
433 ;; GNU Emacs 19.01 through 19.27
434 ;; Before version 19.28, {pre,post}-command-hook was unable to set itself.
435
436 (defvar uniquify-post-command-p nil
437 "Set to trigger re-rationalization of buffer names by function on
438 `post-command-hook'. Used by kill-buffer-rationalization mechanism.")
439
440 (defun uniquify-post-command-rerationalization ()
441 "Set variable so buffer names may be rationalized by `post-command-hook'.
442
443 See variables `uniquify-post-command-p', `uniquify-buffer-name-style', and
444 `uniquify-after-kill-buffer-p'."
445 (if (and uniquify-buffer-name-style
446 uniquify-after-kill-buffer-p)
447 (setq uniquify-post-command-p
448 ;; Set the buffer name, so, once the delimiter character
449 ;; is parameterized, we could selectively rationalize just
450 ;; related buffer names.
451 (cons (buffer-name) uniquify-post-command-p))))
452 (defun uniquify-rationalize-after-buffer-kill ()
453 "Via `post-command-hook', rerationalize buffer names after kill-buffer.
454
455 Checks `uniquify-post-command-p', which should be set by
456 `uniquify-post-command-rerationalization' function on `kill-buffer-hook'."
457 (if uniquify-post-command-p
458 (progn (if (and uniquify-buffer-name-style
459 uniquify-after-kill-buffer-p)
460 (uniquify-rationalize-file-buffer-names))
461 (setq uniquify-post-command-p nil))))
462
463 (add-hook 'kill-buffer-hook 'uniquify-post-command-rerationalization)
464 (add-hook 'post-command-hook 'uniquify-rationalize-after-buffer-kill))
465 ))
466 (t
467 ;; Emacs 18: redefine create-file-buffer and dired-find-buffer.
468
469 ;; Since advice.el can run in Emacs 18 as well as Emacs 19, we could use
470 ;; advice here, too, if it is available; but it's not worth it, since
471 ;; Emacs 18 is obsolescent anyway.
472
473 (defun create-file-buffer (filename) ;from files.el
474 "Create a suitably named buffer for visiting FILENAME, and return it."
475 (let ((base (file-name-nondirectory filename)))
476 (if (string= base "")
477 (setq base filename))
478 (if (and (get-buffer base)
479 uniquify-ask-about-buffer-names-p)
480 (get-buffer-create
481 (let ((tem (read-string (format
482 "Buffer name \"%s\" is in use; type a new name, or Return to clobber: "
483 base))))
484 (if (equal tem "") base tem)))
485 (let ((buf (generate-new-buffer base)))
486 (if uniquify-buffer-name-style
487 (uniquify-rationalize-file-buffer-names filename buf))
488 buf))))
489
490 (defun dired-find-buffer (dirname) ;from dired.el
491 (let ((blist (buffer-list))
492 found)
493 (while blist
494 (save-excursion
495 (set-buffer (car blist))
496 (if (and (eq major-mode 'dired-mode)
497 (equal dired-directory dirname))
498 (setq found (car blist)
499 blist nil)
500 (setq blist (cdr blist)))))
501 (or found
502 (progn (if (string-match "/$" dirname)
503 (setq dirname (substring dirname 0 -1)))
504 (create-file-buffer (if uniquify-buffer-name-style
505 dirname
506 (file-name-nondirectory dirname)))))))))
507 425
508 ;;; uniquify.el ends here 426 ;;; uniquify.el ends here