diff lisp/emacs-lisp/lucid.el @ 2206:c3bec907580c

*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Mon, 15 Mar 1993 20:40:34 +0000
parents af8f27940f79
children d4cc427a53dd
line wrap: on
line diff
--- a/lisp/emacs-lisp/lucid.el	Mon Mar 15 20:17:07 1993 +0000
+++ b/lisp/emacs-lisp/lucid.el	Mon Mar 15 20:40:34 1993 +0000
@@ -45,19 +45,106 @@
 	  (setcdr (cdr plist) (nthcdr 4 plist)))
       (setq plist (cdr (cdr plist))))))
 
-(defun map-keymap (function keymap)
+(defun map-keymap (function keymap &optional sort-first)
   "Call FUNCTION for every binding in KEYMAP.
 This includes bindings inherited from a parent keymap.
 FUNCTION receives two arguments each time it is called:
 the character (more generally, the event type) that is bound,
 and the binding it has."
-  (while (consp keymap)
-    (if (consp (car keymap))
-	(funcall function (car (car keymap)) (cdr (car keymap)))
-      (if (vectorp (car keymap))
-	  (let ((i (length (car keymap)))
-		(vector (car keymap)))
-	    (while (>= i 0)
-	      (funcall function i (aref vector i))
-	      (setq i (1- i))))))
-    (setq keymap (cdr keymap))))
+  (if sort-first
+      (let (list)
+	(map-keymap (function (lambda (a b)
+				(setq list (cons (cons a b) list))))
+		    keymap)
+	(setq list (sort list
+			 (function (lambda (a b)
+				     (setq a (car a) b (car b))
+				     (if (integerp a)
+					 (if (integerp b) (< a b)
+					   t)
+				       (if (integerp b) t
+					 (string< a b)))))))
+	(while list
+	  (funcall function (car (car list)) (cdr (car list)))
+	  (setq list (cdr list))))
+    (while (consp keymap)
+      (if (consp (car keymap))
+	  (funcall function (car (car keymap)) (cdr (car keymap)))
+	(if (vectorp (car keymap))
+	    (let ((i (1- (length (car keymap))))
+		  (vector (car keymap)))
+	      (while (>= i 0)
+		(funcall function i (aref vector i))
+		(setq i (1- i))))))
+      (setq keymap (cdr keymap)))))
+
+(defun real-path-name (name &optional default)
+  (file-truename (expand-file-name name default)))
+
+;; It's not clear what to return if the mouse is not in FRAME.
+(defun read-mouse-position (frame)
+  (let ((pos (mouse-position)))
+    (if (eq (car pos) frame)
+	(cdr pos))))
+
+(defun switch-to-other-buffer (arg)
+  "Switch to the previous buffer.
+With a numeric arg N, switch to the Nth most recent buffer.
+With an arg of 0, buries the current buffer at the
+bottom of the buffer stack."
+  (interactive "p")
+  (if (eq arg 0)
+      (bury-buffer (current-buffer)))
+  (switch-to-buffer
+   (if (<= arg 1) (other-buffer (current-buffer))
+     (nth (1+ arg) (buffer-list)))))
+
+;; Support the Lucid names with `screen' instead of `frame'.
+
+(fset 'current-screen-configuration 'current-frame-configuration)
+(fset 'delete-screen 'delete-frame)
+(fset 'find-file-new-screen 'find-file-other-frame)
+(fset 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
+(fset 'find-tag-new-screen 'find-tag-other-frame)
+;;(fset 'focus-screen 'focus-frame)
+(fset 'iconify-screen 'iconify-frame)
+(fset 'mail-new-screen 'mail-other-frame)
+(fset 'make-screen-invisible 'make-frame-invisible)
+(fset 'make-screen-visible 'make-frame-visible)
+;; (fset 'minibuffer-screen-list 'minibuffer-frame-list)
+(fset 'modify-screen-parameters 'modify-frame-parameters)
+(fset 'next-screen 'next-frame)
+;; (fset 'next-multiscreen-window 'next-multiframe-window)
+;; (fset 'previous-multiscreen-window 'previous-multiframe-window)
+;; (fset 'redirect-screen-focus 'redirect-frame-focus)
+(fset 'redraw-screen 'redraw-frame)
+;; (fset 'screen-char-height 'frame-char-height)
+;; (fset 'screen-char-width 'frame-char-width)
+;; (fset 'screen-configuration-to-register 'frame-configuration-to-register)
+;; (fset 'screen-focus 'frame-focus)
+(fset 'screen-height 'frame-height)
+(fset 'screen-list 'frame-list)
+;; (fset 'screen-live-p 'frame-live-p)
+(fset 'screen-parameters 'frame-parameters)
+(fset 'screen-pixel-height 'frame-pixel-height)
+(fset 'screen-pixel-width 'frame-pixel-width)
+(fset 'screen-root-window 'frame-root-window)
+(fset 'screen-selected-window 'frame-selected-window)
+(fset 'lower-screen 'frame-to-back)
+(fset 'raise-screen 'frame-to-front)
+(fset 'screen-visible-p 'frame-visible-p)
+(fset 'screen-width 'frame-width)
+(fset 'screenp 'framep)
+(fset 'select-screen 'select-frame)
+(fset 'selected-screen 'selected-frame)
+;; (fset 'set-screen-configuration 'set-frame-configuration)
+;; (fset 'set-screen-height 'set-frame-height)
+(fset 'set-screen-position 'set-frame-position)
+(fset 'set-screen-size 'set-frame-size)
+ll (fset 'set-screen-width 'set-frame-width)
+(fset 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
+;; (fset 'unfocus-screen 'unfocus-frame)
+(fset 'visible-screen-list 'visible-frame-list)
+(fset 'window-screen 'window-frame)
+(fset 'x-create-screen 'x-create-frame)
+(fset 'x-new-screen 'new-frame)