cgit.sxemacs.org Git - packages/blob - xemacs-packages/sml-mode/sml-compat.el

   1 ;;; sml-compat.el --- Compatibility functions for Emacs variants for sml-mode
   2
   3 ;; Copyright (C) 1999-2000  Stefan Monnier <monnier@cs.yale.edu>
   4 ;;
   5 ;; This program is free software; you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation; either version 2 of the License, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program; if not, write to the Free Software
  17 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19 ;;; Commentary:
  20
  21 ;;; Code:
  22
  23 (require 'cl)
  24
  25 (unless (fboundp 'set-keymap-parents)
  26   (defun set-keymap-parents (m parents)
  27     (if (keymapp parents) (setq parents (list parents)))
  28     (set-keymap-parent
  29      m
  30      (if (cdr parents)
  31          (reduce (lambda (m1 m2)
  32                    (let ((m (copy-keymap m1)))
  33                      (set-keymap-parent m m2) m))
  34                  parents
  35                  :from-end t)
  36        (car parents)))))
  37
  38 ;; for XEmacs
  39 (when (and (not (boundp 'temporary-file-directory)) (fboundp 'temp-directory))
  40   (defvar temporary-file-directory (temp-directory)))
  41
  42 (unless (fboundp 'make-temp-file)
  43   ;; Copied from Emacs-21's subr.el
  44   (defun make-temp-file (prefix &optional dir-flag)
  45   "Create a temporary file.
  46 The returned file name (created by appending some random characters at the end
  47 of PREFIX, and expanding against `temporary-file-directory' if necessary,
  48 is guaranteed to point to a newly created empty file.
  49 You can then use `write-region' to write new data into the file.
  50
  51 If DIR-FLAG is non-nil, create a new empty directory instead of a file."
  52   (let (file)
  53     (while (condition-case ()
  54                (progn
  55                  (setq file
  56                        (make-temp-name
  57                         (expand-file-name prefix temporary-file-directory)))
  58                  (if dir-flag
  59                      (make-directory file)
  60                    (write-region "" nil file nil 'silent nil))
  61                  nil)
  62             (file-already-exists t))
  63       ;; the file was somehow created by someone else between
  64       ;; `make-temp-name' and `write-region', let's try again.
  65       nil)
  66     file)))
  67
  68
  69
  70 (unless (fboundp 'regexp-opt)
  71   (defun regexp-opt (strings &optional paren)
  72     (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
  73       (concat open (mapconcat 'regexp-quote strings "\\|") close))))
  74
  75
  76 ;;;;
  77 ;;;; Custom
  78 ;;;;
  79
  80 ;; doesn't exist in Emacs < 20.1
  81 (unless (fboundp 'set-face-bold-p)
  82   (defun set-face-bold-p (face v &optional f)
  83     (when v (ignore-errors (make-face-bold face)))))
  84 (unless (fboundp 'set-face-italic-p)
  85   (defun set-face-italic-p (face v &optional f)
  86     (when v (ignore-errors (make-face-italic face)))))
  87
  88 ;; doesn't exist in Emacs < 20.1
  89 (ignore-errors (require 'custom))
  90 (unless (fboundp 'defgroup)
  91   (defmacro defgroup (&rest rest) ()))
  92 (unless (fboundp 'defcustom)
  93   (defmacro defcustom (sym val str &rest rest) `(defvar ,sym ,val ,str)))
  94 (unless (fboundp 'defface)
  95   (defmacro defface (sym val str &rest rest)
  96     `(defvar ,sym (make-face ',sym) ,str)))
  97
  98 (defvar :group ':group)
  99 (defvar :type ':type)
 100 (defvar :copy ':copy)
 101 (defvar :dense ':dense)
 102 (defvar :inherit ':inherit)
 103 (defvar :suppress ':suppress)
 104
 105 (provide 'sml-compat)
 106
 107 ;;; sml-compat.el ends here