[net.emacs] Creating new keymaps in GNU

mct@briar.UUCP (Mark C. Tucker) (08/20/86)

;;;
;;; New prefix chars
;;;

;; This code shows how to make ^w a command prefix.
;;
;; First we create a keymap to hold the keybindings to use
;;   once you get to ^w from the keyboard.
;;
;; Then we create a "function" whose body is a keymap, instead
;; of a lambda expression.  This is a piece of magic that I don't understand.
;;
;; Finally we set ^W to this "function" in the primary key map.  This lets
;;   the leading ^W trap to the keymap, instead of to "kill-region".
;; 
;; Then, for grins, we put "kill-region" on ^w^w.


;;; C-W commands
(defvar ctl-w-map (make-keymap)
  "Keymap for subcommands of C-W")
(fset 'ctl-w-prefix ctl-w-map)
(define-key global-map "\^W" 'ctl-w-prefix)
(define-key ctl-w-map "\^w" 'kill-region)


;; This code redefines ^q to be the help prefix
;;  and makes escape q be the usual quote character.
;; Then it lets ^h do the nice backward delete that expands tabs

;;; Help and C-H  and vanilla
(setq help-char 17)
(define-key global-map "\^q" help-map)
(define-key esc-map  "q" 'quoted-insert)
(define-key global-map "\^h" 'backward-delete-char-untabify)

moore@ucbcad.BERKELEY.EDU (Peter X Moore) (08/22/86)

I found the process of making new keymaps unfriendly enough, I automated
it.  Here is a set of macros that bind commands to an arbitrary key sequence,
creating new keymaps as necessary.

Peter Moore
moore@ic.Berkeley.EDU

(defun make-global-binding (key function)
  "Bind globally to the arbitrary string KEY, FUNCTION"
  (interactive "skey:\nafunction:")
  (make-binding global-map key function))

(defun make-local-binding (key function)
  "Bind locally to the arbitrary string KEY, FUNCTION"
  (interactive "skey:\nafunction:")
  (make-binding (current-local-map) key function))

(defun make-binding (top-map key function)
  (let ((num (lookup-key top-map key)))
    (if (numberp num)
	(let ((prefix (substring key 0 (1- num)))
	      (path (substring key (1- num)))
	      cur-char symb)
	  (while (> (length path) 1)
	    (setq prefix (concat prefix (substring path 0 1)))
	    (setq path (substring path 1))
	    (setq symb (intern (concat prefix "-prefix")))
	    (fset symb (make-sparse-keymap))
	    (define-key top-map prefix symb))))
    (define-key top-map key function)))