# HG changeset patch # User Jim Blandy # Date 693213337 0 # Node ID 36359663b6d8d715190dd1d702ad99b2bf46d2d0 # Parent 4ddaee1a9029f2ae49ef588bfc83a1995b4f627e *** empty log message *** diff -r 4ddaee1a9029 -r 36359663b6d8 lisp/mouse.el --- a/lisp/mouse.el Fri Dec 20 07:15:37 1991 +0000 +++ b/lisp/mouse.el Fri Dec 20 07:15:37 1991 +0000 @@ -1,170 +1,95 @@ -;; Mouse support that is independent of window systems. -;; Copyright (C) 1988 Free Software Foundation, Inc. +;;; Window system-independent mouse support. +;;; Copyright (C) 1988 Free Software Foundation, Inc. -;; This file is part of GNU Emacs. +;;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 1, or (at your option) +;;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. (provide 'mouse) -(defun mouse-select () - "Select the Emacs window the mouse is on." - (interactive "@")) +;;; Utility functions. + +(defun mouse-movement-p (event) + (and (consp event) + (eq (car event) 'mouse-movement))) + +(defun event-window (event) (nth 1 event)) +(defun event-point (event) (nth 2 event)) +(defun mouse-coords (event) (nth 3 event)) +(defun mouse-timestamp (event) (nth 4 event)) -(defun mouse-delete-window () - "Delete the Emacs window the mouse is on." - (interactive "@") - (delete-window)) +;;; Indent track-mouse like progn. +(put 'track-mouse 'lisp-indent-function 0) -(defun mouse-keep-one-window () - "Select Emacs window mouse is on, then kill all other Emacs windows." - (interactive "@") + +(defun mouse-delete-window (click) + "Delete the window clicked on. +This must be bound to a mouse click." + (interactive "K") + (delete-window (event-window click))) + +(defun mouse-delete-other-windows (click) + "Select Emacs window clicked on, then kill all other Emacs windows. +This must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) (delete-other-windows)) -(defun mouse-select-and-split () - "Select Emacs window mouse is on, then split it vertically in half." - (interactive "@") - (split-window-vertically nil)) - -(defun mouse-set-point (event) - "Select Emacs window mouse is on, and move point to mouse position." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - ;; Note that hscroll must get above 1 - ;; before the text actually starts to move. - (move-to-column (+ (car relative-coordinate) (current-column) - (1- (max 1 (window-hscroll (selected-window)))))) - (what-line))))) +(defun mouse-split-window-vertically (click) + "Select Emacs window mouse is on, then split it vertically in half. +The window is split at the line clicked on. +This command must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) + (split-window-vertically (1+ (cdr (mouse-coords click))))) -(defun mouse-eval-last-sexpr (event) - (interactive "@e") - (save-excursion - (mouse-set-point event) - (eval-last-sexp nil))) +(defun mouse-set-point (click) + "Move point to the position clicked on with the mouse. +This must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) + (goto-char (event-point click))) -(defun mouse-line-length (event) - "Print the length of the line indicated by the pointer." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (save-excursion - (move-to-window-line (car (cdr relative-coordinate))) - (end-of-line) - (push-mark nil t) - (beginning-of-line) - (message "Line length: %d" - (- (region-end) (region-beginning))) - (sleep-for 1))))) - -(defun mouse-set-mark (event) - "Select Emacs window mouse is on, and set mark at mouse position. -Display cursor at that position for a second." - (interactive "@e") +(defun mouse-set-mark (click) + "Set mark at the position clicked on with the mouse. +Display cursor at that position for a second. +This must be bound to a mouse click." + (interactive "K") (let ((point-save (point))) (unwind-protect - (progn (mouse-set-point event) + (progn (mouse-set-point click) (push-mark nil t) (sit-for 1)) (goto-char point-save)))) -(defun mouse-fill-paragraph (event) - "Fill the paragraph at the mouse position." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (fill-paragraph))) - -(defun mouse-fill-paragraph-with-prefix (event) - "Fill the paragraph at the mouse position with specified fill prefix. -Click at the end of the fill prefix that you want; -The text before the mouse position, on the same line, is used as the prefix." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (let ((fill-prefix (buffer-substring (save-excursion (beginning-of-line) - (point)) - (point)))) - (fill-paragraph)))) - -(defun mouse-scroll (event) - "Scroll point to the mouse position." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (recenter (car (cdr relative-coordinate))) - (scroll-right (+ (car relative-coordinate) (current-column))))))) - -(defun mouse-del-char (event) - "Delete the char pointed to by the mouse." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - (move-to-column (+ (car relative-coordinate) (current-column))) - (delete-char 1 nil))))) +(defun mouse-kill (click) + "Kill the region between point and the mouse click. +The text is saved in the kill ring, as with \\[kill-region]." + (interactive "K") + (mouse-set-mark click) + (kill-region)) -(defun mouse-kill-line (event) - "Kill the line pointed to by the mouse." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - (move-to-column (+ (car relative-coordinate) (current-column))) - (kill-line nil))))) +(defun mouse-kill-ring-save + "Copy the region between point and the mouse click in the kill ring. +This does not delete the region; it acts like \\[kill-ring-save]." + (interactive "K") + (mouse-set-mark click) + (kill-ring-save)) -(defun narrow-window-to-region (m n) - "Narrow window to region between point and last mark" - (interactive "r") - (save-excursion - (save-restriction - (if (eq (selected-window) (next-window)) - (split-window)) - (goto-char m) - (recenter 0) - (if (eq (selected-window) - (if (zerop (minibuffer-depth)) - (next-window))) - () - (shrink-window (- (- (window-height) (count-lines m n)) 1)))))) -(defun mouse-window-to-region (event) - "Narrow window to region between cursor and mouse pointer." - (interactive "@e") - (let ((point-save (point))) - (unwind-protect - (progn (mouse-set-point event) - (push-mark nil t) - (sit-for 1)) - (goto-char point-save) - (narrow-window-to-region (region-beginning) (region-end))))) - -(defun mouse-ignore () - "Don't do anything." - (interactive)) ;; Commands for the scroll bar. @@ -231,77 +156,77 @@ ;; Set up these commands, including the prefix keys for the scroll bar. -(fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-scroll-bar-prefix - 'mouse-vertical-scroll-bar-prefix) - -(defun mouse-scroll-motion (event) - (interactive "e") - (let ((pos (car (car event))) - (length (car (cdr (car event))))) - (message "[%d %d]" pos length))) - -(let ((map (function mouse-vertical-scroll-bar-prefix))) - (define-key map mouse-button-right 'mouse-scroll-down) - (define-key map mouse-button-left 'mouse-scroll-up) - (define-key map mouse-button-middle 'mouse-scroll-absolute) - (define-key map mouse-motion 'x-horizontal-line)) - -;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap)) -;(define-key global-mouse-map mouse-vertical-slider-prefix -; 'mouse-vertical-slider-prefix) - -;(let ((map (function mouse-vertical-slider-prefix))) -; (define-key map mouse-button-right 'mouse-scroll-move-cursor) -; (define-key map mouse-button-left 'mouse-scroll-move-cursor) -; (define-key map mouse-button-middle 'mouse-scroll-move-cursor)) - -(fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-thumbup-prefix - 'mouse-vertical-thumbup-prefix) - -(let ((map (function mouse-vertical-thumbup-prefix))) - (define-key map mouse-button-right 'mouse-scroll-down-full) - (define-key map mouse-button-left 'mouse-scroll-down-full) - (define-key map mouse-button-middle 'mouse-scroll-down-full)) - -(fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-thumbdown-prefix - 'mouse-vertical-thumbdown-prefix) - -(let ((map (function mouse-vertical-thumbdown-prefix))) - (define-key map mouse-button-right 'mouse-scroll-up-full) - (define-key map mouse-button-left 'mouse-scroll-up-full) - (define-key map mouse-button-middle 'mouse-scroll-up-full)) - -;; Horizontal bar - -(fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-scroll-bar-prefix - 'mouse-horizontal-scroll-bar-prefix) - -(let ((map (function mouse-horizontal-scroll-bar-prefix))) - (define-key map mouse-button-right 'mouse-scroll-right) - (define-key map mouse-button-left 'mouse-scroll-left) - (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally)) - -(fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-thumbleft-prefix - 'mouse-horizontal-thumbleft-prefix) - -(let ((map (function mouse-horizontal-thumbleft-prefix))) - (define-key map mouse-button-right 'mouse-scroll-left-full) - (define-key map mouse-button-left 'mouse-scroll-left-full) - (define-key map mouse-button-middle 'mouse-scroll-left-full)) - -(fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-thumbright-prefix - 'mouse-horizontal-thumbright-prefix) - -(let ((map (function mouse-horizontal-thumbright-prefix))) - (define-key map mouse-button-right 'mouse-scroll-right-full) - (define-key map mouse-button-left 'mouse-scroll-right-full) - (define-key map mouse-button-middle 'mouse-scroll-right-full)) +;;; (fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-scroll-bar-prefix +;;; 'mouse-vertical-scroll-bar-prefix) +;;; +;;; (defun mouse-scroll-motion (event) +;;; (interactive "e") +;;; (let ((pos (car (car event))) +;;; (length (car (cdr (car event))))) +;;; (message "[%d %d]" pos length))) +;;; +;;; (let ((map (function mouse-vertical-scroll-bar-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-down) +;;; (define-key map mouse-button-left 'mouse-scroll-up) +;;; (define-key map mouse-button-middle 'mouse-scroll-absolute) +;;; (define-key map mouse-motion 'x-horizontal-line)) +;;; +;;; ;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap)) +;;; ;(define-key global-mouse-map mouse-vertical-slider-prefix +;;; ; 'mouse-vertical-slider-prefix) +;;; +;;; ;(let ((map (function mouse-vertical-slider-prefix))) +;;; ; (define-key map mouse-button-right 'mouse-scroll-move-cursor) +;;; ; (define-key map mouse-button-left 'mouse-scroll-move-cursor) +;;; ; (define-key map mouse-button-middle 'mouse-scroll-move-cursor)) +;;; +;;; (fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-thumbup-prefix +;;; 'mouse-vertical-thumbup-prefix) +;;; +;;; (let ((map (function mouse-vertical-thumbup-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-down-full) +;;; (define-key map mouse-button-left 'mouse-scroll-down-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-down-full)) +;;; +;;; (fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-thumbdown-prefix +;;; 'mouse-vertical-thumbdown-prefix) +;;; +;;; (let ((map (function mouse-vertical-thumbdown-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-up-full) +;;; (define-key map mouse-button-left 'mouse-scroll-up-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-up-full)) +;;; +;;; ;; Horizontal bar +;;; +;;; (fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-scroll-bar-prefix +;;; 'mouse-horizontal-scroll-bar-prefix) +;;; +;;; (let ((map (function mouse-horizontal-scroll-bar-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-right) +;;; (define-key map mouse-button-left 'mouse-scroll-left) +;;; (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally)) +;;; +;;; (fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-thumbleft-prefix +;;; 'mouse-horizontal-thumbleft-prefix) +;;; +;;; (let ((map (function mouse-horizontal-thumbleft-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-left-full) +;;; (define-key map mouse-button-left 'mouse-scroll-left-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-left-full)) +;;; +;;; (fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-thumbright-prefix +;;; 'mouse-horizontal-thumbright-prefix) +;;; +;;; (let ((map (function mouse-horizontal-thumbright-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-right-full) +;;; (define-key map mouse-button-left 'mouse-scroll-right-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-right-full)) ;;;; @@ -402,10 +327,10 @@ (x-erase-rectangle (selected-screen)) (setq last-line-drawn nil)))) -(defun test-x-rectangle () - (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) - (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) - (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) +;;; (defun test-x-rectangle () +;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) +;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) +;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) ;; ;; Here is how to do double clicking in lisp. About to change. @@ -433,10 +358,10 @@ (> (- (nth 4 event ) double-start) double-click-interval) (setq double-start nil))) -(defun x-test-doubleclick () - (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) - (define-key doubleclick-test-map mouse-button-left 'double-down) - (define-key doubleclick-test-map mouse-button-left-up 'double-up)) +;;; (defun x-test-doubleclick () +;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) +;;; (define-key doubleclick-test-map mouse-button-left 'double-down) +;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up)) ;; ;; This scrolls while button is depressed. Use preferable in scrollbar. @@ -467,12 +392,12 @@ (setq scrolled-lines 0) (sleep-for 1)) -(defun x-testing-scroll () - (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) - (define-key scrolling-map mouse-button-left 'incr-scroll-down) - (define-key scrolling-map mouse-button-right 'incr-scroll-up) - (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) - (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) +;;; (defun x-testing-scroll () +;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) +;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down) +;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up) +;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) +;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) ;; ;; Some playthings suitable for picture mode? They need work. @@ -522,3 +447,10 @@ (mouse-multiple-insert (- (car relative-coordinate) (current-column)) " ")) ((= (current-column) (car relative-coordinate)) (ding)))))) + + +;;; Bindings for mouse commands. + +(global-set-key [mouse-1] 'mouse-set-point) +(global-set-key [S-mouse-1] 'mouse-set-mark) +(global-set-key [mouse-3] 'mouse-delete-other-windows) diff -r 4ddaee1a9029 -r 36359663b6d8 src/keymap.c --- a/src/keymap.c Fri Dec 20 07:15:37 1991 +0000 +++ b/src/keymap.c Fri Dec 20 07:15:37 1991 +0000 @@ -64,6 +64,9 @@ /* was MinibufLocalMustMatchMap */ Lisp_Object Vminibuffer_local_must_match_map; +/* Alist of minor mode variables and keymaps. */ +Lisp_Object Vminor_mode_map_alist; + Lisp_Object Qkeymapp, Qkeymap; /* A char over 0200 in a key sequence @@ -77,6 +80,8 @@ static void describe_map (); static void describe_alist (); +/* Keymap object support - constructors and predicates. */ + DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0, "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ VECTOR is a 128-element vector which holds the bindings for the ASCII\n\ @@ -173,7 +178,8 @@ return tem; if (error) wrong_type_argument (Qkeymapp, object); - else return Qnil; + else + return Qnil; } Lisp_Object @@ -387,6 +393,8 @@ return copy; } +/* Simple Keymap mutators and accessors. */ + DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ @@ -558,6 +566,75 @@ } +/* Global, local, and minor mode keymap stuff. */ + +/* Store a pointer to an array of the keymaps of the currently active + minor modes in *buf, and return the number of maps it contains. + + This function always returns a pointer to the same buffer, and may + free or reallocate it, so if you want to keep it for a long time or + hand it out to lisp code, copy it. This procedure will be called + for every key sequence read, so the nice lispy approach (return a + new assoclist, list, what have you) for each invocation would + result in a lot of consing over time. + + If we used xrealloc/xmalloc and ran out of memory, they would throw + back to the command loop, which would try to read a key sequence, + which would call this function again, resulting in an infinite + loop. Instead, we'll use realloc/malloc and silently truncate the + list, let the key sequence be read, and hope some other piece of + code signals the error. */ +int +current_minor_maps (modeptr, mapptr) + Lisp_Object **modeptr, **mapptr; +{ + static Lisp_Object *modes, *maps; + static int size; + + int i = 0; + Lisp_Object alist, assoc, var; + + for (alist = Vminor_mode_map_alist; + CONSP (alist); + alist = XCONS (alist)->cdr) + if (CONSP (assoc = XCONS (alist)->car) + && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol + && ! NULL (Fboundp (var)) + && ! NULL (Fsymbol_value (var))) + { + if (i >= size) + { + Lisp_Object *newmodes, *newmaps; + + if (maps) + { + newmodes = (Lisp_Object *) realloc (modes, size *= 2); + newmaps = (Lisp_Object *) realloc (maps, size); + } + else + { + newmodes = (Lisp_Object *) malloc (size = 30); + newmaps = (Lisp_Object *) malloc (size); + } + + if (newmaps && newmodes) + { + modes = newmodes; + maps = newmaps; + } + else + break; + } + modes[i] = var; + maps [i] = XCONS (assoc)->cdr; + i++; + } + + if (modeptr) *modeptr = modes; + if (mapptr) *mapptr = maps; + return i; +} + DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0, "Return the binding for command KEY in current keymaps.\n\ KEY is a string, a sequence of keystrokes.\n\ @@ -565,22 +642,30 @@ (key) Lisp_Object key; { - register Lisp_Object map, value, value1; - map = current_buffer->keymap; - if (!NULL (map)) + Lisp_Object *maps, value; + int nmaps, i; + + nmaps = current_minor_maps (0, &maps); + for (i = 0; i < nmaps; i++) + if (! NULL (maps[i])) + { + value = Flookup_key (maps[i], key); + if (! NULL (value) && XTYPE (value) != Lisp_Int) + return value; + } + + if (! NULL (current_buffer->keymap)) { - value = Flookup_key (map, key); - if (NULL (value)) - { - value1 = Flookup_key (current_global_map, key); - if (XTYPE (value1) == Lisp_Int) - return Qnil; - return value1; - } - else if (XTYPE (value) != Lisp_Int) + value = Flookup_key (current_buffer->keymap, key); + if (! NULL (value) && XTYPE (value) != Lisp_Int) return value; } - return Flookup_key (current_global_map, key); + + value = Flookup_key (current_global_map, key); + if (! NULL (value) && XTYPE (value) != Lisp_Int) + return value; + + return Qnil; } DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0, @@ -607,6 +692,38 @@ return Flookup_key (current_global_map, keys); } +DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 1, 0, + "Find the visible minor mode bindings of KEY.\n\ +Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ +the symbol which names the minor mode binding KEY, and BINDING is\n\ +KEY's definition in that mode. In particular, if KEY has no\n\ +minor-mode bindings, return nil. If the first binding is a\n\ +non-prefix, all subsequent bindings will be omitted, since they would\n\ +be ignored. Similarly, the list doesn't include non-prefix bindings\n\ +that come after prefix bindings.") + (key) +{ + Lisp_Object *modes, *maps; + int nmaps; + Lisp_Object binding; + int i, j; + + nmaps = current_minor_maps (&modes, &maps); + + for (i = j = 0; i < nmaps; i++) + if (! NULL (maps[i]) + && ! NULL (binding = Flookup_key (maps[i], key)) + && XTYPE (binding) != Lisp_Int) + { + if (! NULL (get_keymap_1 (binding, 0))) + maps[j++] = Fcons (modes[i], binding); + else if (j == 0) + return Fcons (Fcons (modes[i], binding), Qnil); + } + + return Flist (j, maps); +} + DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, "kSet key globally: \nCSet key %s to command: ", "Give KEY a global binding as COMMAND.\n\ @@ -729,7 +846,19 @@ { return current_global_map; } + +DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0, + "Return a list of keymaps for the minor modes of the current buffer.") + () +{ + Lisp_Object *maps; + int nmaps = current_minor_maps (0, &maps); + + return Flist (nmaps, maps); +} +/* Help functions for describing and documenting keymaps. */ + DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, 1, 1, 0, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ @@ -1021,6 +1150,8 @@ return build_string (tem); } +/* where-is - finding a command in a set of keymaps. */ + DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\ If KEYMAP is nil, search only KEYMAP1.\n\ @@ -1212,6 +1343,8 @@ return Qnil; } +/* describe-bindings - summarizing all the bindings in a set of keymaps. */ + DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "", "Show a list of all defined keys, and their definitions.\n\ The list is put in a buffer, which is displayed.") @@ -1236,19 +1369,41 @@ Fset_buffer (Vstandard_output); + { + int i, nmaps; + Lisp_Object *modes, *maps; + + nmaps = current_minor_maps (&modes, &maps); + for (i = 0; i < nmaps; i++) + { + if (XTYPE (modes[i]) == Lisp_Symbol) + { + insert_char ('`'); + insert_string (XSYMBOL (modes[i])->name->data); + insert_char ('\''); + } + else + insert_string ("Strangely Named"); + insert_string (" Minor Mode Bindings:\n"); + insert_string (heading); + describe_map_tree (maps[i], 0, Qnil); + insert_char ('\n'); + } + } + start1 = XBUFFER (descbuf)->keymap; if (!NULL (start1)) { insert_string ("Local Bindings:\n"); insert_string (heading); - describe_map_tree (start1, 0, Qnil, Qnil); + describe_map_tree (start1, 0, Qnil); insert_string ("\n"); } insert_string ("Global Bindings:\n"); insert_string (heading); - describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap, Qnil); + describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap); Fset_buffer (descbuf); return Qnil; @@ -1563,7 +1718,7 @@ UNGCPRO; } -/* Apropos */ +/* Apropos - finding all symbols whose names match a regexp. */ Lisp_Object apropos_predicate; Lisp_Object apropos_accumulate; @@ -1639,6 +1794,14 @@ current_global_map = global_map; + DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist, + "Alist of keymaps to use for minor modes.\n\ +Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\ +key sequences and look up bindings iff VARIABLE's value is non-nil.\n\ +If two active keymaps bind the same key, the keymap appearing earlier\n\ +in the list takes precedence."); + Vminor_mode_map_alist = Qnil; + Qsingle_key_description = intern ("single-key-description"); staticpro (&Qsingle_key_description); @@ -1655,6 +1818,7 @@ defsubr (&Skey_binding); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); + defsubr (&Sminor_mode_key_binding); defsubr (&Sglobal_set_key); defsubr (&Slocal_set_key); defsubr (&Sdefine_key); @@ -1666,6 +1830,7 @@ defsubr (&Suse_local_map); defsubr (&Scurrent_local_map); defsubr (&Scurrent_global_map); + defsubr (&Scurrent_minor_mode_maps); defsubr (&Saccessible_keymaps); defsubr (&Skey_description); defsubr (&Sdescribe_vector);