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