annotate lisp/emacs-lisp/lucid.el @ 2089:cc2e35185964

*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Tue, 09 Mar 1993 23:40:36 +0000
parents aa90bb7c515b
children af8f27940f79
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2088
aa90bb7c515b Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 (defun add-timeout (secs function object &optional resignal)
aa90bb7c515b Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2 (run-at-time secs resignal function object))
aa90bb7c515b Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
aa90bb7c515b Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 (defun disable-timeout (timeout)
aa90bb7c515b Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 (cancel-timer timeout))
2089
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
6
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
7 (defun copy-tree (tree)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
8 (if (consp tree)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
9 (cons (copy-tree (car tree))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
10 (copy-tree (cdr tree)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
11 (if (vectorp tree)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
12 (let ((new (copy-sequence tree))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
13 (i (1- (length new))))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
14 (while (>= i 0)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
15 (aset new i (copy-tree (aref new i)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
16 (setq i (1- i)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
17 new)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
18 tree)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
19
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
20 (fset 'current-time-seconds 'current-time)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
21
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
22 (defun keymap-parent (keymap)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
23 (let ((tail (cdr keymap)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
24 (while (and tail (not (eq (car tail) 'keymap)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
25 (setq tail (cdr tail)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
26 tail))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
27
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
28 (defun set-keymap-parent (keymap new-parent)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
29 (let ((tail (cdr keymap)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
30 (while (and tail (cdr tail) (not (eq (car (cdr tail)) 'keymap)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
31 (setq tail (cdr tail)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
32 (if tail
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
33 (setcdr tail new-parent))))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
34
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
35 (defun remove-hook (hook-var function)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
36 (if (boundp 'hook-var)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
37 (set hook-var (delq function (symbol-value hook-var)))))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
38
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
39 (defun remprop (symbol prop)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
40 (let ((plist (symbol-plist symbol)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
41 (while (eq (car plist) prop)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
42 (setplist symbol (setq plist (cdr (cdr plist)))))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
43 (while plist
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
44 (if (eq (nth 2 plist) prop)
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
45 (setcdr (cdr plist) (nthcdr 4 plist)))
cc2e35185964 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 2088
diff changeset
46 (setq plist (cdr (cdr plist))))))