Mercurial > emacs
comparison lisp/uniquify.el @ 50826:1fe62a68c56a
(uniquify-buffer-name-style, uniquify-after-kill-buffer-p)
(uniquify-ask-about-buffer-names-p, uniquify-ignore-buffers-re)
(uniquify-min-dir-content, uniquify-separator, uniquify-trailing-separator-p):
Remove redundant group specification.
(uniquify-file-name-nondirectory): Delete.
(uniquify-rationalize-file-buffer-names): Simplify.
Use directory names as `filename' component of uniquify-item.
(uniquify-get-proposed-name): Adjust now that `filename' does not
include `base'.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 05 May 2003 16:55:38 +0000 |
parents | 28d06c5071e1 |
children | 86903fed9f75 |
comparison
equal
deleted
inserted
replaced
50825:e945bb200f5c | 50826:1fe62a68c56a |
---|---|
107 :type '(radio (const forward) | 107 :type '(radio (const forward) |
108 (const reverse) | 108 (const reverse) |
109 (const post-forward) | 109 (const post-forward) |
110 (const post-forward-angle-brackets) | 110 (const post-forward-angle-brackets) |
111 (const :tag "standard Emacs behavior (nil)" nil)) | 111 (const :tag "standard Emacs behavior (nil)" nil)) |
112 :require 'uniquify | 112 :require 'uniquify) |
113 :group 'uniquify) | |
114 | 113 |
115 (defcustom uniquify-after-kill-buffer-p nil | 114 (defcustom uniquify-after-kill-buffer-p nil |
116 "*If non-nil, rerationalize buffer names after a buffer has been killed. | 115 "*If non-nil, rerationalize buffer names after a buffer has been killed. |
117 This can be dangerous if Emacs Lisp code is keeping track of buffers by their | 116 This can be dangerous if Emacs Lisp code is keeping track of buffers by their |
118 names (rather than keeping pointers to the buffers themselves)." | 117 names (rather than keeping pointers to the buffers themselves)." |
119 :type 'boolean | 118 :type 'boolean) |
120 :group 'uniquify) | |
121 | 119 |
122 (defcustom uniquify-ask-about-buffer-names-p nil | 120 (defcustom uniquify-ask-about-buffer-names-p nil |
123 "*If non-nil, permit user to choose names for buffers with same base file. | 121 "*If non-nil, permit user to choose names for buffers with same base file. |
124 If the user chooses to name a buffer, uniquification is preempted and no | 122 If the user chooses to name a buffer, uniquification is preempted and no |
125 other buffer names are changed." | 123 other buffer names are changed." |
126 :type 'boolean | 124 :type 'boolean) |
127 :group 'uniquify) | |
128 | 125 |
129 ;; The default value matches certain Gnus buffers. | 126 ;; The default value matches certain Gnus buffers. |
130 (defcustom uniquify-ignore-buffers-re "^\\*\\(un\\)?sent " | 127 (defcustom uniquify-ignore-buffers-re "^\\*\\(un\\)?sent " |
131 "*Regular expression matching buffer names that should not be uniquified. | 128 "*Regular expression matching buffer names that should not be uniquified. |
132 For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename | 129 For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename |
133 draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the | 130 draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the |
134 visited file name isn't the same as that of the buffer." | 131 visited file name isn't the same as that of the buffer." |
135 :type '(choice (const :tag "Uniquify all buffers" nil) regexp) | 132 :type '(choice (const :tag "Uniquify all buffers" nil) regexp)) |
136 :group 'uniquify) | |
137 | 133 |
138 (defcustom uniquify-min-dir-content 0 | 134 (defcustom uniquify-min-dir-content 0 |
139 "*Minimum number of directory name components included in buffer name." | 135 "*Minimum number of directory name components included in buffer name." |
140 :type 'integer | 136 :type 'integer) |
141 :group 'uniquify) | |
142 | 137 |
143 (defcustom uniquify-separator nil | 138 (defcustom uniquify-separator nil |
144 "*String separator for buffer name components. | 139 "*String separator for buffer name components. |
145 When `uniquify-buffer-name-style' is `post-forward', separates | 140 When `uniquify-buffer-name-style' is `post-forward', separates |
146 base file name from directory part in buffer names (default \"|\"). | 141 base file name from directory part in buffer names (default \"|\"). |
147 When `uniquify-buffer-name-style' is `reverse', separates all | 142 When `uniquify-buffer-name-style' is `reverse', separates all |
148 file name components (default \"\\\")." | 143 file name components (default \"\\\")." |
149 :type '(choice (const nil) string) | 144 :type '(choice (const nil) string)) |
150 :group 'uniquify) | |
151 | 145 |
152 (defcustom uniquify-trailing-separator-p nil | 146 (defcustom uniquify-trailing-separator-p nil |
153 "*If non-nil, add a file name separator to dired buffer names. | 147 "*If non-nil, add a file name separator to dired buffer names. |
154 If `uniquify-buffer-name-style' is `forward', add the separator at the end; | 148 If `uniquify-buffer-name-style' is `forward', add the separator at the end; |
155 if it is `reverse', add the separator at the beginning; otherwise, this | 149 if it is `reverse', add the separator at the beginning; otherwise, this |
156 variable is ignored." | 150 variable is ignored." |
157 :type 'boolean | 151 :type 'boolean) |
158 :group 'uniquify) | |
159 | 152 |
160 (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) | 153 (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode) |
161 "List of modes for which uniquify should obey `list-buffers-directory'. | 154 "List of modes for which uniquify should obey `list-buffers-directory'. |
162 That means that when `buffer-file-name' is set to nil, `list-buffers-directory' | 155 That means that when `buffer-file-name' is set to nil, `list-buffers-directory' |
163 contains the name of the directory which the buffer is visiting.") | 156 contains the name of the directory which the buffer is visiting.") |
164 | 157 |
165 ;;; Utilities | 158 ;;; Utilities |
166 | |
167 ;; For directories, return the last component, not the empty string. | |
168 (defun uniquify-file-name-nondirectory (file-name) | |
169 (file-name-nondirectory (directory-file-name file-name))) | |
170 | 159 |
171 ;; uniquify-fix-list data structure | 160 ;; uniquify-fix-list data structure |
172 (defstruct (uniquify-item | 161 (defstruct (uniquify-item |
173 (:constructor nil) (:copier nil) | 162 (:constructor nil) (:copier nil) |
174 (:constructor uniquify-make-item (base filename buffer proposed))) | 163 (:constructor uniquify-make-item (base filename buffer proposed))) |
183 "Make file buffer names unique by adding segments from file name. | 172 "Make file buffer names unique by adding segments from file name. |
184 If `uniquify-min-dir-content' > 0, always pulls that many | 173 If `uniquify-min-dir-content' > 0, always pulls that many |
185 file name elements. | 174 file name elements. |
186 Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." | 175 Arguments NEWBUFFILE and NEWBUF cause only a subset of buffers to be renamed." |
187 (interactive) | 176 (interactive) |
188 (let (fix-list | 177 (when newbuffile |
189 (newbuffile-nd (and newbuffile | 178 (setq newbuffile (expand-file-name (directory-file-name newbuffile)))) |
190 (uniquify-file-name-nondirectory newbuffile)))) | 179 (let ((fix-list nil) |
180 (base (and newbuffile (file-name-nondirectory newbuffile)))) | |
191 (dolist (buffer (buffer-list)) | 181 (dolist (buffer (buffer-list)) |
192 (let ((bufname (buffer-name buffer)) | 182 (let ((bufname (buffer-name buffer)) |
193 bfn rawname proposed) | 183 bfn rawname) |
194 (if (and (not (and uniquify-ignore-buffers-re | 184 (when (and (not (and uniquify-ignore-buffers-re |
195 (string-match uniquify-ignore-buffers-re | 185 (string-match uniquify-ignore-buffers-re |
196 bufname))) | 186 bufname))) |
197 (setq bfn (if (eq buffer newbuf) | 187 (setq bfn (if (eq buffer newbuf) newbuffile |
198 (when newbuffile | 188 (uniquify-buffer-file-name buffer))) |
199 (expand-file-name | 189 (setq rawname (file-name-nondirectory bfn)) |
200 (directory-file-name newbuffile))) | 190 (or (null base) (equal rawname base))) |
201 (uniquify-buffer-file-name buffer))) | 191 (when (setq bfn (file-name-directory bfn)) ;Strip off the `base'. |
202 (setq rawname (uniquify-file-name-nondirectory bfn)) | 192 (setq bfn (directory-file-name bfn))) ;Strip trailing slash. |
203 (or (not newbuffile) | 193 (push (uniquify-make-item rawname bfn buffer |
204 (equal rawname newbuffile-nd)) | 194 (uniquify-get-proposed-name rawname bfn)) |
205 (setq proposed (uniquify-get-proposed-name rawname bfn))) | 195 fix-list)))) |
206 (push (uniquify-make-item rawname bfn buffer proposed) fix-list)))) | |
207 ;; selects buffers whose names may need changing, and others that | 196 ;; selects buffers whose names may need changing, and others that |
208 ;; may conflict, then bring conflicting names together | 197 ;; may conflict, then bring conflicting names together |
209 (uniquify-rationalize-a-list fix-list))) | 198 (uniquify-rationalize-a-list fix-list))) |
210 | 199 |
211 ;; uniquify's version of buffer-file-name; result never contains trailing slash | 200 ;; uniquify's version of buffer-file-name; result never contains trailing slash |
250 (uniquify-rationalize-conflicting-sublist conflicting-sublist | 239 (uniquify-rationalize-conflicting-sublist conflicting-sublist |
251 old-proposed depth))) | 240 old-proposed depth))) |
252 | 241 |
253 (defun uniquify-get-proposed-name (base filename &optional depth) | 242 (defun uniquify-get-proposed-name (base filename &optional depth) |
254 (unless depth (setq depth uniquify-min-dir-content)) | 243 (unless depth (setq depth uniquify-min-dir-content)) |
255 (assert (equal base (uniquify-file-name-nondirectory filename))) | 244 (assert (equal (directory-file-name filename) filename)) ;No trailing slash. |
256 (assert (equal (directory-file-name filename) filename)) | |
257 | 245 |
258 ;; Distinguish directories by adding extra separator. | 246 ;; Distinguish directories by adding extra separator. |
259 (if (and uniquify-trailing-separator-p | 247 (if (and uniquify-trailing-separator-p |
260 (file-directory-p filename) | 248 (file-directory-p (expand-file-name base filename)) |
261 (not (string-equal base ""))) | 249 (not (string-equal base ""))) |
262 (cond ((eq uniquify-buffer-name-style 'forward) | 250 (cond ((eq uniquify-buffer-name-style 'forward) |
263 (setq base (file-name-as-directory base))) | 251 (setq base (file-name-as-directory base))) |
264 ;; (setq base (concat base "/"))) | 252 ;; (setq base (concat base "/"))) |
265 ((eq uniquify-buffer-name-style 'reverse) | 253 ((eq uniquify-buffer-name-style 'reverse) |
266 (setq base (concat (or uniquify-separator "\\") base))))) | 254 (setq base (concat (or uniquify-separator "\\") base))))) |
267 | 255 |
268 (let ((extra-string nil) | 256 (let ((extra-string nil) |
269 (n depth)) | 257 (n depth)) |
270 (while (and (> n 0) filename | 258 (while (and (> n 0) filename) |
271 (setq filename (file-name-directory filename)) | |
272 (setq filename (directory-file-name filename))) | |
273 (let ((file (file-name-nondirectory filename))) | 259 (let ((file (file-name-nondirectory filename))) |
260 (when (setq filename (file-name-directory filename)) | |
261 (setq filename (directory-file-name filename))) | |
274 (setq n (1- n)) | 262 (setq n (1- n)) |
275 (push (if (zerop (length file)) ;nil or "". | 263 (push (if (zerop (length file)) ;nil or "". |
276 (prog1 "" (setq filename nil)) ;Could be `filename' iso "". | 264 (prog1 "" (setq filename nil)) ;Could be `filename' iso "". |
277 file) | 265 file) |
278 extra-string))) | 266 extra-string))) |
279 (when (zerop n) | 267 (when (zerop n) |
280 (if (and filename extra-string | 268 (if (and filename extra-string |
281 (setq filename (file-name-directory filename)) | 269 (equal filename (file-name-directory filename))) |
282 (equal filename | |
283 (file-name-directory (directory-file-name filename)))) | |
284 ;; We're just before the root. Let's add the leading / already. | 270 ;; We're just before the root. Let's add the leading / already. |
285 ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with | 271 ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with |
286 ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b". | 272 ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b". |
287 (push "" extra-string)) | 273 (push "" extra-string)) |
288 (setq uniquify-possibly-resolvable t)) | 274 (setq uniquify-possibly-resolvable t)) |