Skip to content

GitLab

emacs
emacs
Commit cc0a8174 authored by Jim Blandy's avatar Jim Blandy
Browse files
Options

*** empty log message ***

parent 6367dc09
Hide whitespace changes
Inline Side-by-side
Showing with 379 additions and 312 deletions
lisp/mouse.el
View file @ cc0a8174
;; 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-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)))
(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))
;; Commands for the scroll bar.
......@@ -231,77 +156,77 @@ The text before the mouse position, on the same line, is used as the prefix."
;; 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 @@ The text before the mouse position, on the same line, is used as the prefix."
(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 @@ The text before the mouse position, on the same line, is used as the prefix."
(> (- (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 @@ The text before the mouse position, on the same line, is used as the prefix."
(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 @@ The text before the mouse position, on the same line, is used as the prefix."
(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)
lisp/term/news.el
View file @ cc0a8174
......@@ -18,68 +18,38 @@
;; 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)))))
;; 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])
src/keymap.c
View file @ cc0a8174
......@@ -64,6 +64,9 @@ Lisp_Object Vminibuffer_local_completion_map;
/* 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_command ();
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 @@ get_keymap_1 (object, error)
return tem;
if (error)
wrong_type_argument (Qkeymapp, object);
else return Qnil;
else
return Qnil;
}
Lisp_Object
......@@ -387,6 +393,8 @@ is not copied.")
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 @@ append_key (key_sequence, key)
}
/* 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;