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-util.el
ViewVC logotype

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

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

revision 341, Fri Jun 18 19:10:12 1999 UTC revision 535, Fri Feb 18 16:49:10 2000 UTC
# Line 50  Line 50 
50            :from-end t))            :from-end t))
51    
52  ;;;  ;;;
53  ;;; temp files  ;;; defmap
54  ;;;  ;;;
55    
 (defvar temp-file-dir temporary-file-directory  
   "Directory where to put temp files.")  
   
 (defvar temp-directories ())  
   
 (defun delete-temp-dirs ()  
   (dolist (dir temp-directories)  
     (when (file-directory-p dir)  
       (let ((default-directory dir))  
         (dolist (file (directory-files "."))  
           (ignore-errors (delete-file file))))  
       (delete-directory dir))))  
 (add-hook 'kill-emacs-hook 'delete-temp-dirs)  
   
 (defun make-temp-dir (s)  
   "Create a temporary directory.  
 The returned dir name (created by appending some random characters at the end  
 of S and prepending `temporary-file-directory' if it is not already absolute)  
 is guaranteed to point to a newly created empty directory."  
   (let* ((prefix (expand-file-name s temp-file-dir))  
          (dir (make-temp-name prefix)))  
     (if (not (ignore-errors (make-directory dir t) t))  
         (make-temp-dir prefix)  
       (push dir temp-directories)  
       (file-name-as-directory dir))))  
   
 (defun make-temp-file (s)  
   "Create a temporary file.  
 The returned file name (created by appending some random characters at the end  
 of S and prepending `temporary-file-directory' if it is not already absolute)  
 is guaranteed to point to a newly created empty file."  
   (unless (file-name-absolute-p s)  
     (unless (equal (user-uid)  
                    (third (file-attributes temporary-file-directory)))  
       (setq temporary-file-directory (make-temp-dir "emacs")))  
     (setq s (expand-file-name s temporary-file-directory)))  
   (let ((file (make-temp-name s)))  
     (write-region 1 1 file nil 'silent)  
     file))  
   
 ;; defmap ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
   
56  (defun custom-create-map (m bs args)  (defun custom-create-map (m bs args)
57    (let (inherit dense)    (let (inherit dense suppress)
58      (while args      (while args
59        (let ((key (first args))        (let ((key (first args))
60              (val (second args)))              (val (second args)))
61          (cond          (cond
62           ((eq key :dense) (setq dense val))           ((eq key :dense) (setq dense val))
63           ((eq key :inherit) (setq inherit val))           ((eq key :inherit) (setq inherit val))
64             ((eq key :group) )
65             ;;((eq key :suppress) (setq suppress val))
66           (t (message "Uknown argument %s in defmap" key))))           (t (message "Uknown argument %s in defmap" key))))
67        (setq args (cddr args)))        (setq args (cddr args)))
68      (unless (keymapp m)      (unless (keymapp m)
69        (setq bs (append m bs))        (setq bs (append m bs))
70        (setq m (if dense (make-keymap) (make-sparse-keymap))))        (setq m (if dense (make-keymap) (make-sparse-keymap))))
71      (dolist (b bs)      (dolist (b bs)
72        (let ((key (car b))        (let ((keys (car b))
73              (binding (cdr b)))              (binding (cdr b)))
74            (dolist (key (if (consp keys) keys (list keys)))
75          (cond          (cond
76           ((symbolp key)           ((symbolp key)
77            (substitute-key-definition key binding m global-map))            (substitute-key-definition key binding m global-map))
78           ((let ((o (lookup-key m key))) (or (null o) (numberp o)))             ((null binding)
79            (define-key m key binding)))))              (unless (keymapp (lookup-key m key)) (define-key m key binding)))
80               ((let ((o (lookup-key m key)))
81                  (or (null o) (numberp o) (eq o 'undefined)))
82                (define-key m key binding))))))
83      (cond      (cond
84       ((keymapp inherit) (set-keymap-parent m inherit))       ((keymapp inherit) (set-keymap-parent m inherit))
85       ((consp inherit) (set-keymap-parents m inherit)))       ((consp inherit) (set-keymap-parents m inherit)))
# Line 141  Line 105 
105  (defmacro defsyntax (st css doc &rest args)  (defmacro defsyntax (st css doc &rest args)
106    `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))    `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))
107    
108    ;;;;
109    ;;;; Compatibility info
110    ;;;;
111    
112    (defvar sml-builtin-nested-comments-flag
113      (ignore-errors
114        (not (equal (let ((st (make-syntax-table)))
115                      (modify-syntax-entry ?\* ". 23n" st) st)
116                    (let ((st (make-syntax-table)))
117                      (modify-syntax-entry ?\* ". 23" st) st))))
118      "Whether this Emacs understands the `n' in syntax entries.")
119    
120  ;;  ;;
121  (provide 'sml-util)  (provide 'sml-util)

Legend:
Removed from v.341  
changed lines
  Added in v.535

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