Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/sml-mode/sml-compat.el
ViewVC logotype

Annotation of /sml/trunk/sml-mode/sml-compat.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 881 - (view) (download)

1 : monnier 541 ;;; sml-compat.el --- Compatibility functions for Emacs variants for sml-mode
2 : monnier 319
3 : monnier 541 ;; Copyright (C) 1999-2000 Stefan Monnier <monnier@cs.yale.edu>
4 : monnier 319 ;;
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 : monnier 541 ;;; Commentary:
20 : monnier 319
21 : monnier 541 ;;; Code:
22 :    
23 : monnier 881 (require 'cl)
24 :    
25 : monnier 319 (unless (fboundp 'set-keymap-parents)
26 :     (defun set-keymap-parents (m parents)
27 : monnier 535 (if (keymapp parents) (setq parents (list parents)))
28 : monnier 319 (set-keymap-parent
29 : monnier 332 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 : monnier 319
38 : monnier 535 ;; 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 'excl))
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 : monnier 536 file)))
67 : monnier 535
68 :    
69 : monnier 881
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 : monnier 319 (provide 'sml-compat)
106 : monnier 541
107 :     ;;; sml-compat.el ends here

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0