Mercurial > emacs
diff lisp/cedet/cedet-files.el @ 104438:33171bfc7147
cedet/cedet-files.el: New file.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 21:06:53 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/cedet-files.el Sun Aug 30 21:06:53 2009 +0000 @@ -0,0 +1,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