code.delx.au - gnu-emacs/blob - lisp/cedet/cedet-files.el

   1 ;;; cedet-files.el --- Common routines dealing with file names.
   2
   3 ;; Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012  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
  29 (defun cedet-directory-name-to-file-name (referencedir &optional testmode)
  30   "Convert the REFERENCEDIR (a full path name) into a filename.
  31 Convert directory separation characters into ! characters.
  32 Optional argument TESTMODE is used by tests to avoid conversion
  33 to the file's truename, and dodging platform tricks."
  34   (let ((file referencedir))
  35     ;; Expand to full file name
  36     (when (not testmode)
  37       (setq file (file-truename file)))
  38     ;; If FILE is a directory, then force it to end in /.
  39     (when (file-directory-p file)
  40       (setq file (file-name-as-directory file)))
  41     ;; Handle Windows Special cases
  42     (when (or (memq system-type '(windows-nt ms-dos)) testmode)
  43       ;; Replace any invalid file-name characters (for the
  44       ;; case of backing up remote files).
  45       (when (not testmode)
  46         (setq file (expand-file-name (convert-standard-filename file))))
  47       ;; Normalize DOSish file names.
  48       (if (eq (aref file 1) ?:)
  49           (setq file (concat "/"
  50                              "drive_"
  51                              (char-to-string (downcase (aref file 0)))
  52                              (if (eq (aref file 2) ?/)
  53                                  ""
  54                                "/")
  55                              (substring file 2)))))
  56     ;; Make the name unique by substituting directory
  57     ;; separators.  It may not really be worth bothering about
  58     ;; doubling `!'s in the original name...
  59     (setq file (subst-char-in-string
  60                 ?/ ?!
  61                 (replace-regexp-in-string "!" "!!" file)))
  62     file))
  63
  64 (defun cedet-file-name-to-directory-name (referencefile &optional testmode)
  65   "Reverse the process of `cedet-directory-name-to-file-name'.
  66 Convert REFERENCEFILE to a directory name replacing ! with /.
  67 Optional TESTMODE is used in tests to avoid doing some platform
  68 specific conversions during tests."
  69   (let ((file referencefile))
  70     ;; Replace the ! with /
  71     (setq file (subst-char-in-string ?! ?/ file))
  72     ;; Occurrences of // meant there was once a single !.
  73     (setq file (replace-regexp-in-string "//" "!" file))
  74
  75     ;; Handle Windows special cases
  76     (when (or (memq system-type '(windows-nt ms-dos)) testmode)
  77
  78       ;; Handle drive letters from DOSish file names.
  79       (when (string-match "^/drive_\\([a-z]\\)/" file)
  80         (let ((driveletter (match-string 1 file))
  81               )
  82           (setq file (concat driveletter ":"
  83                              (substring file (match-end 1))))))
  84
  85       ;; Handle the \\file\name nomenclature on some windows boxes.
  86       (when (string-match "^!" file)
  87         (setq file (concat "//" (substring file 1)))))
  88     file))
  89
  90 (provide 'cedet-files)
  91
  92 ;; arch-tag: 4884c616-82c3-475d-ac9f-039e3431a702
  93 ;;; cedet-files.el ends here