xemacs-beta: lisp/utils/uniquify.el comparison

comparison lisp/utils/uniquify.el @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	ac2d302a0011
children	131b0175ea99

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 ;;; uniquify.el --- unique buffer names dependent on file name
-;; Copyright (c) 1989, 1995 Free Software Foundation, Inc.
+;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc.
 ;; Author: Dick King <king@reasoning.com>
 ;; Maintainer: Michael Ernst <mernst@theory.lcs.mit.edu>
 ;; Created: 15 May 86
+;; Time-stamp: <97/03/03 17:16:23 mernst>
 ;; This file is part of GNU Emacs.
 ;; 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
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; 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
+;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;; Boston, MA 02111-1307, USA.
 ;;; Commentary:
 ;; Emacs's standard method for making buffer names unique adds <2>, <3>,
 ;; etc. to the end of (all but one of) the buffers.  This file replaces
 ;; are unique.  For instance, buffers visiting /u/mernst/tmp/Makefile and
 ;; /usr/projects/zaphod/Makefile would be named Makefile|tmp and
 ;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>).
 ;; Other buffer name styles are also available.
-;; To use this file, just load it.
+;; To use this file, just load it; or add (require 'uniquify) to your .emacs.
 ;; To disable it after loading, set variable uniquify-buffer-name-style to nil.
 ;; For other options, see "User-visible variables", below.
-;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs,
+;; uniquify.el works under Emacs 18, Emacs 19, XEmacs, and InfoDock.
-;; and InfoDock is available from the maintainer.
+;; Doesn't correctly handle buffer names created by M-x write-file in Emacs 18.
+;; Doesn't work under NT when backslash is used as a path separator (forward
+;;   slash path separator works fine).  To fix, check system-type against
+;;   'windows-nt, write a routine that breaks paths down into components.
+;;   (Surprisingly, there isn't one built in.)
 ;;; Change Log:
 ;; Originally by Dick King <king@reasoning.com> 15 May 86
 ;; Converted for Emacs 18 by Stephen Gildea <gildea@lcs.mit.edu>
 ;;  add uniquify-ask-about-buffer-names-p.  king, mernst 13 Jun 95
 ;; Prefix functions by "uniquify-..."; rename mnemonic-buffer-names to
 ;;  uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets
 ;;  styles; remove uniquify-reverse-dir-content-p; add
 ;;  uniquify-trailing-separator-p.  mernst 4 Aug 95
+;; Don't call expand-file-name on nil.  mernst 7 Jan 96
+;; Check whether list-buffers-directory is bound.  mernst 11 Oct 96
+;; Ignore non-file non-dired buffers. Colin Rafferty <craffert@ml.com> 3 Mar 97
 ;; Valuable feedback was provided by
 ;; Paul Smith <psmith@baynetworks.com>,
 ;; Alastair Burt <burt@dfki.uni-kl.de>,
 ;; Bob Weiner <weiner@footloose.sps.mot.com>,
 ;; Albert L. Ting <alt@vlibs.com>,
-;; gyro@reasoning.com.
+;; gyro@reasoning.com,
+;; Bryan O'Sullivan <bos@eng.sun.com>.
 ;;; Code:
 (provide 'uniquify)
 	(depth uniquify-min-dir-content))
 (let ((buffers (buffer-list)))
 (while buffers
 	(let* ((buffer (car buffers))
 	       (bfn (if (eq buffer newbuf)
-			(and newbuffile
+(and newbuffile
-			     (expand-file-name newbuffile))
+(expand-file-name newbuffile))
 		      (uniquify-buffer-file-name buffer)))
 	       (rawname (and bfn (file-name-nondirectory bfn)))
 	       (deserving (and rawname
 			       (or (not newbuffile)
 				   (equal rawname
 (mapcar 'uniquify-unrationalized-buffer fix-list)))
 ;; uniquify's version of buffer-file-name
 (defun uniquify-buffer-file-name (buffer)
 "Return name of file BUFFER is visiting, or nil if none.
-Works on dired buffers as well as ordinary file-visiting buffers."
+Works on dired buffers as well as ordinary file-visiting buffers,
+but no others."
 (or (buffer-file-name buffer)
-(save-excursion
+(and (featurep 'dired)
-	(set-buffer buffer)
+	   (save-excursion
-	list-buffers-directory)))
+	     (set-buffer buffer)
+	     (and
+	      (eq major-mode 'dired-mode) ; do nothing if not a dired buffer
+	      (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this
+		  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-fix-list-filename-lessp (fixlist1 fixlist2)
 (uniquify-filename-lessp
 (uniquify-fix-list-filename fixlist1) (uniquify-fix-list-filename fixlist2)))
 (apply (function concat) sofar)))
 ;;; Hooks from the rest of Emacs
-;; Emacs 19 (Emacs or XEmacs)
+(cond
+((string-match "^19" emacs-version)
-;; The logical place to put all this code is in generate-new-buffer-name.
+;; Emacs 19 (Emacs or XEmacs)
-;; 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
+;; The logical place to put all this code is in generate-new-buffer-name.
-;; that is that generate-new-buffer-name takes a potential buffer name as
+;; It's written in C, so we would add a generate-new-buffer-name-function
-;; its argument -- not other information, such as what file the buffer will
+;; which, if non-nil, would be called instead of the C.  One problem with
-;; visit.
+;; that is that generate-new-buffer-name takes a potential buffer name as
+;; its argument -- not other information, such as what file the buffer will
-;; The below solution works because generate-new-buffer-name is called
+;; visit.
-;; only by rename-buffer (which, as of 19.29, is never called from C) and
-;; generate-new-buffer, which is called only by Lisp functions
+;; The below solution works because generate-new-buffer-name is called
-;; create-file-buffer and rename-uniquely.  Rename-uniquely generally
+;; only by rename-buffer (which, as of 19.29, is never called from C) and
-;; isn't used for buffers visiting files, so it's sufficient to hook
+;; generate-new-buffer, which is called only by Lisp functions
-;; rename-buffer and create-file-buffer.  (Setting find-file-hooks isn't
+;; create-file-buffer and rename-uniquely.  Rename-uniquely generally
-;; sufficient.)
+;; isn't used for buffers visiting files, so it's sufficient to hook
+;; rename-buffer and create-file-buffer.  (Setting find-file-hooks isn't
-(defadvice rename-buffer (after rename-buffer-uniquify activate)
+;; sufficient.)
-"Uniquify buffer names with parts of directory name."
-(if (and uniquify-buffer-name-style
+(defadvice rename-buffer (after rename-buffer-uniquify activate)
-	   ;; UNIQUE argument
+"Uniquify buffer names with parts of directory name."
-	   (ad-get-arg 1))
+(if (and uniquify-buffer-name-style
-(progn
+	     ;; UNIQUE argument
-	(if uniquify-after-kill-buffer-p
+	     (ad-get-arg 1))
-	    ;; call with no argument; rationalize vs. old name as well as new
+	(progn
-	    (uniquify-rationalize-file-buffer-names)
+	  (if uniquify-after-kill-buffer-p
-	  ;; call with argument: rationalize vs. new name only
+	      ;; call with no argument; rationalize vs. old name as well as new
-	  (uniquify-rationalize-file-buffer-names
+	      (uniquify-rationalize-file-buffer-names)
-	   (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
+	    ;; call with argument: rationalize vs. new name only
-	(setq ad-return-value (buffer-name (current-buffer))))))
+	    (uniquify-rationalize-file-buffer-names
+	     (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
-(defadvice create-file-buffer (after create-file-buffer-uniquify activate)
+	  (setq ad-return-value (buffer-name (current-buffer))))))
-"Uniquify buffer names with parts of directory name."
-(if uniquify-buffer-name-style
+(defadvice create-file-buffer (after create-file-buffer-uniquify activate)
-(uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
+"Uniquify buffer names with parts of directory name."
+(if uniquify-buffer-name-style
-;; Buffer deletion
+	(uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
-;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
-;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
+;; Buffer deletion
-;; That means that the kill-buffer-hook function cannot just delete the
+;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
-;; buffer -- it has to set something to do the rationalization *later*.
+;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
-;; It actually puts another function on `post-command-hook'.  This other
+;; That means that the kill-buffer-hook function cannot just delete the
-;; function runs the rationalization and then removes itself from the hook.
+;; buffer -- it has to set something to do the rationalization *later*.
-;; Is there a better way to accomplish this?
+;; It actually puts another function on `post-command-hook'.  This other
-;; (This ought to set some global variables so the work is done only for
+;; function runs the rationalization and then removes itself from the hook.
-;; buffers with names similar to the deleted buffer.  -MDE)
+;; Is there a better way to accomplish this?
+;; (This ought to set some global variables so the work is done only for
-(defun delay-uniquify-rationalize-file-buffer-names ()
+;; buffers with names similar to the deleted buffer.  -MDE)
-"Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
+(cond
+((or (not (string-lessp emacs-version "19.28"))
+	(and (string-match "XEmacs" emacs-version)
+	     (not (string-lessp emacs-version "19.12"))))
+;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?)
+(defun delay-uniquify-rationalize-file-buffer-names ()
+"Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
 For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
 (if (and uniquify-buffer-name-style
-	   uniquify-after-kill-buffer-p)
+	       uniquify-after-kill-buffer-p)
-(add-hook 'post-command-hook
+	  (add-hook 'post-command-hook
-		'delayed-uniquify-rationalize-file-buffer-names)))
+		    'delayed-uniquify-rationalize-file-buffer-names)))
+(defun delayed-uniquify-rationalize-file-buffer-names ()
-(defun delayed-uniquify-rationalize-file-buffer-names ()
+"Rerationalize buffer names and remove self from `post-command-hook'.
-"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
-	       'delayed-uniquify-rationalize-file-buffer-names))
+		   'delayed-uniquify-rationalize-file-buffer-names))
-(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
+(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names))
+(t
+;; GNU Emacs 19.01 through 19.27
+;; Before version 19.28, {pre,post}-command-hook was unable to set itself.
+(defvar uniquify-post-command-p nil
+"Set to trigger re-rationalization of buffer names by function on
+`post-command-hook'.  Used by kill-buffer-rationalization mechanism.")
+(defun uniquify-post-command-rerationalization ()
+"Set variable so buffer names may be rationalized by `post-command-hook'.
+See variables `uniquify-post-command-p', `uniquify-buffer-name-style', and
+`uniquify-after-kill-buffer-p'."
+(if (and uniquify-buffer-name-style
+	       uniquify-after-kill-buffer-p)
+	  (setq uniquify-post-command-p
+		;; Set the buffer name, so, once the delimiter character
+		;; is parameterized, we could selectively rationalize just
+		;; related buffer names.
+		(cons (buffer-name) uniquify-post-command-p))))
+(defun uniquify-rationalize-after-buffer-kill ()
+"Via `post-command-hook', rerationalize buffer names after kill-buffer.
+Checks `uniquify-post-command-p', which should be set by
+`uniquify-post-command-rerationalization' function on `kill-buffer-hook'."
+(if uniquify-post-command-p
+	  (progn (if (and uniquify-buffer-name-style
+			  uniquify-after-kill-buffer-p)
+		     (uniquify-rationalize-file-buffer-names))
+		 (setq uniquify-post-command-p nil))))
+(add-hook 'kill-buffer-hook 'uniquify-post-command-rerationalization)
+(add-hook 'post-command-hook 'uniquify-rationalize-after-buffer-kill))
+))
+(t
+;; Emacs 18: redefine create-file-buffer and dired-find-buffer.
+;; Since advice.el can run in Emacs 18 as well as Emacs 19, we could use
+;; advice here, too, if it is available; but it's not worth it, since
+;; Emacs 18 is obsolescent anyway.
+(defun create-file-buffer (filename)	;from files.el
+"Create a suitably named buffer for visiting FILENAME, and return it."
+(let ((base (file-name-nondirectory filename)))
+(if (string= base "")
+	  (setq base filename))
+(if (and (get-buffer base)
+	       uniquify-ask-about-buffer-names-p)
+	  (get-buffer-create
+	   (let ((tem (read-string (format
+				    "Buffer name \"%s\" is in use; type a new name, or Return to clobber: "
+base))))
+	     (if (equal tem "") base tem)))
+	(let ((buf (generate-new-buffer base)))
+	  (if uniquify-buffer-name-style
+	      (uniquify-rationalize-file-buffer-names filename buf))
+	  buf))))
+(defun dired-find-buffer (dirname)	;from dired.el
+(let ((blist (buffer-list))
+	  found)
+(while blist
+	(save-excursion
+	  (set-buffer (car blist))
+	  (if (and (eq major-mode 'dired-mode)
+		   (equal dired-directory dirname))
+	      (setq found (car blist)
+		    blist nil)
+	    (setq blist (cdr blist)))))
+(or found
+	  (progn (if (string-match "/$" dirname)
+		     (setq dirname (substring dirname 0 -1)))
+		 (create-file-buffer (if uniquify-buffer-name-style
+					 dirname
+				       (file-name-nondirectory dirname)))))))))
 ;;; uniquify.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/utils/uniquify.el @ 30:ec9a17fef872 r19-15b98