lisp/cedet/cedet-files.el

   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