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