diff src/elisp/urweb-compat.el @ 350:3a1e36b14105

First sort-of-working run of urweb-mode
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Oct 2008 10:04:17 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/elisp/urweb-compat.el	Sun Oct 12 10:04:17 2008 -0400
@@ -0,0 +1,111 @@
+;;; urweb-compat.el --- Compatibility functions for Emacs variants for urweb-mode
+
+;; Based on sml-mode:
+;; Copyright (C) 1999, 2000, 2004  Stefan Monnier <monnier@gnu.org>
+;;
+;; Modified for urweb-mode:
+;; Copyright (C) 2008  Adam Chlipala <adamc@hcoop.net>
+;;
+;; 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 (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)
+	    (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 'urweb-compat)
+
+;;; urweb-compat.el ends here