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 541, Fri Feb 18 20:35:43 2000 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  (unless (fboundp 'set-keymap-parents)  (unless (fboundp 'set-keymap-parents)
24    (defun set-keymap-parents (m parents)    (defun set-keymap-parents (m parents)
25        (if (keymapp parents) (setq parents (list parents)))
26      (set-keymap-parent      (set-keymap-parent
27       m (reduce (lambda (m1 m2)       m
28         (if (cdr parents)
29             (reduce (lambda (m1 m2)
30                   (let ((m (copy-keymap m1)))                   (let ((m (copy-keymap m1)))
31                     (set-keymap-parent m m2) m))                     (set-keymap-parent m m2) m))
32                 parents))))                   parents
33                     :from-end t)
34           (car parents)))))
35    
36    ;; for XEmacs
37    (when (and (not (boundp 'temporary-file-directory)) (fboundp 'temp-directory))
38      (defvar temporary-file-directory (temp-directory)))
39    
40    (unless (fboundp 'make-temp-file)
41      ;; Copied from Emacs-21's subr.el
42      (defun make-temp-file (prefix &optional dir-flag)
43      "Create a temporary file.
44    The returned file name (created by appending some random characters at the end
45    of PREFIX, and expanding against `temporary-file-directory' if necessary,
46    is guaranteed to point to a newly created empty file.
47    You can then use `write-region' to write new data into the file.
48    
49    If DIR-FLAG is non-nil, create a new empty directory instead of a file."
50      (let (file)
51        (while (condition-case ()
52                   (progn
53                     (setq file
54                           (make-temp-name
55                            (expand-file-name prefix temporary-file-directory)))
56                     (if dir-flag
57                         (make-directory file)
58                       (write-region "" nil file nil 'silent nil 'excl))
59                     nil)
60                (file-already-exists t))
61          ;; the file was somehow created by someone else between
62          ;; `make-temp-name' and `write-region', let's try again.
63          nil)
64        file)))
65    
66    
 ;;  
67  (provide 'sml-compat)  (provide 'sml-compat)
68    
69    ;;; sml-compat.el ends here

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

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