adamc@350: ;;; urweb-compat.el --- Compatibility functions for Emacs variants for urweb-mode
adamc@350: 
adamc@350: ;; Based on sml-mode:
adamc@350: ;; Copyright (C) 1999, 2000, 2004  Stefan Monnier <monnier@gnu.org>
adamc@350: ;;
adamc@350: ;; Modified for urweb-mode:
adamc@350: ;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
adamc@350: ;;
adamc@350: ;; This program is free software; you can redistribute it and/or modify
adamc@350: ;; it under the terms of the GNU General Public License as published by
adamc@350: ;; the Free Software Foundation; either version 2 of the License, or
adamc@350: ;; (at your option) any later version.
adamc@350: ;;
adamc@350: ;; This program is distributed in the hope that it will be useful,
adamc@350: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
adamc@350: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
adamc@350: ;; GNU General Public License for more details.
adamc@350: ;;
adamc@350: ;; You should have received a copy of the GNU General Public License
adamc@350: ;; along with this program; if not, write to the Free Software
adamc@350: ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
adamc@350: 
adamc@350: ;;; Commentary:
adamc@350: 
adamc@350: ;;; Code:
adamc@350: 
adamc@350: (require 'cl)
adamc@350: 
adamc@350: (unless (fboundp 'set-keymap-parents)
adamc@350:   (defun set-keymap-parents (m parents)
adamc@350:     (if (keymapp parents) (setq parents (list parents)))
adamc@350:     (set-keymap-parent
adamc@350:      m
adamc@350:      (if (cdr parents)
adamc@350: 	 (reduce (lambda (m1 m2)
adamc@350: 		   (let ((m (copy-keymap m1)))
adamc@350: 		     (set-keymap-parent m m2) m))
adamc@350: 		 parents
adamc@350: 		 :from-end t)
adamc@350:        (car parents)))))
adamc@350: 
adamc@350: ;; for XEmacs
adamc@350: (when (fboundp 'temp-directory)
adamc@350:   (defvar temporary-file-directory (temp-directory)))
adamc@350: 
adamc@350: (unless (fboundp 'make-temp-file)
adamc@350:   ;; Copied from Emacs-21's subr.el
adamc@350:   (defun make-temp-file (prefix &optional dir-flag)
adamc@350:   "Create a temporary file.
adamc@350: The returned file name (created by appending some random characters at the end
adamc@350: of PREFIX, and expanding against `temporary-file-directory' if necessary,
adamc@350: is guaranteed to point to a newly created empty file.
adamc@350: You can then use `write-region' to write new data into the file.
adamc@350: 
adamc@350: If DIR-FLAG is non-nil, create a new empty directory instead of a file."
adamc@350:   (let (file)
adamc@350:     (while (condition-case ()
adamc@350: 	       (progn
adamc@350: 		 (setq file
adamc@350: 		       (make-temp-name
adamc@350: 			(expand-file-name prefix temporary-file-directory)))
adamc@350: 		 (if dir-flag
adamc@350: 		     (make-directory file)
adamc@350: 		   (write-region "" nil file nil 'silent))
adamc@350: 		 nil)
adamc@350: 	    (file-already-exists t))
adamc@350:       ;; the file was somehow created by someone else between
adamc@350:       ;; `make-temp-name' and `write-region', let's try again.
adamc@350:       nil)
adamc@350:     file)))
adamc@350: 
adamc@350: 
adamc@350: 
adamc@350: (unless (fboundp 'regexp-opt)
adamc@350:   (defun regexp-opt (strings &optional paren)
adamc@350:     (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
adamc@350:       (concat open (mapconcat 'regexp-quote strings "\\|") close))))
adamc@350: 
adamc@350: 
adamc@350: ;;;; 
adamc@350: ;;;; Custom
adamc@350: ;;;; 
adamc@350: 
adamc@350: ;; doesn't exist in Emacs < 20.1
adamc@350: (unless (fboundp 'set-face-bold-p)
adamc@350:   (defun set-face-bold-p (face v &optional f)
adamc@350:     (when v (ignore-errors (make-face-bold face)))))
adamc@350: (unless (fboundp 'set-face-italic-p)
adamc@350:   (defun set-face-italic-p (face v &optional f)
adamc@350:     (when v (ignore-errors (make-face-italic face)))))
adamc@350: 
adamc@350: ;; doesn't exist in Emacs < 20.1
adamc@350: (ignore-errors (require 'custom))
adamc@350: (unless (fboundp 'defgroup)
adamc@350:   (defmacro defgroup (&rest rest) ()))
adamc@350: (unless (fboundp 'defcustom)
adamc@350:   (defmacro defcustom (sym val str &rest rest) `(defvar ,sym ,val ,str)))
adamc@350: (unless (fboundp 'defface)
adamc@350:   (defmacro defface (sym val str &rest rest)
adamc@350:     `(defvar ,sym (make-face ',sym) ,str)))
adamc@350: 
adamc@350: (defvar :group ':group)
adamc@350: (defvar :type ':type)
adamc@350: (defvar :copy ':copy)
adamc@350: (defvar :dense ':dense)
adamc@350: (defvar :inherit ':inherit)
adamc@350: (defvar :suppress ':suppress)
adamc@350: 
adamc@350: (provide 'urweb-compat)
adamc@350: 
adamc@350: ;;; urweb-compat.el ends here