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

Parent Directory | Revision Log | Patch

	revision 331, Sat Jun 12 15:04:53 1999 UTC	revision 332, Tue Jun 15 00:51:38 1999 UTC
#	Line 37	Line 37
37	(flatten head rest)	(flatten head rest)
38	(cons head rest)))))	(cons head rest)))))
39
40		;;;
41		;;; temp files
42		;;;
43
44		(defvar temp-file-dir temporary-file-directory
45		"Directory where to put temp files.")
46
47		(defvar temp-directories ())
48
49		(defun delete-temp-dirs ()
50		(dolist (dir temp-directories)
51		(when (file-directory-p dir)
52		(let ((default-directory dir))
53		(dolist (file (directory-files "."))
54		(ignore-errors (delete-file file))))
55		(delete-directory dir))))
56		(add-hook 'kill-emacs-hook 'delete-temp-dirs)
57
58		(defun make-temp-dir (s)
59		(let* ((prefix (expand-file-name s temp-file-dir))
60		(dir (make-temp-name prefix)))
61		(if (not (ignore-errors (make-directory dir t) t))
62		(make-temp-dir prefix)
63		(push dir temp-directories)
64		dir)))
65
66		(defun make-temp-file (s)
67		(unless (file-name-absolute-p s)
68		(unless (equal (user-uid)
69		(third (file-attributes temporary-file-directory)))
70		(setq temporary-file-directory (make-temp-dir "emacs")))
71		(setq s (expand-file-name s temporary-file-directory)))
72		(let ((file (make-temp-name s)))
73		(write-region 1 1 file nil 'silent)
74		file))
75
76		;; defmap ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
77
78	(defun custom-create-map (m bs args)	(defun custom-create-map (m bs args)
79	(unless (keymapp m)	(unless (keymapp m)
80	(setq bs (append m bs))	(setq bs (append m bs))
#	Line 47	Line 85
85	(cond	(cond
86	((symbolp key)	((symbolp key)
87	(substitute-key-definition key binding m global-map))	(substitute-key-definition key binding m global-map))
88	((not (lookup-key m key))	((let ((o (lookup-key m key))) (or (null o) (numberp o)))
89	(define-key m key binding)))))	(define-key m key binding)))))
90	(while args	(while args
91	(let ((key (first args))	(let ((key (first args))
#	Line 58	Line 96
96	((keymapp val) (set-keymap-parent m val))	((keymapp val) (set-keymap-parent m val))
97	(t (set-keymap-parents m val))))	(t (set-keymap-parents m val))))
98	(t (error "Uknown argument %s in defmap" key))))	(t (error "Uknown argument %s in defmap" key))))
99	(setq args (cddr args))))	(setq args (cddr args)))
100		m)
101
102	(defmacro defmap (m bs doc &rest args)	(defmacro defmap (m bs doc &rest args)
103	`(progn	`(defconst ,m
104	(defvar ,m (make-sparse-keymap) ,doc)	(custom-create-map (if (boundp ',m) ,m) ,bs ,(cons 'list args))
105	(custom-create-map ,m ,bs ,(cons 'list args))))	,doc))
106
107	(defmacro defsyntax (st css doc &rest args)	;; defsyntax ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
108	`(defvar ,st
109	(let ((st (make-syntax-table ,(cadr (memq :copy args)))))	(defun custom-create-syntax (css args)
110	(dolist (cs ,css)	(let ((st (make-syntax-table (cadr (memq :copy args)))))
111		(dolist (cs css)
112	(let ((char (car cs))	(let ((char (car cs))
113	(syntax (cdr cs)))	(syntax (cdr cs)))
114	(if (sequencep char)	(if (sequencep char)
115	(mapcar* (lambda (c) (modify-syntax-entry c syntax st))	(mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
	char)
116	(modify-syntax-entry char syntax st))))	(modify-syntax-entry char syntax st))))
117	st)	st))
118	doc))
119		(defmacro defsyntax (st css doc &rest args)
120		`(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))
121
122	;;	;;
123	(provide 'sml-util)	(provide 'sml-util)

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.331   changed lines   Added in v.332

---

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