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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 319, Mon Jun 7 22:47:00 1999 UTC revision 881, Thu Jul 19 20:07:53 2001 UTC
# Line 1  Line 1 
1  ;;; sml-compat.el  ;;; sml-compat.el --- Compatibility functions for Emacs variants for sml-mode
2    
3  (defconst rcsid-sml-compat "@(#)$Name$:$Id$")  ;; Copyright (C) 1999-2000  Stefan Monnier <monnier@cs.yale.edu>
   
 ;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>  
4  ;;  ;;
5  ;; This program is free software; you can redistribute it and/or modify  ;; 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  ;; it under the terms of the GNU General Public License as published by
# Line 18  Line 16 
16  ;; along with this program; if not, write to the Free Software  ;; along with this program; if not, write to the Free Software
17  ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18    
19  ;;  ;;; Commentary:
20    
21    ;;; Code:
22    
23    (require 'cl)
24    
25  (unless (fboundp 'set-keymap-parents)  (unless (fboundp 'set-keymap-parents)
26    (defun set-keymap-parents (m parents)    (defun set-keymap-parents (m parents)
27        (if (keymapp parents) (setq parents (list parents)))
28      (set-keymap-parent      (set-keymap-parent
29       m (reduce (lambda (m1 m2)       m
30         (if (cdr parents)
31             (reduce (lambda (m1 m2)
32                   (let ((m (copy-keymap m1)))                   (let ((m (copy-keymap m1)))
33                     (set-keymap-parent m m2) m))                     (set-keymap-parent m m2) m))
34                 parents))))                   parents
35                     :from-end t)
36           (car parents)))))
37    
38    ;; 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        file)))
67    
68    
69    
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  (provide 'sml-compat)  (provide 'sml-compat)
106    
107    ;;; sml-compat.el ends here

Legend:
Removed from v.319  
changed lines
  Added in v.881

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