diff options
| author | Jim Blandy | 1993-03-15 20:40:34 +0000 |
|---|---|---|
| committer | Jim Blandy | 1993-03-15 20:40:34 +0000 |
| commit | 7d18d35c95c5829bb0a23d16546471014c9af392 (patch) | |
| tree | 6225573147ccadc4697c56b5bce7d50ce7f5afe0 | |
| parent | c26406fef27bf84e38a2222f41cd464b33cdeee0 (diff) | |
| download | emacs-7d18d35c95c5829bb0a23d16546471014c9af392.tar.gz emacs-7d18d35c95c5829bb0a23d16546471014c9af392.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/emacs-lisp/lucid.el | 109 |
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. |
| 50 | This includes bindings inherited from a parent keymap. | 50 | This includes bindings inherited from a parent keymap. |
| 51 | FUNCTION receives two arguments each time it is called: | 51 | FUNCTION receives two arguments each time it is called: |
| 52 | the character (more generally, the event type) that is bound, | 52 | the character (more generally, the event type) that is bound, |
| 53 | and the binding it has." | 53 | and 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. | ||
| 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) | ||