cgit.sxemacs.org Git - packages/blob - xemacs-packages/cedet-common/cedet-compat.el

   1 ;;; cedet-compat.el --- Compatibility across (X)Emacs versions
   2
   3 ;; Copyright (C) 2003, 2007 David Ponce
   4
   5 ;; Author: David Ponce <david@dponce.com>
   6 ;; Maintainer: David Ponce <david@dponce.com>
   7 ;; Keywords: compatibility
   8 ;; X-RCS: $Id: cedet-compat.el,v 1.1 2007-11-26 15:06:38 michaels Exp $
   9
  10 ;; This file is not part of Emacs
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; This library provides functions to allow running CEDET packages on
  30 ;; a variety of [X]Emacs versions.
  31
  32 ;;; Code:
  33
  34 (when (not (fboundp 'compare-strings))
  35
  36 ;; XEmacs does not have the `compare-strings' function.  Here is an
  37 ;; implementation in Emacs Lisp, derived from the C implementation
  38 ;; found in src/fns.c, in GNU Emacs 21.3.1 sources.
  39 ;;;###autoload
  40 (defun compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case)
  41   "Compare the contents of two strings.
  42 In string STR1, skip the first START1 characters and stop at END1.
  43 In string STR2, skip the first START2 characters and stop at END2.
  44 END1 and END2 default to the full lengths of the respective strings.
  45
  46 Case is significant in this comparison if IGNORE-CASE is nil.
  47
  48 The value is t if the strings (or specified portions) match.
  49 If string STR1 is less, the value is a negative number N;
  50   - 1 - N is the number of characters that match at the beginning.
  51 If string STR1 is greater, the value is a positive number N;
  52   N - 1 is the number of characters that match at the beginning."
  53   (or start1 (setq start1 0))
  54   (or start2 (setq start2 0))
  55   (setq end1 (if end1
  56                  (min end1 (length str1))
  57                (length str1)))
  58   (setq end2 (if end2
  59                  (min end2 (length str2))
  60                (length str2)))
  61   (let ((i1 start1)
  62         (i2 start2)
  63         result c1 c2)
  64     (while (and (not result) (< i1 end1) (< i2 end2))
  65       (setq c1 (aref str1 i1)
  66             c2 (aref str2 i2)
  67             i1 (1+ i1)
  68             i2 (1+ i2))
  69       (if ignore-case
  70           (setq c1 (upcase c1)
  71                 c2 (upcase c2)))
  72       (setq result (cond ((< c1 c2) (- i1))
  73                          ((> c1 c2) i1))))
  74     (or result
  75         (cond ((< i1 end1) (1+ (- i1 start1)))
  76               ((< i2 end2) (1- (- start1 i1)))
  77               (t)))
  78     ))
  79
  80 )
  81
  82 ;; subst-char-in-string is not found on the XEmacs <= 21.4.  Provide
  83 ;; here for compatibility.
  84 (if (not (fboundp 'subst-char-in-string))
  85
  86 ;;;###autoload
  87 (defun subst-char-in-string (fromchar tochar string &optional inplace)
  88   ;; From Emacs 21.3/lisp/subr.el
  89   "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
  90 Unless optional argument INPLACE is non-nil, return a new string."
  91   (let ((i (length string))
  92         (newstr (if inplace string (copy-sequence string))))
  93     (while (> i 0)
  94       (setq i (1- i))
  95       (if (eq (aref newstr i) fromchar)
  96           (aset newstr i tochar)))
  97     newstr))
  98
  99 )
 100
 101
 102 (provide 'cedet-compat)
 103
 104 ;;; cedet-compat.el ends here