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 319, Mon Jun 7 22:47:00 1999 UTC revision 334, Thu Jun 17 02:43:15 1999 UTC
# Line 37  Line 37 
37            (flatten head rest)            (flatten head rest)
38          (cons head rest)))))          (cons head rest)))))
39    
40    (defun sml-preproc-alist (al)
41      "Expand an alist where keys can be lists of keys into a normal one."
42      (reduce (lambda (x al)
43                (let ((k (car x))
44                      (v (cdr x)))
45                  (if (consp k)
46                      (append (mapcar (lambda (y) (cons y v)) k) al)
47                    (cons x al))))
48              al
49              :initial-value nil
50              :from-end t))
51    
52    ;;;
53    ;;; temp files
54    ;;;
55    
56    (defvar temp-file-dir temporary-file-directory
57      "Directory where to put temp files.")
58    
59    (defvar temp-directories ())
60    
61    (defun delete-temp-dirs ()
62      (dolist (dir temp-directories)
63        (when (file-directory-p dir)
64          (let ((default-directory dir))
65            (dolist (file (directory-files "."))
66              (ignore-errors (delete-file file))))
67          (delete-directory dir))))
68    (add-hook 'kill-emacs-hook 'delete-temp-dirs)
69    
70    (defun make-temp-dir (s)
71      "Create a temporary directory.
72    The returned dir name (created by appending some random characters at the end
73    of S and prepending `temporary-file-directory' if it is not already absolute)
74    is guaranteed to point to a newly created empty directory."
75      (let* ((prefix (expand-file-name s temp-file-dir))
76             (dir (make-temp-name prefix)))
77        (if (not (ignore-errors (make-directory dir t) t))
78            (make-temp-dir prefix)
79          (push dir temp-directories)
80          (file-name-as-directory dir))))
81    
82    (defun make-temp-file (s)
83      "Create a temporary file.
84    The returned file name (created by appending some random characters at the end
85    of S and prepending `temporary-file-directory' if it is not already absolute)
86    is guaranteed to point to a newly created empty file."
87      (unless (file-name-absolute-p s)
88        (unless (equal (user-uid)
89                       (third (file-attributes temporary-file-directory)))
90          (setq temporary-file-directory (make-temp-dir "emacs")))
91        (setq s (expand-file-name s temporary-file-directory)))
92      (let ((file (make-temp-name s)))
93        (write-region 1 1 file nil 'silent)
94        file))
95    
96    ;; defmap ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97    
98  (defun custom-create-map (m bs args)  (defun custom-create-map (m bs args)
99    (unless (keymapp m)    (unless (keymapp m)
100      (setq bs (append m bs))      (setq bs (append m bs))
# Line 47  Line 105 
105        (cond        (cond
106         ((symbolp key)         ((symbolp key)
107          (substitute-key-definition key binding m global-map))          (substitute-key-definition key binding m global-map))
108         ((not (lookup-key m key))         ((let ((o (lookup-key m key))) (or (null o) (numberp o)))
109          (define-key m key binding)))))          (define-key m key binding)))))
110    (while args    (while args
111      (let ((key (first args))      (let ((key (first args))
# Line 58  Line 116 
116           ((keymapp val) (set-keymap-parent m val))           ((keymapp val) (set-keymap-parent m val))
117           (t (set-keymap-parents m val))))           (t (set-keymap-parents m val))))
118         (t (error "Uknown argument %s in defmap" key))))         (t (error "Uknown argument %s in defmap" key))))
119      (setq args (cddr args))))      (setq args (cddr args)))
120      m)
121    
122  (defmacro defmap (m bs doc &rest args)  (defmacro defmap (m bs doc &rest args)
123    `(progn    `(defconst ,m
124       (defvar ,m (make-sparse-keymap) ,doc)       (custom-create-map (if (boundp ',m) ,m) ,bs ,(cons 'list args))
125       (custom-create-map ,m ,bs ,(cons 'list args))))       ,doc))
126    
127  (defmacro defsyntax (st css doc &rest args)  ;; defsyntax ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
128    `(defvar ,st  
129       (let ((st (make-syntax-table ,(cadr (memq :copy args)))))  (defun custom-create-syntax (css args)
130         (dolist (cs ,css)    (let ((st (make-syntax-table (cadr (memq :copy args)))))
131        (dolist (cs css)
132           (let ((char (car cs))           (let ((char (car cs))
133                 (syntax (cdr cs)))                 (syntax (cdr cs)))
134             (if (sequencep char)             (if (sequencep char)
135                 (mapcar* (lambda (c) (modify-syntax-entry c syntax st))              (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
                         char)  
136               (modify-syntax-entry char syntax st))))               (modify-syntax-entry char syntax st))))
137         st)      st))
138       doc))  
139    (defmacro defsyntax (st css doc &rest args)
140      `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))
141    
142  ;;  ;;
143  (provide 'sml-util)  (provide 'sml-util)

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

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