rbj@nav.icst.nbs.GOV (Root Boy Jim) (10/03/88)
Matt,
Here is an updated version of the tvi950.el that you posted
awhile back. Besides the gratuitous binding changes (;-), I changed the
way that labels were done. I use alternating inverse video to delimit
the labels and the labels function toggles between 1-11 and 12-22.
I also documented all the possible tvi950 keys. Some functions may be
missing as I did not include my fns.el file. Hope you like it!
My `def-key' function is pretty much like define-key except that it takes
a keymap *name* instead of the keymap itself. What it does is define an
intermediate variable suffixed with the fourth argument and fsets its
function definition to the function provided. This way, any changes I
make to the standard bindings show up in describe-bindings.
To add to the madness, if the map is specified as `t' or `nil', the
current-{global,local}-map is used. Set-key is an interactive wrapper.
Note also that I defined ^Q as a prefix key. I am one of those people who
use ^Q/^S for flow control and map ^^/^_ to ^Q/^S via the
keyboard-translate-table. This the Home key becomes a prefix for the
other arrow keys. Thanks for the doing all the initial work.
(Root Boy) Jim Cottrell (301) 975-5688
<rbj@nav.icst.nbs.gov> or <rbj@icst-cmr.arpa>
Careful with that VAX Eugene!
;; tvi950 package for GNU emacs
;; January 1986; Matt Crawford
;; August 1988; Root Boy Jim hacked it unmercifully
;; This file makes the FUNCT key act like a meta key. It also
;; provides tvi-reset, tvi-setup, tvi-bind, and tvi-labels.
;; If tvi-arrows is bound and non-nil then the key bindings are
;; scrambled to accomodate the arrow keys (down up left right
;; are C-V C-K C-H C-L respectively.)
(defconst tvi-reset
(concat "\eG0 01 \eG4 02 \eG0 03 \eG4 04 \eG0 05 \eG4 06 "
"\eG0 07 \eG4 08 \eG0 09 \eG4 10 \eG0 11 "
"\eG8 12 \eG< 13 \eG8 14 \eG< 15 \eG8 16 \eG< 17 "
"\eG8 18 \eG< 19 \eG8 20 \eG< 21 \eG8 22 ")
"Original labels for tvi950 function keys")
(defvar tvi-labels tvi-reset "Status line labels for tvi950 function keys.")
(defvar tvi-toggle 0 "Toggle which labels are displayed")
(defun tvi-labels () "Display labels for tvi950 function keys."
(interactive)
(send-string-to-terminal
(concat "\eg\ef"
(substring tvi-labels tvi-toggle (+ tvi-toggle 99))
"\^m"))
(setq tvi-toggle (- 99 tvi-toggle)))
(defun tvi-reset (arg) "Reset tvi950 function keys and labels."
(interactive "P")
(setq tvi-labels tvi-reset
tvi-toggle 0)
(tvi-labels)
(tvi-setup arg))
(defun tvi-meta ()
"Make the tvi950 FUNCT key act like a META key."
(interactive)
(let ((save-key (read-char)))
(if (/= (read-char) ?\^M)
(error "Bad C-A or FUNCT key usage")
(setq prefix-arg current-prefix-arg
unread-command-char (logior save-key 128)))))
(def-key t "\^A" 'tvi-meta ">")
(defvar tvi-map (make-keymap) "Keymap for tvi950 function keys")
(defvar tvi-prefix "\e_" "Prefix for tvi950 function key map")
(defvar tvi-base ?` "Function key values start (after) here")
(defun tvi-setup (arg)
"Bind the tvi950 function keys with `tvi-prefix' starting after `tvi-base'."
(if arg (setq tvi-map (make-keymap)))
(fset 'tvi-map tvi-map)
(def-key t tvi-prefix 'tvi-map "+")
;; save the following for later reference ...
(let ((ps (tvi-quote tvi-prefix))
(key 0))
(while (< key 22)
(setq key (1+ key))
(send-string-to-terminal
(concat "\e|"
(char-to-string (+ key ?0))
"1" ps
(char-to-string (+ key tvi-base))
"\^Y")))))
(defun tvi-quote (string)
"Quote control chars in STRING with ^P, for tvi950 terminal."
(let ((result ""))
(while (> (length string) 0)
(setq result (concat result
(and (or (< (string-to-char string) 32)
(= (string-to-char string) 127))
"\^P")
(substring string 0 1)))
(setq string (substring string 1)))
result))
(defun tvi-bind (key command label) "\
Bind tvi950 function key number KEY to COMMAND.
Give it the 6 character LABEL on the 25th line.
Shifted keys are numbered 12 thru 22."
(interactive "nKey number: \nCCommand: \nsLabel: ")
(and (or (> key 22) (< key 1)) (error "Key number out of range!"))
(def-key 'tvi-map (char-to-string (+ key tvi-base)) command "+")
(if (string= label "") nil
(setq tvi-toggle (if (> key 11) 99 0)
key (- (* 9 key) 6)
tvi-labels (concat (substring tvi-labels 0 key)
(substring (concat label " ") 0 6)
(substring tvi-labels (+ key 6))))
(tvi-labels)))
(tvi-reset nil)
;(tvi-bind 1 'undefined "")
;(tvi-bind 2 'undefined "")
;(tvi-bind 3 'undefined "")
;(tvi-bind 4 'undefined "")
;(tvi-bind 5 'undefined "")
;(tvi-bind 6 'undefined "")
;(tvi-bind 7 'undefined "")
;(tvi-bind 8 'undefined "")
;(tvi-bind 9 'undefined "")
(tvi-bind 10 'tvi-bind "tvbind")
(tvi-bind 11 'tvi-labels "labels")
;(tvi-bind 12 'undefined "")
;(tvi-bind 13 'undefined "")
;(tvi-bind 14 'undefined "")
;(tvi-bind 15 'undefined "")
;(tvi-bind 16 'undefined "")
;(tvi-bind 17 'undefined "")
;(tvi-bind 18 'undefined "")
;(tvi-bind 19 'undefined "")
;(tvi-bind 20 'undefined "")
(tvi-bind 21 'tvi-reset "RESET")
(tvi-bind 22 'tvi-labels "LABELS")
(defvar tvi-arrows nil "Shuffle commands to use arrows if set")
(defun tvi-arrows ()
"Make the arrow keys act in the intuitive fashion."
(define-key global-map "\^v" 'next-line) ;down arrow
(define-key global-map "\^k" 'previous-line) ;up arrow
(define-key global-map "\^h" 'backward-char) ;left arrow
(define-key global-map "\^l" 'forward-char) ;right arrow
;; move the old functions of the above
(define-key global-map "\^n" 'scroll-up)
(define-key global-map "\^p" 'scroll-down)
(define-key global-map "\^_" 'help-command) (setq help-char ?\^_)
;; for consistency with arrows and C-N ...
(define-key esc-map "\^v" 'other-window) ;M-down
(define-key esc-map "\^k" 'previous-window) ;M-up
(define-key esc-map "\^h" 'backward-word) ;M-left
(define-key esc-map "\^l" 'forward-word) ;M-right
(define-key esc-map "n" 'scroll-other-window)
(define-key esc-map "p" 'scroll-other-window-down)
)
(if tvi-arrows (tvi-arrows))
;; Other functions keys, mainly for documentation. CAPS mean shifted.
(def-key t "\eQ" 'quoted-insert "+") ;char insert
;(def-key t "\eq" ') ;CHAR INSERT
(def-key t "\eW" 'rubout-char "+") ;char delete
;(def-key t "\er" ') ;CHAR DELETE
(def-key t "\eE" 'yank-rectangle "+") ;line insert
(def-key t "\eN" 'rubout-line "+") ;LINE INSERT
(def-key t "\eR" 'kill-rectangle "+") ;line delete
(def-key t "\eO" 'join-line "+") ;LINE DELETE
(def-key t "\eT" 'line-to-top "+") ;line erase
;(def-key t "\et" ') ;LINE ERASE
(def-key t "\eY" 'line-to-bot "+") ;page erase
;(def-key t "\ey" ') ;PAGE ERASE
(def-key t "\^Z" 'previous-window "+") ;clear space
;(def-key t "\e*" ') ;CLEAR SPACE
(def-key t "\eI" 'undo "+") ;BACK TAB
(def-key t "\eP" 'scroll-up "+") ;print
(def-key t "\eL" 'scroll-down "+") ;PRINT
(send-string-to-terminal "\e01S\e02s") ;program SEND key
(def-key t "\eS" 'tvi-bind "+") ;send
;(def-key t "\es" ') ;SEND
;;; Use the Home Key (^^ -> ^Q) as an Arrow Prefix
(def-key t "\^q" nil) ; undefine ^Q
(def-key t "\^q\^q" 'quoted-insert "*") ; save old ^Q
(def-key t "\^q\^v" 'scroll-up "+") ; down
(def-key t "\^q\^k" 'scroll-down "+") ; up
(def-key t "\^q\^h" 'scroll-other-window "+") ; left
(def-key t "\^q\^l" 'scroll-other-window-down "+") ; rite
;;; keys.el
(setq debug-on-error nil)
(defvar gubed nil "Debug Spelt Sideways!")
(defun def-key (map key cmd &optional suffix def) "\
In MAP, bind KEY to CMD. Create an intermediate variable with SUFFIX
appended to cmd name & set its function definition to command.
If MAP is t, use global-map; if nil, use local map; else use
given map. MAP must be the *name* of a map, *not* the map itself.
Optional fifth arg DEF is function definition."
(if gubed (debug))
(cond ((null map) (setq map '(current-local-map)))
((eq map t) (setq map '(current-global-map))))
(if def (fset cmd def))
;; (or suffix (setq suffix "?"))
(let ((name (concat (symbol-name cmd) suffix)))
(and suffix (not (string= suffix ""))
(eval (read (concat "(fset '" name " cmd)"))))
(define-key (eval map) key (intern name))
(if load-in-progress nil
(message "%s bound to %s in %s"
(key-description key) name map))))
(defun set-key (key cmd &optional map) "\
Interactive wrapper for def-key. Bind KEY to CMD in MAP. MAP is
decoded from the prefix arg. If any prefix arg is supplied, use global
map, else use local map. Suffix is always '&'."
(interactive "kSet Key: \nCCommand: \nP")
(if gubed (debug))
(def-key (not map) key cmd "&"))
;;; Random Conventions: Keys fall into various categorys and are
;;; designated by a third argument to `set-key' as follows:
;;;
;;; Suffix Category
;;;
;;; "+" New functions on new keys (additions)
;;; ">" Old functions on new keys (displacements)
;;; "<" New functions on old keys (supercessions)
;;; "*" Old functions on old keys (relocations)
;;; "@" Old function no longer used
(defun tick (&optional map) "\
Define ` as ESC-prefix and `` as self insert.
Global definition if MAP is t, else local definition."
(interactive)
(def-key map "`" 'ESC-prefix "*")
(def-key map "\e`" 'self-insert-command "+"))
(tick t)
;;; Control Key Map
(def-key t "\^a" 'scroll-up "*")
(def-key t "\^s" 'transpose-chars "*")
(def-key t "\^t" 'isearch-forward "*")
(def-key t "\^v" 'beginning-of-line "*")
(def-key t "\^z" 'scroll-down "*")
(def-key t "\^]" 'other-window "*")
;;; Meta Additions (FULL) _ is tvi950 function keys
(def-key t "\e\^l" 'count-lines-region ">")
(def-key t "\e\^m" 'scroll-other-window "+")
(def-key t "\e\^q" 'indent-region ">")
(def-key t "\e\^r" 'isearch-backward-regexp "+")
(def-key t "\e\^v" 'scroll-other-window-down ">")
(def-key t "\e\^y" 'eval-region "+")
(def-key t "\e\^z" 'eval-current-buffer "+")
(def-key t "\e\^_" 'abort-recursive-edit "<")
(def-key t "\e\^]" 'scroll-other-window-down "+")
(def-key t "\e " 'set-mark-command "*")
(def-key t "\e\"" 'mail-quote "+")
(def-key t "\e#" 'spell-buffer "+")
(def-key t "\e*" 'set-key "+")
(def-key t "\e+" 'make-command-summary "+")
(def-key t "\e:" 'print-buffer "+")
(def-key t "\e=" 'what-line "<")
(def-key t "\e?" 'print-region "+")
(def-key t "\en" 'rename-buffer "+")
(def-key t "\eo" 'occur "+")
(def-key t "\ep" 'pwd "+")
(def-key t "\eq" 'query-replace "*")
(def-key t "\er" 'query-replace-regexp "<")
(def-key t "\es" 'set-variable "+")
(def-key t "\ev" 'view-buffer "<")
(def-key t "\e\\" 'end-of-buffer "<")
;;; ^X Map (FREE %& @_) ^@ is sun-mouse, # is server-edit
(def-key t "\^x\^a" 'append-to-file "<")
(def-key t "\^x\^b" 'buffer-menu "@")
(def-key t "\^x\^h" 'fill-paragraph "*")
(def-key t "\^x\^j" 'backward-kill-sexp "+")
(def-key t "\^x\^k" 'bury-buffer "+")
(def-key t "\^x\^m" 'rmail-file "+")
(def-key t "\^x\^r" 'move-to-window-line "@")
(def-key t "\^x\^y" 'yowza "+")
(def-key t "\^x\^]" 'blink-paren "+")
(def-key t "\^x\^_" 'backward-kill-sexp "+")
(def-key t "\^x " 'just-one-space ">")
(def-key t "\^x!" 'shell "+")
(def-key t "\^x\"" 'mail-uucp "+")
(def-key t "\^x*" 'add-mode-abbrev ">")
(def-key t "\^x," 'inverse-add-mode-abbrev ">")
(def-key t "\^x3" 'compare-windows "+")
(def-key t "\^x6" 'enlarge-window "+")
(def-key t "\^x7" 'shrink-window "+")
(def-key t "\^x8" 'scroll-up-in-place "+")
(def-key t "\^x9" 'scroll-down-in-place "+")
(def-key t "\^x:" 'lpr-buffer "+")
(def-key t "\^x?" 'lpr-region "+")
(def-key t "\^xc" 'cd "+")
(def-key t "\^xd" 'delete-matching-lines "@")
(def-key t "\^xt" 'tick "+")
(def-key t "\^xv" 'view-file "+")
(def-key t "\^xy" 'prev-complex-command "+")
(def-key t "\^xz" 'rerun-prev-command "+")
(def-key t "\^x\\" 'electric-command-history "+")
(def-key t "\^x|" 'recover-file "+")
(def-key t "\^x~" 'revert-buffer "+")
;;; I like Control Key Help (FREE ^eopquxz)
(def-key t "\^h\^a" 'command-apropos ">")
(def-key t "\^h\^b" 'describe-bindings ">")
(def-key t "\^h\^c" 'describe-key-briefly "@")
(def-key t "\^h\^d" 'dup-line "@")
(def-key t "\^h\^f" 'describe-function ">")
(def-key t "\^h\^i" 'info ">")
(def-key t "\^h\^j" 'goto-line "+")
(def-key t "\^h\^k" 'describe-key ">")
(def-key t "\^h\^l" 'load-library "+")
(def-key t "\^h\^m" 'describe-mode ">")
(def-key t "\^h\^n" 'next-error "@")
(def-key t "\^h\^r" 'byte-recompile-directory "+")
(def-key t "\^h\^s" 'describe-syntax ">")
(def-key t "\^h\^t" 'help-with-tutorial ">")
(def-key t "\^h\^v" 'describe-variable ">")
(def-key t "\^h\^w" 'where-is "@")
(def-key t "\^h\^y" 'random-yow "+")
;;; Now use ^h for a few other things (FREE ehijoprwxz)
(def-key t "\^h " 'delete-horizontal-space ">")
(def-key t "\^h." 'find-tag-other-window "+")
(def-key t "\^h;" 'kill-comment "+")
(def-key t "\^h=" 'what-page "+")
(def-key t "\^ha" 'apropos "<")
(def-key t "\^hb" 'switch-to-buffer-other-window "*")
(def-key t "\^hc" 'compile "<")
(def-key t "\^hd" 'dired-other-window "*")
(def-key t "\^hf" 'find-file-other-window "*")
(def-key t "\^hg" 'grep "+")
(def-key t "\^hj" 'goto-char "+")
(def-key t "\^hk" 'kill-rectangle "<")
(def-key t "\^hl" 'list-tags "@")
(def-key t "\^hm" 'repeat-matching-complex-command ">")
(def-key t "\^hn" 'next-file "@")
(def-key t "\^hq" 'tags-query-replace "+")
(def-key t "\^hs" 'tags-search "+")
(def-key t "\^ht" 'tags-apropos "+")
(def-key t "\^hu" 'undigestify-rmail-message "+")
(def-key t "\^hv" 'visit-tags-table "<")
(def-key t "\^hy" 'yank-rectangle "+")
;;; end keys.el