aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1993-03-15 20:40:34 +0000
committerJim Blandy1993-03-15 20:40:34 +0000
commit7d18d35c95c5829bb0a23d16546471014c9af392 (patch)
tree6225573147ccadc4697c56b5bce7d50ce7f5afe0
parentc26406fef27bf84e38a2222f41cd464b33cdeee0 (diff)
downloademacs-7d18d35c95c5829bb0a23d16546471014c9af392.tar.gz
emacs-7d18d35c95c5829bb0a23d16546471014c9af392.zip
*** empty log message ***
-rw-r--r--lisp/emacs-lisp/lucid.el109
1 files changed, 98 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/lucid.el b/lisp/emacs-lisp/lucid.el
index 6412b0bc8f4..bd34ffa822d 100644
--- a/lisp/emacs-lisp/lucid.el
+++ b/lisp/emacs-lisp/lucid.el
@@ -45,19 +45,106 @@
45 (setcdr (cdr plist) (nthcdr 4 plist))) 45 (setcdr (cdr plist) (nthcdr 4 plist)))
46 (setq plist (cdr (cdr plist)))))) 46 (setq plist (cdr (cdr plist))))))
47 47
48(defun map-keymap (function keymap) 48(defun map-keymap (function keymap &optional sort-first)
49 "Call FUNCTION for every binding in KEYMAP. 49 "Call FUNCTION for every binding in KEYMAP.
50This includes bindings inherited from a parent keymap. 50This includes bindings inherited from a parent keymap.
51FUNCTION receives two arguments each time it is called: 51FUNCTION receives two arguments each time it is called:
52the character (more generally, the event type) that is bound, 52the character (more generally, the event type) that is bound,
53and the binding it has." 53and the binding it has."
54 (while (consp keymap) 54 (if sort-first
55 (if (consp (car keymap)) 55 (let (list)
56 (funcall function (car (car keymap)) (cdr (car keymap))) 56 (map-keymap (function (lambda (a b)
57 (if (vectorp (car keymap)) 57 (setq list (cons (cons a b) list))))
58 (let ((i (length (car keymap))) 58 keymap)
59 (vector (car keymap))) 59 (setq list (sort list
60 (while (>= i 0) 60 (function (lambda (a b)
61 (funcall function i (aref vector i)) 61 (setq a (car a) b (car b))
62 (setq i (1- i)))))) 62 (if (integerp a)
63 (setq keymap (cdr keymap)))) 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.
92With a numeric arg N, switch to the Nth most recent buffer.
93With an arg of 0, buries the current buffer at the
94bottom 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)
144ll (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)