cgit.sxemacs.org Git - packages/blob - xemacs-packages/pcl-cvs/cvs-compat.el

   1 ;;; cvs-compat.el --- Compatibility functions for various Emacsen
   2
   3 ;; Copyright (C) 1999-2000  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: compatibility
   7 ;; Version: v2_9_9
   8 ;; Revision: cvs-compat.el,v 1.3 2000/03/05 21:32:21 monnier Exp
   9
  10 ;; This program 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 2 of the License, or
  13 ;; (at your option) any later version.
  14 ;;
  15 ;; This program 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 this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; History:
  27
  28 ;;; Code:
  29
  30 (require 'cl)
  31
  32 ;;;;
  33 ;;;; String Processing
  34 ;;;;
  35
  36 ;; doesn't exist in Emacs < 20.1
  37 (eval-when-compile (autoload 'string-split "string"))
  38 (unless (fboundp 'split-string)
  39   ;; define it in terms of elib's string's string-split
  40   (require 'string)
  41   (defun split-string (str &optional sep)
  42     ;; this is not quite correct since we should only eliminate
  43     ;; a leading and a trailing empty string, but it's enough for our use.
  44     (delete-if (lambda (str) (string= str "")) (string-split sep str))))
  45
  46 ;; too bad it's only provided by dired rather than by some "neutral" lib.
  47 (unless (fboundp 'string-replace-match)
  48   (require 'dired)
  49   (if (fboundp 'dired-string-replace-match)
  50       (defalias 'string-replace-match 'dired-string-replace-match)
  51     (require 'string)))
  52
  53 ;;;;
  54 ;;;; Buffer management
  55 ;;;;
  56
  57 ;; doesn't exist in Emacs < 20.1
  58 (unless (fboundp 'save-current-buffer)
  59   (defmacro save-current-buffer (&rest body)
  60     (let ((sym (make-symbol "curbuf")))
  61       `(let ((,sym (current-buffer)))
  62          (unwind-protect (progn ,@body) (set-buffer ,sym))))))
  63
  64 ;; doesn't exist in Emacs < 20.1
  65 (unless (fboundp 'with-current-buffer)
  66   (defmacro with-current-buffer (buf &rest body)
  67     `(save-current-buffer (set-buffer ,buf) ,@body)))
  68
  69 ;;;;
  70 ;;;; Keymaps
  71 ;;;;
  72
  73 ;; doesn't exist in Emacs < 20.1
  74 (unless (fboundp 'set-keymap-parent)
  75   (defun set-keymap-parent (keymap parent)
  76     (unless (and (consp keymap) (eq 'keymap (car keymap)))
  77       (error "Unknown keymap type"))
  78     (setf (cdr (last keymap)) parent)))
  79
  80 ;; doesn't exist in Emacs
  81 (unless (fboundp 'set-keymap-parents)
  82   (defun set-keymap-parents (m parents)
  83     (if (keymapp parents) (setq parents (list parents)))
  84     (set-keymap-parent
  85      m
  86      (if (cdr parents)
  87          (reduce (lambda (m1 m2)
  88                    (let ((m (copy-keymap m1)))
  89                      (set-keymap-parent m m2) m))
  90                  parents
  91                  :from-end t)
  92        (car parents)))))
  93
  94 ;;;;
  95 ;;;; Custom
  96 ;;;;
  97
  98 ;; doesn't exist in Emacs < 20.1
  99 (unless (fboundp 'set-face-bold-p)
 100   (defun set-face-bold-p (face v &optional f)
 101     (when v (ignore-errors (make-face-bold face)))))
 102 (unless (fboundp 'set-face-italic-p)
 103   (defun set-face-italic-p (face v &optional f)
 104     (when v (ignore-errors (make-face-italic face)))))
 105
 106 ;; doesn't exist in Emacs < 20.1
 107 (ignore-errors (require 'custom))
 108 (unless (fboundp 'defgroup)
 109   (defmacro defgroup (&rest rest) ()))
 110 (unless (fboundp 'defcustom)
 111   (defmacro defcustom (sym val str &rest rest) `(defvar ,sym ,val ,str)))
 112 (unless (fboundp 'defface)
 113   (defmacro defface (sym val str &rest rest)
 114     `(defvar ,sym (make-face ',sym) ,str)))
 115
 116 ;;;;
 117 ;;;; missing functions in Emacs
 118 ;;;;
 119
 120 ;; doesn't exist in Emacs
 121 (unless (fboundp 'read-directory-name)
 122   (defalias 'read-directory-name 'read-file-name))
 123
 124
 125 (provide 'cvs-compat)
 126 ;;; cvs-compat.el ends here