2088
|
1 (defun add-timeout (secs function object &optional resignal)
|
|
2 (run-at-time secs resignal function object))
|
|
3
|
|
4 (defun disable-timeout (timeout)
|
|
5 (cancel-timer timeout))
|
2089
|
6
|
|
7 (defun copy-tree (tree)
|
|
8 (if (consp tree)
|
|
9 (cons (copy-tree (car tree))
|
|
10 (copy-tree (cdr tree)))
|
|
11 (if (vectorp tree)
|
|
12 (let ((new (copy-sequence tree))
|
|
13 (i (1- (length new))))
|
|
14 (while (>= i 0)
|
|
15 (aset new i (copy-tree (aref new i)))
|
|
16 (setq i (1- i)))
|
|
17 new)
|
|
18 tree)))
|
|
19
|
|
20 (fset 'current-time-seconds 'current-time)
|
|
21
|
|
22 (defun keymap-parent (keymap)
|
|
23 (let ((tail (cdr keymap)))
|
|
24 (while (and tail (not (eq (car tail) 'keymap)))
|
|
25 (setq tail (cdr tail)))
|
|
26 tail))
|
|
27
|
|
28 (defun set-keymap-parent (keymap new-parent)
|
|
29 (let ((tail (cdr keymap)))
|
|
30 (while (and tail (cdr tail) (not (eq (car (cdr tail)) 'keymap)))
|
|
31 (setq tail (cdr tail)))
|
|
32 (if tail
|
|
33 (setcdr tail new-parent))))
|
|
34
|
|
35 (defun remove-hook (hook-var function)
|
|
36 (if (boundp 'hook-var)
|
|
37 (set hook-var (delq function (symbol-value hook-var)))))
|
|
38
|
|
39 (defun remprop (symbol prop)
|
|
40 (let ((plist (symbol-plist symbol)))
|
|
41 (while (eq (car plist) prop)
|
|
42 (setplist symbol (setq plist (cdr (cdr plist)))))
|
|
43 (while plist
|
|
44 (if (eq (nth 2 plist) prop)
|
|
45 (setcdr (cdr plist) (nthcdr 4 plist)))
|
|
46 (setq plist (cdr (cdr plist))))))
|