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))))))
|
2168
|
47
|
2206
|
48 (defun map-keymap (function keymap &optional sort-first)
|
2168
|
49 "Call FUNCTION for every binding in KEYMAP.
|
|
50 This includes bindings inherited from a parent keymap.
|
|
51 FUNCTION receives two arguments each time it is called:
|
|
52 the character (more generally, the event type) that is bound,
|
|
53 and the binding it has."
|
2206
|
54 (if sort-first
|
|
55 (let (list)
|
|
56 (map-keymap (function (lambda (a b)
|
|
57 (setq list (cons (cons a b) list))))
|
|
58 keymap)
|
|
59 (setq list (sort list
|
|
60 (function (lambda (a b)
|
|
61 (setq a (car a) b (car b))
|
|
62 (if (integerp a)
|
|
63 (if (integerp b) (< a b)
|
|
64 t)
|
|
65 (if (integerp b) t
|
|
66 (string< a b)))))))
|
|
67 (while list
|
|
68 (funcall function (car (car list)) (cdr (car list)))
|
|
69 (setq list (cdr list))))
|
|
70 (while (consp keymap)
|
|
71 (if (consp (car keymap))
|
|
72 (funcall function (car (car keymap)) (cdr (car keymap)))
|
|
73 (if (vectorp (car keymap))
|
|
74 (let ((i (1- (length (car keymap))))
|
|
75 (vector (car keymap)))
|
|
76 (while (>= i 0)
|
|
77 (funcall function i (aref vector i))
|
|
78 (setq i (1- i))))))
|
|
79 (setq keymap (cdr keymap)))))
|
|
80
|
|
81 (defun real-path-name (name &optional default)
|
|
82 (file-truename (expand-file-name name default)))
|
|
83
|
|
84 ;; It's not clear what to return if the mouse is not in FRAME.
|
|
85 (defun read-mouse-position (frame)
|
|
86 (let ((pos (mouse-position)))
|
|
87 (if (eq (car pos) frame)
|
|
88 (cdr pos))))
|
|
89
|
|
90 (defun switch-to-other-buffer (arg)
|
|
91 "Switch to the previous buffer.
|
|
92 With a numeric arg N, switch to the Nth most recent buffer.
|
|
93 With an arg of 0, buries the current buffer at the
|
|
94 bottom of the buffer stack."
|
|
95 (interactive "p")
|
|
96 (if (eq arg 0)
|
|
97 (bury-buffer (current-buffer)))
|
|
98 (switch-to-buffer
|
|
99 (if (<= arg 1) (other-buffer (current-buffer))
|
|
100 (nth (1+ arg) (buffer-list)))))
|
|
101
|
|
102 ;; Support the Lucid names with `screen' instead of `frame'.
|
|
103
|
|
104 (fset 'current-screen-configuration 'current-frame-configuration)
|
|
105 (fset 'delete-screen 'delete-frame)
|
|
106 (fset 'find-file-new-screen 'find-file-other-frame)
|
|
107 (fset 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
|
|
108 (fset 'find-tag-new-screen 'find-tag-other-frame)
|
|
109 ;;(fset 'focus-screen 'focus-frame)
|
|
110 (fset 'iconify-screen 'iconify-frame)
|
|
111 (fset 'mail-new-screen 'mail-other-frame)
|
|
112 (fset 'make-screen-invisible 'make-frame-invisible)
|
|
113 (fset 'make-screen-visible 'make-frame-visible)
|
|
114 ;; (fset 'minibuffer-screen-list 'minibuffer-frame-list)
|
|
115 (fset 'modify-screen-parameters 'modify-frame-parameters)
|
|
116 (fset 'next-screen 'next-frame)
|
|
117 ;; (fset 'next-multiscreen-window 'next-multiframe-window)
|
|
118 ;; (fset 'previous-multiscreen-window 'previous-multiframe-window)
|
|
119 ;; (fset 'redirect-screen-focus 'redirect-frame-focus)
|
|
120 (fset 'redraw-screen 'redraw-frame)
|
|
121 ;; (fset 'screen-char-height 'frame-char-height)
|
|
122 ;; (fset 'screen-char-width 'frame-char-width)
|
|
123 ;; (fset 'screen-configuration-to-register 'frame-configuration-to-register)
|
|
124 ;; (fset 'screen-focus 'frame-focus)
|
|
125 (fset 'screen-height 'frame-height)
|
|
126 (fset 'screen-list 'frame-list)
|
|
127 ;; (fset 'screen-live-p 'frame-live-p)
|
|
128 (fset 'screen-parameters 'frame-parameters)
|
|
129 (fset 'screen-pixel-height 'frame-pixel-height)
|
|
130 (fset 'screen-pixel-width 'frame-pixel-width)
|
|
131 (fset 'screen-root-window 'frame-root-window)
|
|
132 (fset 'screen-selected-window 'frame-selected-window)
|
|
133 (fset 'lower-screen 'frame-to-back)
|
|
134 (fset 'raise-screen 'frame-to-front)
|
|
135 (fset 'screen-visible-p 'frame-visible-p)
|
|
136 (fset 'screen-width 'frame-width)
|
|
137 (fset 'screenp 'framep)
|
|
138 (fset 'select-screen 'select-frame)
|
|
139 (fset 'selected-screen 'selected-frame)
|
|
140 ;; (fset 'set-screen-configuration 'set-frame-configuration)
|
|
141 ;; (fset 'set-screen-height 'set-frame-height)
|
|
142 (fset 'set-screen-position 'set-frame-position)
|
|
143 (fset 'set-screen-size 'set-frame-size)
|
|
144 ll (fset 'set-screen-width 'set-frame-width)
|
|
145 (fset 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
|
|
146 ;; (fset 'unfocus-screen 'unfocus-frame)
|
|
147 (fset 'visible-screen-list 'visible-frame-list)
|
|
148 (fset 'window-screen 'window-frame)
|
|
149 (fset 'x-create-screen 'x-create-frame)
|
|
150 (fset 'x-new-screen 'new-frame)
|