Mercurial > emacs
comparison lisp/cedet/cedet-files.el @ 104438:33171bfc7147
cedet/cedet-files.el: New file.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 21:06:53 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
104437:11587959f51d | 104438:33171bfc7147 |
---|---|
1 ;;; cedet-files.el --- Common routines dealing with file names. | |
2 | |
3 ;;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation, either version 3 of the License, or | |
12 ;; (at your option) any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | |
22 ;;; Commentary: | |
23 ;; | |
24 ;; Various useful routines for dealing with file names in the tools | |
25 ;; which are a part of CEDET. | |
26 | |
27 ;;; Code: | |
28 (defvar cedet-dir-sep-char (if (boundp 'directory-sep-char) | |
29 (symbol-value 'directory-sep-char) | |
30 ?/) | |
31 "Character used for directory separation. | |
32 Obsoleted in some versions of Emacs. Needed in others.") | |
33 | |
34 | |
35 (defun cedet-directory-name-to-file-name (referencedir &optional testmode) | |
36 "Convert the REFERENCEDIR (a full path name) into a filename. | |
37 Converts directory seperation characters into ! characters. | |
38 Optional argument TESTMODE is used by tests to avoid conversion | |
39 to the file's truename, and dodging platform tricks." | |
40 (let ((file referencedir) | |
41 dir-sep-string) | |
42 ;; Expand to full file name | |
43 (when (not testmode) | |
44 (setq file (file-truename file))) | |
45 ;; If FILE is a directory, then force it to end in /. | |
46 (when (file-directory-p file) | |
47 (setq file (file-name-as-directory file))) | |
48 ;; Handle Windows Special cases | |
49 (when (or (memq system-type '(windows-nt ms-dos)) testmode) | |
50 ;; Replace any invalid file-name characters (for the | |
51 ;; case of backing up remote files). | |
52 (when (not testmode) | |
53 (setq file (expand-file-name (convert-standard-filename file)))) | |
54 (setq dir-sep-string (char-to-string cedet-dir-sep-char)) | |
55 ;; Normalize DOSish file names: convert all slashes to | |
56 ;; directory-sep-char, downcase the drive letter, if any, | |
57 ;; and replace the leading "x:" with "/drive_x". | |
58 (if (eq (aref file 1) ?:) | |
59 (setq file (concat dir-sep-string | |
60 "drive_" | |
61 (char-to-string (downcase (aref file 0))) | |
62 (if (eq (aref file 2) cedet-dir-sep-char) | |
63 "" | |
64 dir-sep-string) | |
65 (substring file 2))))) | |
66 ;; Make the name unique by substituting directory | |
67 ;; separators. It may not really be worth bothering about | |
68 ;; doubling `!'s in the original name... | |
69 (setq file (subst-char-in-string | |
70 cedet-dir-sep-char ?! | |
71 (replace-regexp-in-string "!" "!!" file))) | |
72 file)) | |
73 | |
74 (defun cedet-file-name-to-directory-name (referencefile &optional testmode) | |
75 "Reverse the process of `cedet-directory-name-to-file-name'. | |
76 Convert REFERENCEFILE to a directory name replacing ! with /. | |
77 Optional TESTMODE is used in tests to avoid doing some platform | |
78 specific conversions during tests." | |
79 (let ((file referencefile)) | |
80 ;; Replace the ! with / | |
81 (setq file (subst-char-in-string ?! ?/ file)) | |
82 ;; Occurances of // meant there was once a single !. | |
83 (setq file (replace-regexp-in-string "//" "!" file)) | |
84 | |
85 ;; Handle Windows special cases | |
86 (when (or (memq system-type '(windows-nt ms-dos)) testmode) | |
87 | |
88 ;; Handle drive letters from DOSish file names. | |
89 (when (string-match "^/drive_\\([a-z]\\)/" file) | |
90 (let ((driveletter (match-string 1 file)) | |
91 ) | |
92 (setq file (concat driveletter ":" | |
93 (substring file (match-end 1)))))) | |
94 | |
95 ;; Handle the \\file\name nomenclature on some windows boxes. | |
96 (when (string-match "^!" file) | |
97 (setq file (concat "//" (substring file 1)))) | |
98 ) | |
99 | |
100 file)) | |
101 | |
102 ;;; Tests | |
103 ;; | |
104 (defvar cedet-files-utest-list | |
105 '( | |
106 ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" ) | |
107 ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" ) | |
108 ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" ) | |
109 ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" ) | |
110 ) | |
111 "List of different file names to test. | |
112 Each entry is a cons cell of ( FNAME . CONVERTED ) | |
113 where FNAME is some file name, and CONVERTED is what it should be | |
114 converted into.") | |
115 | |
116 (defun cedet-files-utest () | |
117 "Test out some file name conversions." | |
118 (interactive) | |
119 | |
120 (let ((idx 0)) | |
121 (dolist (FT cedet-files-utest-list) | |
122 | |
123 (setq idx (+ idx 1)) | |
124 | |
125 (let ((dir->file (cedet-directory-name-to-file-name (car FT) t)) | |
126 (file->dir (cedet-file-name-to-directory-name (cdr FT) t)) | |
127 ) | |
128 | |
129 (unless (string= (cdr FT) dir->file) | |
130 (error "Failed: %d. Found: %S Wanted: %S" | |
131 idx dir->file (cdr FT)) | |
132 ) | |
133 | |
134 (unless (string= file->dir (car FT)) | |
135 (error "Failed: %d. Found: %S Wanted: %S" | |
136 idx file->dir (car FT)) | |
137 ) | |
138 | |
139 )))) | |
140 | |
141 | |
142 ;;; Compatibility | |
143 ;; | |
144 ;; replace-regexp-in-string is in subr.el in Emacs 21. Provide | |
145 ;; here for compatibility. | |
146 | |
147 (when (not (fboundp 'replace-regexp-in-string)) | |
148 | |
149 (defun replace-regexp-in-string (regexp rep string &optional | |
150 fixedcase literal subexp start) | |
151 "Replace all matches for REGEXP with REP in STRING. | |
152 | |
153 Return a new string containing the replacements. | |
154 | |
155 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the | |
156 arguments with the same names of function `replace-match'. If START | |
157 is non-nil, start replacements at that index in STRING. | |
158 | |
159 REP is either a string used as the NEWTEXT arg of `replace-match' or a | |
160 function. If it is a function it is applied to each match to generate | |
161 the replacement passed to `replace-match'; the match-data at this | |
162 point are such that match 0 is the function's argument. | |
163 | |
164 To replace only the first match (if any), make REGEXP match up to \\' | |
165 and replace a sub-expression, e.g. | |
166 (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1) | |
167 => \" bar foo\"" | |
168 | |
169 ;; To avoid excessive consing from multiple matches in long strings, | |
170 ;; don't just call `replace-match' continually. Walk down the | |
171 ;; string looking for matches of REGEXP and building up a (reversed) | |
172 ;; list MATCHES. This comprises segments of STRING which weren't | |
173 ;; matched interspersed with replacements for segments that were. | |
174 ;; [For a `large' number of replacements it's more efficient to | |
175 ;; operate in a temporary buffer; we can't tell from the function's | |
176 ;; args whether to choose the buffer-based implementation, though it | |
177 ;; might be reasonable to do so for long enough STRING.] | |
178 (let ((l (length string)) | |
179 (start (or start 0)) | |
180 matches str mb me) | |
181 (save-match-data | |
182 (while (and (< start l) (string-match regexp string start)) | |
183 (setq mb (match-beginning 0) | |
184 me (match-end 0)) | |
185 ;; If we matched the empty string, make sure we advance by one char | |
186 (when (= me mb) (setq me (min l (1+ mb)))) | |
187 ;; Generate a replacement for the matched substring. | |
188 ;; Operate only on the substring to minimize string consing. | |
189 ;; Set up match data for the substring for replacement; | |
190 ;; presumably this is likely to be faster than munging the | |
191 ;; match data directly in Lisp. | |
192 (string-match regexp (setq str (substring string mb me))) | |
193 (setq matches | |
194 (cons (replace-match (if (stringp rep) | |
195 rep | |
196 (funcall rep (match-string 0 str))) | |
197 fixedcase literal str subexp) | |
198 (cons (substring string start mb) ; unmatched prefix | |
199 matches))) | |
200 (setq start me)) | |
201 ;; Reconstruct a string from the pieces. | |
202 (setq matches (cons (substring string start l) matches)) ; leftover | |
203 (apply #'concat (nreverse matches))))) | |
204 | |
205 ) | |
206 | |
207 (provide 'cedet-files) | |
208 | |
209 ;;; cedet-files.el ends here |