home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / loadkeys.jl < prev    next >
Lisp/Scheme  |  1994-10-07  |  8KB  |  259 lines
  1. ;;;; loadkeys.jl -- Set up standard keybindings
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar global-keymap (make-keytab)
  21.   "The root keymap.")
  22.  
  23. (defvar ctrl-x-keymap (make-keytab)
  24.   "Default `Ctrl-x' keymap.")
  25.  
  26. (defvar ctrl-x-4-keymap (make-keylist)
  27.   "Default `Ctrl-x 4' keymap.")
  28.  
  29. (defvar ctrl-x-5-keymap (make-keylist)
  30.   "Default `Ctrl-x 5' keymap.")
  31.  
  32. (defvar ctrl-c-keymap nil
  33.   "Hook to hang major mode `Ctrl-c' keymap from.")
  34. (make-variable-buffer-local 'ctrl-c-keymap)
  35.  
  36. (defvar user-keymap (make-keylist)
  37.   "Keymap for user-defined bindings, hung from `Ctrl-c'.")
  38.  
  39. (setq unbound-key-hook nil
  40.       keymap-path '(global-keymap))
  41.  
  42. (make-variable-buffer-local 'keymap-path)
  43. (make-variable-buffer-local 'unbound-key-hook)
  44.  
  45. (setq mark-1 (make-mark)
  46.       mark-2 (make-mark)
  47.       mark-3 (make-mark))
  48.  
  49. (bind-keys global-keymap
  50.   "Meta-0"    '(numeric-arg 0)
  51.   "Meta-1"    '(numeric-arg 1)
  52.   "Meta-2"    '(numeric-arg 2)
  53.   "Meta-3"    '(numeric-arg 3)
  54.   "Meta-4"    '(numeric-arg 4)
  55.   "Meta-5"    '(numeric-arg 5)
  56.   "Meta-6"    '(numeric-arg 6)
  57.   "Meta-7"    '(numeric-arg 7)
  58.   "Meta-8"    '(numeric-arg 8)
  59.   "Meta-9"    '(numeric-arg 9)
  60.   "Meta--"    'negative-arg
  61.   "Up"        'goto-prev-line
  62.   "Down"    'goto-next-line
  63.   "Left"    'goto-left-char
  64.   "Right"    'goto-right-char
  65.   "Shift-Up"    '(progn (set-auto-mark) (goto-char (pos nil 0)))
  66.   "Shift-Down"    '(progn (set-auto-mark) (goto-char (pos nil (1- (buffer-length)))))
  67.   "Shift-Left"    'goto-line-start
  68.   "Shift-Right"    'goto-line-end
  69.   "Ctrl-Up"    'prev-screen
  70.   "Ctrl-Down"    'next-screen
  71.   "Ctrl-Left"    '(goto-char (left-char 40))
  72.   "Ctrl-Right"    '(goto-char (right-char 40))
  73.   "Meta-Left"    'backward-word
  74.   "Meta-Right"    'forward-word
  75.   "Meta-Up"    'backward-paragraph
  76.   "Meta-Down"    'forward-paragraph
  77.   "Ctrl-TAB"    'goto-next-tab
  78.   "Shift-TAB"    'goto-prev-tab
  79.   "RET"        'split-line
  80.   "Backspace"    'backspace-char
  81.   "DEL"        'delete-char
  82.   "Shift-Backspace" 'backward-kill-line
  83.   "Shift-DEL"    'kill-line
  84.   "Ctrl-DEL"    'kill-whole-line
  85.   "Meta-DEL"    'kill-word
  86.   "Meta-ESC"    'eval-and-print
  87.   "Meta-TAB"    'goto-next-tab
  88.   "Meta-Backspace" 'backward-kill-word
  89.   "Ctrl-Meta-Backspace" 'backward-kill-exp
  90.   "Help"    'help
  91.   "Meta-Help"    'toggle-iconic
  92.   "Ctrl-@"    'set-auto-mark
  93.   "Meta-@"    'mark-word
  94.   "Meta-%"    'query-replace
  95.   "Ctrl-a"    'goto-line-start
  96.   "Ctrl-b"    'goto-prev-char
  97.   "Meta-b"    'backward-word
  98.   "Ctrl-Meta-b"    'backward-exp
  99.   "Ctrl-c"    '(setq next-keymap-path '(ctrl-c-keymap user-keymap))
  100.   "Meta-c"    'capitalize-word
  101.   "Ctrl-Meta-c"    'abort-recursive-edit
  102.   "Ctrl-d"    'delete-char
  103.   "Meta-d"    'kill-word
  104.   "Ctrl-e"    'goto-line-end
  105.   "Ctrl-f"    'goto-next-char
  106.   "Meta-f"    'forward-word
  107.   "Ctrl-Meta-f"    'forward-exp
  108.   "Ctrl-h"    'help
  109.   "Meta-h"    'mark-paragraph
  110.   "Ctrl-i"    'insert-block
  111.   "Meta-i"    '(insert "\t")
  112.   "Meta-j"    'goto-line
  113.   "Ctrl-k"    'kill-line
  114.   "Ctrl-Meta-k"    'kill-exp
  115.   "Ctrl-l"    'centre-display
  116.   "Meta-l"    'downcase-word
  117.   "Ctrl-m"    'block-toggle
  118.   "Ctrl-M"    'toggle-rect-blocks
  119.   "Meta-m"    '(goto-glyph (indent-pos))
  120.   "Ctrl-n"    'goto-next-line
  121.   "Meta-n"    '(progn (set-auto-mark) (goto-char (match-brackets)))
  122.   "Ctrl-o"    'open-line
  123.   "Ctrl-p"    'goto-prev-line
  124.   "Ctrl-q"    '(setq next-keymap-path t)
  125.   "Ctrl-r"    'isearch-backward
  126.   "Ctrl-s"    'isearch-forward
  127.   "Ctrl-t"    'transpose-chars
  128.   "Meta-t"    'transpose-words
  129.   "Ctrl-Meta-t"    'transpose-exps
  130.   "Ctrl-u"    'universal-arg
  131.   "Meta-u"    'upcase-word
  132.   "Ctrl-v"    'next-screen
  133.   "Meta-v"    'prev-screen
  134.   "Ctrl-w"    'kill-block
  135.   "Ctrl-W"    'delete-block
  136.   "Meta-w"    'copy-block-as-kill
  137.   "Ctrl-x"    '(setq next-keymap-path '(ctrl-x-keymap))
  138.   "Meta-x"    'call-command
  139.   "Ctrl-y"    'yank
  140.   "Ctrl-Y"    'yank-rectangle
  141.   "Ctrl-z"    'toggle-iconic
  142.   "Ctrl-."    'rotate-buffers-forward
  143.   "Ctrl-,"    'rotate-buffers-backward
  144.   "Ctrl-SPC"    'block-toggle
  145.   "Meta-SPC"    'just-spaces
  146.   "Ctrl-]"    'abort-recursive-edit
  147.   "Meta-["    'backward-paragraph
  148.   "Meta-]"    'forward-paragraph
  149.   "Ctrl-_"    'undo
  150.   "Meta-!"    'system
  151.   "Meta-<"    '(progn (set-auto-mark) (goto-buffer-start))
  152.   "Meta->"    '(progn (set-auto-mark) (goto-buffer-end))
  153.   "Meta-;"    'insert-comment
  154.   "Meta-~"    '(set-buffer-modified nil nil)
  155.   "Meta-\\"    'no-spaces
  156.   "Ctrl-Meta-\\" 'indent-area
  157.   "F1"        '(goto-mark mark-1)
  158.   "F2"        '(goto-mark mark-2)
  159.   "F3"        '(goto-mark mark-3)
  160.   "Shift-F1"    '(set-mark mark-1 (cursor-pos) (current-buffer))
  161.   "Shift-F2"    '(set-mark mark-2 (cursor-pos) (current-buffer))
  162.   "Shift-F3"    '(set-mark mark-3 (cursor-pos) (current-buffer))
  163.   "LMB-Click1"    '(goto-char (mouse-pos))
  164.   "LMB-Click2"    'block-toggle
  165.   "LMB-Move"    '(goto-char (mouse-pos))
  166.   "MMB-Click1"    'yank-to-mouse
  167.   "RMB-Click1"    'toggle-iconic
  168.   "Meta-Shift-LMB-Click1" 'block-kill)
  169.  
  170. (bind-keys ctrl-x-keymap
  171.   "Ctrl-b"    'buffer-menu
  172.   "Ctrl-c"    'save-and-quit
  173.   "Ctrl-f"    'find-file
  174.   "Ctrl-l"    'downcase-area
  175.   "Ctrl-r"    'find-file-read-only
  176.   "Ctrl-s"    'save-file
  177.   "Ctrl-u"    'upcase-area
  178.   "Ctrl-v"    'find-alternate-file
  179.   "Ctrl-w"    'save-file-as
  180.   "Ctrl-x"    'swap-cursor-and-auto-mark
  181.   "0"        'close-window
  182.   "1"        'close-other-windows
  183.   "2"        'open-window
  184.   "4"        '(setq next-keymap-path '(ctrl-x-4-keymap))
  185.   "5"        '(setq next-keymap-path '(ctrl-x-5-keymap))
  186.   "b"        'switch-to-buffer
  187.   "f"        'set-fill-column
  188.   "h"        'mark-whole-buffer
  189.   "i"        'insert-file
  190.   "k"        'kill-buffer
  191.   "o"        '(set-current-window (next-window) t)
  192.   "q"        '(set-buffer-read-only nil (not (buffer-read-only-p)))
  193.   "s"        'save-some-buffers
  194.   "u"        'undo
  195.   "`"        'next-error
  196.   "#"        'server-close-file)
  197.  
  198. (bind-keys ctrl-x-4-keymap
  199.   "Ctrl-f"    '(in-other-window 'find-file)
  200.   "a"        '(in-other-window 'add-change-log-entry)
  201.   "b"        '(in-other-window 'switch-to-buffer)
  202.   "f"        '(in-other-window 'find-file)
  203.   "h"        '(in-other-window 'help)
  204.   "i"        '(in-other-window 'info)
  205.   "`"        '(in-other-window 'next-error))
  206.  
  207. (bind-keys ctrl-x-5-keymap
  208.   "Ctrl-f"    '(in-new-window 'find-file)
  209.   "a"        '(in-new-window 'add-change-log-entry)
  210.   "b"        '(in-new-window 'switch-to-buffer)
  211.   "f"        '(in-new-window 'find-file)
  212.   "h"        '(in-new-window 'help)
  213.   "i"        '(in-new-window 'info)
  214.   "`"        '(in-new-window 'next-error))
  215.  
  216. (defun self-insert (event-string)
  217.   "This function can be bound to a key to make it insert its usual character
  218. sequence. This is usually used to ``hide'' a previously bound definition of
  219. the key."
  220.   (interactive "E")
  221.   (insert event-string))
  222.  
  223. (defun numeric-arg (digit)
  224.   "Add a digit to the prefix-arg."
  225.   (when (numberp digit)
  226.     ;; Set the `next-keymap-path' to ensure echoing
  227.     ;; continues. `prefix-arg' *must* be set after
  228.     ;; `next-keymap-path' for this all to work!
  229.     (setq next-keymap-path keymap-path
  230.       prefix-arg (cond
  231.               ((numberp current-prefix-arg)
  232.                (+ (* current-prefix-arg 10) digit))
  233.               ((eq current-prefix-arg '-)
  234.                (- digit))
  235.               (t
  236.                digit)))))
  237.  
  238. (defun negative-arg (arg)
  239.   "Negate the prefix-arg. Bound to `Meta--'. "
  240.   (interactive "P")
  241.   (setq next-keymap-path keymap-path
  242.     prefix-arg (cond
  243.             ((numberp arg)
  244.              (* arg -1))
  245.             ((eq arg '-)
  246.              nil)
  247.             (t
  248.              '-))))
  249.  
  250. (defun universal-arg (arg)
  251.   (interactive "P")
  252.   (setq next-keymap-path keymap-path
  253.     prefix-arg (cond
  254.             ((consp arg)
  255.              (rplaca arg (* 4 (car arg)))
  256.              arg)
  257.             (t
  258.              (cons 4 nil)))))
  259.