Update copyright year to 2014 by running admin/update-copyright.
[emacs.git] / lisp / cedet / cedet-files.el
blob889b2d64bf1ffd041d69f836629ffbac26a4ead8
1 ;;; cedet-files.el --- Common routines dealing with file names.
3 ;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
6 ;; Package: cedet
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; Various useful routines for dealing with file names in the tools
26 ;; which are a part of CEDET.
28 ;;; Code:
30 (defun cedet-directory-name-to-file-name (referencedir &optional testmode)
31 "Convert the REFERENCEDIR (a full path name) into a filename.
32 Convert directory separation characters into ! characters.
33 Optional argument TESTMODE is used by tests to avoid conversion
34 to the file's truename, and dodging platform tricks."
35 (let ((file referencedir))
36 ;; Expand to full file name
37 (when (not testmode)
38 (setq file (file-truename file)))
39 ;; If FILE is a directory, then force it to end in /.
40 (when (file-directory-p file)
41 (setq file (file-name-as-directory file)))
42 ;; Handle Windows Special cases
43 (when (or (memq system-type '(windows-nt ms-dos)) testmode)
44 ;; Replace any invalid file-name characters (for the
45 ;; case of backing up remote files).
46 (when (not testmode)
47 (setq file (expand-file-name (convert-standard-filename file))))
48 ;; Normalize DOSish file names.
49 (if (eq (aref file 1) ?:)
50 (setq file (concat "/"
51 "drive_"
52 (char-to-string (downcase (aref file 0)))
53 (if (eq (aref file 2) ?/)
55 "/")
56 (substring file 2)))))
57 ;; Make the name unique by substituting directory
58 ;; separators. It may not really be worth bothering about
59 ;; doubling `!'s in the original name...
60 (setq file (subst-char-in-string
61 ?/ ?!
62 (replace-regexp-in-string "!" "!!" file)))
63 file))
65 (defun cedet-file-name-to-directory-name (referencefile &optional testmode)
66 "Reverse the process of `cedet-directory-name-to-file-name'.
67 Convert REFERENCEFILE to a directory name replacing ! with /.
68 Optional TESTMODE is used in tests to avoid doing some platform
69 specific conversions during tests."
70 (let ((file referencefile))
71 ;; Replace the ! with /
72 (setq file (subst-char-in-string ?! ?/ file))
73 ;; Occurrences of // meant there was once a single !.
74 (setq file (replace-regexp-in-string "//" "!" file))
76 ;; Handle Windows special cases
77 (when (or (memq system-type '(windows-nt ms-dos)) testmode)
79 ;; Handle drive letters from DOSish file names.
80 (when (string-match "^/drive_\\([a-z]\\)/" file)
81 (let ((driveletter (match-string 1 file))
83 (setq file (concat driveletter ":"
84 (substring file (match-end 1))))))
86 ;; Handle the \\file\name nomenclature on some Windows boxes.
87 (when (string-match "^!" file)
88 (setq file (concat "//" (substring file 1)))))
89 file))
91 (defun cedet-files-list-recursively (dir re)
92 "Returns list of files in directory matching to given regex"
93 (when (file-accessible-directory-p dir)
94 (let ((files (directory-files dir t))
95 matched)
96 (dolist (file files matched)
97 (let ((fname (file-name-nondirectory file)))
98 (cond
99 ((or (string= fname ".")
100 (string= fname "..")) nil)
101 ((and (file-regular-p file)
102 (string-match re fname))
103 (setq matched (cons file matched)))
104 ((file-directory-p file)
105 (let ((tfiles (cedet-files-list-recursively file re)))
106 (when tfiles (setq matched (append matched tfiles)))))))))))
109 (provide 'cedet-files)
111 ;;; cedet-files.el ends here