Mercurial > urweb

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

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