lisp/cedet/cedet-files.el

   1 ;;; cedet-files.el --- Common routines dealing with file names.
   2
   3 ;; Copyright (C) 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6 ;; Package: cedet
   7
   8 ;; This file is part of GNU Emacs.
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; Various useful routines for dealing with file names in the tools
  26 ;; which are a part of CEDET.
  27
  28 ;;; Code:
  29
  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) ?/)
  54                                  ""
  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))
  64
  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))
  75
  76     ;; Handle Windows special cases
  77     (when (or (memq system-type '(windows-nt ms-dos)) testmode)
  78
  79       ;; Handle drive letters from DOSish file names.
  80       (when (string-match "^/drive_\\([a-z]\\)/" file)
  81         (let ((driveletter (match-string 1 file))
  82               )
  83           (setq file (concat driveletter ":"
  84                              (substring file (match-end 1))))))
  85
  86       ;; Handle the \\file\name nomenclature on some windows boxes.
  87       (when (string-match "^!" file)
  88         (setq file (concat "//" (substring file 1)))))
  89     file))
  90
  91 (provide 'cedet-files)
  92
  93 ;; arch-tag: 4884c616-82c3-475d-ac9f-039e3431a702
  94 ;;; cedet-files.el ends here