-;; 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)
\f
-(defun mouse-select ()
- "Select the Emacs window the mouse is on."
- (interactive "@"))
+;;; Utility functions.
-(defun mouse-delete-window ()
- "Delete the Emacs window the mouse is on."
- (interactive "@")
- (delete-window))
+(defun mouse-movement-p (event)
+ (and (consp event)
+ (eq (car event) 'mouse-movement)))
-(defun mouse-keep-one-window ()
- "Select Emacs window mouse is on, then kill all other Emacs windows."
- (interactive "@")
- (delete-other-windows))
+(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-select-and-split ()
- "Select Emacs window mouse is on, then split it vertically in half."
- (interactive "@")
- (split-window-vertically nil))
+;;; Indent track-mouse like progn.
+(put 'track-mouse 'lisp-indent-function 0)
-(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-eval-last-sexpr (event)
- (interactive "@e")
- (save-excursion
- (mouse-set-point event)
- (eval-last-sexp nil)))
+\f
+(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-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-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-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-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))
\f
;; Commands for the scroll bar.
;; 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))
;;;;
(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.
(> (- (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.
(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.
(mouse-multiple-insert
(- (car relative-coordinate) (current-column)) " "))
((= (current-column) (car relative-coordinate)) (ding))))))
+
+\f
+;;; 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)
-;; keypad and function key bindings for the Sony NEWS keyboard.
-;; Copyright (C) 1989 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;; This file effects a mapping from the raw escape sequences of various
-;; keypad and function keys to the symbols used by emacs to represent
-;; those keys. The mapping from key symbol to the function performed
-;; when that key is pressed is handled keyboard-independently by the file
-;; ../keypad.el.
-
-;; Note that his file is also used under X11. For this to work, the variable
-;; names must not change from keyboard file to keyboard file, nor can the
-;; structure of keypad-maps change.
-
-(require 'keypad)
-
-(defvar keypads nil
- "Keypad and function keys keymap for Sony News machine.")
-
-(defvar keypad-maps nil
- "A list of strings sent by the keypad and function keys on the Sony News.
-There is an element for each unique prefix. Each element is of the form
-(PREFIX map map ...), each map being (string . symbol).")
-
-(setq keypad-maps '(("\eO"
- ("P" . function-1)
- ("Q" . function-2)
- ("R" . function-3)
- ("S" . function-4)
- ("T" . function-5)
- ("U" . function-6)
- ("V" . function-7)
- ("W" . function-8)
- ("X" . function-9)
- ("Y" . function-10)
-
- ("m" . keypad-subtract)
- ("k" . keypad-add)
- ("l" . keypad-comma)
- ("n" . keypad-period)
- ("M" . keypad-enter)
-
- ("p" . keypad-0)
- ("q" . keypad-1)
- ("r" . keypad-2)
- ("s" . keypad-3)
- ("t" . keypad-4)
- ("u" . keypad-5)
- ("v" . keypad-6)
- ("w" . keypad-7)
- ("x" . keypad-8)
- ("y" . keypad-9)
-
- ; These three strings are just made up.
- ("a" . execute) ; enter
- ("b" . select) ; nfer
- ("c" . cancel)))) ; xfer
-
-(let ((pads keypad-maps))
- (while pads
- (unwind-protect
- (let* ((prefix (car (car pads)))
- (stringmap (cdr (car pads)))
- (padmap (if (lookup-key global-map prefix)
- (error "Keymap entry for keypad prefix already exisists")
- (make-sparse-keymap))))
- (define-key global-map prefix padmap)
- (setup-terminal-keymap padmap stringmap))
- (setq pads (cdr pads)))))
+;; keypad and function key bindings for the Sony NEWS keyboard.
+;; Copyright (C) 1989 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;; This file places entries in function-key-map for the raw escape
+;; sequences of various keypad and function keys, binding them to
+;; their symbolic forms.
+
+(define-prefix-command 'news-fkey-prefix 'news-fkey-map)
+(define-key function-key-map "\eO" 'news-fkey-prefix)
+
+(define-key news-fkey-map "P" [f1])
+(define-key news-fkey-map "Q" [f2])
+(define-key news-fkey-map "R" [f3])
+(define-key news-fkey-map "S" [f4])
+(define-key news-fkey-map "T" [f5])
+(define-key news-fkey-map "U" [f6])
+(define-key news-fkey-map "V" [f7])
+(define-key news-fkey-map "W" [f8])
+(define-key news-fkey-map "X" [f9])
+(define-key news-fkey-map "Y" [f10])
+(define-key news-fkey-map "m" [kp-subtract])
+(define-key news-fkey-map "k" [kp-add])
+(define-key news-fkey-map "l" [kp-separator])
+(define-key news-fkey-map "n" [kp-period])
+(define-key news-fkey-map "M" [kp-enter])
+(define-key news-fkey-map "p" [kp-0])
+(define-key news-fkey-map "q" [kp-1])
+(define-key news-fkey-map "r" [kp-2])
+(define-key news-fkey-map "s" [kp-3])
+(define-key news-fkey-map "t" [kp-4])
+(define-key news-fkey-map "u" [kp-5])
+(define-key news-fkey-map "v" [kp-6])
+(define-key news-fkey-map "w" [kp-7])
+(define-key news-fkey-map "x" [kp-8])
+(define-key news-fkey-map "y" [kp-9])
+(define-key news-fkey-map "a" [execute])
+(define-key news-fkey-map "b" [select])
+(define-key news-fkey-map "c" [cancel])
/* 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
static void describe_map ();
static void describe_alist ();
\f
+/* 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\
return tem;
if (error)
wrong_type_argument (Qkeymapp, object);
- else return Qnil;
+ else
+ return Qnil;
}
Lisp_Object
return copy;
}
\f
+/* 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\
}
\f
+/* 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\
(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,
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\
{
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);
+}
\f
+/* 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\
return build_string (tem);
}
\f
+/* 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\
return Qnil;
}
\f
+/* 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.")
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;
UNGCPRO;
}
\f
-/* Apropos */
+/* Apropos - finding all symbols whose names match a regexp. */
Lisp_Object apropos_predicate;
Lisp_Object apropos_accumulate;
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);
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);
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);
HCoop / bpt / emacs.git / commitdiff